Исходный код программы

unit Unit1;

interface.

uses.

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,.

Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, zLib;

type.

TForm1 = class (TForm).

GroupBox1: TGroupBox;

PackS: TLabeledEdit;

Label1: TLabel;

PackD: TLabeledEdit;

PackDeg: TListBox;

GroupBox2: TGroupBox;

UnpackS: TLabeledEdit;

PackBtn: TBitBtn;

UnpackBtn: TBitBtn;

CheckBox1: TCheckBox;

StatusBar1: TStatusBar;

SaveDialog1: TSaveDialog;

procedure FormCreate (Sender: TObject);

procedure FormClose (Sender: TObject; var Action: TCloseAction);

function SaveToZUP (filein, fileout: string;compression:TCompressionLevel):boolean;

function LoadFromZUP (filein:string):boolean;

procedure PackSClick (Sender: TObject);

procedure UnpackSClick (Sender: TObject);

procedure PackBtnClick (Sender: TObject);

procedure UnpackBtnClick (Sender: TObject);

private.

{ Private declarations }.

public.

{ Public declarations }.

end;

Const cBufferSize = 65 536;

var.

Form1: TForm1;

temp:THandle=0;

PackThread, UnpackThread: THandle;

implementation.

{$R *.dfm}.

function TForm1. SaveToZUP (filein, fileout: string;compression:TCompressionLevel):boolean;

var.

ms:TMemoryStream;

OutFile:TStream;

ZStream: TCustomZLibStream;

filename:string[255];

begin.

try.

ms:=TMemoryStream.Create;

ms.LoadFromFile (filein);

OutFile:=TFileStream.Create (Fileout, fmCreate);

filename:=ExtractFileName (filein);

OutFile.Write (filename, sizeof (filename));

Try.

ZStream:=TCompressionStream.Create (compression, OutFile);

Try.

ZStream.CopyFrom (ms, 0);

finally.

ZStream.Free;

end;

finally.

ms.free;

OutFile.Free;

result:=true;

end;

except result:=false;

end;

end;

function TForm1. LoadFromZUP (filein:string):boolean;

var.

S, fileout: string[255];

Count: Integer;

InFile:TStream;OutFile:TMemoryStream;

ZStream: TCustomZLibStream;

Buffer: array[0.cBufferSize-1] of Byte;

begin.

try.

InFile:= TFileStream. Create (filein, fmOpenRead);

InFile.Read (S, sizeof (S));

try.

OutFile:= TMemoryStream. Create;

try.

ZStream:=TDecompressionStream.Create (InFile);

try.

while True do.

begin.

Count:=ZStream.Read (Buffer, cBufferSize);

if Count 0 then OutFile. WriteBuffer (Buffer, Count).

else Break;

end;

finally ZStream. Free;

end;

finally.

end;

finally.

InFile.Free;

Try.

fileout:=ExtractFilePath (filein)+S;

OutFile.SaveToFile (fileout);

finally.

OutFile.Free;

end;

end;

except result:=false;

end;

result:=true;

end;

procedure Compress (lpvoid:pointer);

const compression: array[0.2] of TCompressionLevel=(clFastest, clDefault, clMax);

begin.

try.

form1.GroupBox1.Enabled:=false;

form1.GroupBox2.Enabled:=false;

form1.StatusBar1.SimpleText:='Архивирую…';

if form1. CheckBox1.Checked then SetThreadPriority (PackThread, THREAD_PRIORITY_HIGHEST);

if form1. SaveToZUP (form1.PackS.Text, ChangeFileExt (form1.PackD.Text,'.SSA'), compression[form1.PackDeg.ItemIndex])then.

form1.StatusBar1.SimpleText:='Архивация закончена.'.

else form1. StatusBar1.SimpleText:='Ошибка. Может Вы неправильно задали параметры.';

form1.GroupBox1.Enabled:=true;

form1.GroupBox2.Enabled:=true;

TerminateThread (PackThread, 0);

except form1. StatusBar1.SimpleText:='Ошибка. Может Вы неправильно задали параметры.';

end;

end;

procedure Decompress (lpvoid:pointer);

begin.

try.

form1.GroupBox1.Enabled:=false;

form1.GroupBox2.Enabled:=false;

form1.StatusBar1.SimpleText:='Извлекаю…';

if form1. CheckBox1.Checked then SetThreadPriority (UnpackThread, THREAD_PRIORITY_HIGHEST);

if form1. LoadFromZUP (form1.UnpackS.Text)then.

form1.StatusBar1.SimpleText:='Извлечение закончено…'.

else form1. StatusBar1.SimpleText:='Ошибка. Может Вы неправильно задали параметры.';

form1.GroupBox1.Enabled:=true;

form1.GroupBox2.Enabled:=true;

TerminateThread (UnpackThread, 0);

except form1. StatusBar1.SimpleText:='Ошибка. Может Вы неправильно задали параметры.';

end;

end;

procedure TForm1. FormCreate (Sender: TObject);

begin.

PackDeg.Selected[0]: =true;

end;

procedure TForm1. FormClose (Sender: TObject; var Action: TCloseAction);

begin.

TerminateThread (PackThread, 0);

TerminateThread (UnpackThread, 0);

end;

procedure TForm1. PackSClick (Sender: TObject);

begin.

form1.SaveDialog1.Filter:='';

if form1. savedialog1.execute then.

begin.

PackS.Text:=form1.savedialog1.FileName;

PackD.Text:=changefileext (form1.savedialog1.FileName,'.ssa');

end;

end;

procedure TForm1. UnpackSClick (Sender: TObject);

begin.

form1.SaveDialog1.Filter:='Файлы архива|*.ssa|Любые файлы|*.*';

if form1. savedialog1.execute then UnpackS. Text:=form1.savedialog1.FileName;

end;

procedure TForm1. PackBtnClick (Sender: TObject);

begin.

if fileexists (PackS.Text)and (PackD.Text'')then PackThread:=CreateThread (0,0,@Compress, 0,0,temp).

else form1. StatusBar1.SimpleText:='Ошибка. Может Вы неправильно задали параметры.';

end;

procedure TForm1. UnpackBtnClick (Sender: TObject);

begin.

if fileexists (UnpackS.Text){and (UnpackD.Text'')}then UnPackThread:=CreateThread (0,0,@DeCompress, 0,0,temp).

else form1. StatusBar1.SimpleText:='Ошибка. Может Вы неправильно задали параметры.';

end;

end.