Форум: "Основная";
Текущий архив: 2005.09.04;
Скачать: [xml.tar.bz2];

Вниз

Архиватор   Найти похожие ветки 

← →
Cerberus ©   (2005-08-09 21:01) [0]

Где есть исходники архиватора, любого. Желательно под DOS (на паскале).

---

← →
KilkennyCat ©   (2005-08-09 21:10) [1]

а статья с теорией сжатия (без исходников) не подойдет?

---

← →
Cerberus ©   (2005-08-09 21:12) [2]

Давай. Попробую но всётаки желательно на исходник посмотреть.

---

← →
Adder ©   (2005-08-09 21:16) [3]

Попробуй здесь поискать:
http://pascal.sources.ru/archives/index.htm

---

← →
KilkennyCat ©   (2005-08-09 21:21) [4]

http://rtfms.ru/page.php?id=20&PHPSESSID=5c3740b7703d6d489821c4fcafb50b40

---

← →
3DxFantastika ©   (2005-08-09 21:38) [5]

Program LZHTest;

{ This is a demo program to illstrate the use of the LZH unit.
 it implements a very simple 1 file at a time compressor program.

 Author : Douglas P. Webb
}

uses LZH;

CONST
 MaxBuf = 4096;     { Must be bigger than the biggest chunk being asked for. }

Type
 BufType = Array[1..MaxBuf] OF BYTE;
 BufPtr = ^BufType;

VAR
 InBuf,OutBuf : BufPtr;
 infile,Outfile : FILE;
 s : STRING;
 Bytes_Written : LongInt;
 Size : LongInt;
 Temp : WORD;

{$F+}

Procedure GetBlock(VAR Target; NoBytes:Word; VAR Actual_Bytes:Word);
CONST
 Posn : Word = 1;
 Buf : Word = 0;

VAR
 Temp:Word;

BEGIN
 IF (Posn > Buf) OR (Posn + NoBytes > SUCC(Buf)) THEN
   BEGIN
     IF Posn > Buf THEN
       BEGIN
         BlockRead(InFile,InBuf^,MaxBuf,Buf);
         Write("+");
       END
     ELSE
       BEGIN
         Move(InBuf^[Posn],InBuf^[1],Buf-Posn);
         BlockRead(InFile,InBuf^[Buf-Posn],MaxBuf-(Buf-Posn),Temp);
         Buf := Buf-Posn+Temp;
         Write("+");
       END;
     IF Buf = 0 THEN
       BEGIN
         Actual_Bytes := 0;
         Writeln;
         Exit;
       END;
     Posn := 1;
   END;
 Move(InBuf^[Posn],Target,NoBytes);
 INC(Posn,NoBytes);
 IF Posn > SUCC(Buf) THEN
   Actual_Bytes := NoBytes -(Posn-SUCC(Buf))
 ELSE Actual_Bytes := NoBytes;
END;

Procedure PutBlock(VAR Source; NoBytes:Word; VAR Actual_Bytes:Word);
CONST
 Posn : Word= 1;

VAR
 Temp:Word;

BEGIN
 If NoBytes = 0 THEN    { Flush condition }
   BEGIN
     BlockWrite(OutFile,OutBuf^,PRED(Posn),Temp);
     EXIT;
   END;
 IF (Posn > MaxBuf) OR (Posn + NoBytes > SUCC(MaxBuf)) THEN
   BEGIN
     BlockWrite(OutFile,OutBuf^,PRED(Posn),Temp);
     Posn := 1;
   END;
 Move(Source,OutBuf^[Posn],NoBytes);
 INC(Posn,NoBytes);
 Actual_Bytes := NoBytes;
END;

{$F-}

BEGIN
 IF (paramcount <> 3) THEN
   BEGIN
     Writeln("Usage:lzhuf e(compression)|d(uncompression) infile outfile");
     halt(1);
   END;
 s := paramstr(1);
 IF NOT (s[1] IN ["D","E","d","e"]) THEN
   Halt(1);
 Assign(infile,paramstr(2));
 reset(infile,1);
 Assign(outfile,Paramstr(3));
 Rewrite(outfile,1);
 New(InBuf);
 New(OutBuf);
 IF (upcase(s[1]) = "E") THEN
   BEGIN
      Size := Filesize(InFile);
      BlockWrite(OutFile,Size,Sizeof(LongInt));
      LZHPack(Bytes_Written,GetBlock,PutBlock);
      PutBlock(Size,0,Temp);
   END
 ELSE
   BEGIN
     BlockRead(Infile,Size,Sizeof(LongInt));
     LZHUnPack(Size,GetBlock,PutBlock);
     PutBlock(Size,0,Temp);
   END;
 Dispose(OutBuf);
 Dispose(InBuf);
 Close(Infile);
 Close(OutFile);
END.

---

← →
3DxFantastika ©   (2005-08-09 21:40) [6]

LZH.PAS => http://www.webfile.ru/449548

---

← →
Ded Moroz ©   (2005-08-11 13:04) [7]

http://sf.net/
http://freshmeat.net/

---

← →
Poirot ©   (2005-08-11 13:55) [8]

Вот а сразу сходить на http://www.compression.ru ?
:) Архивчик статей и исходников в 700 метров :)

---

← →
TUser ©   (2005-08-11 15:01) [9]

У blackman"а есть статья "Идея арифметического кодирования". Там есть исходник.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.09.04;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.012 c