Выручайте нужно описание алгоритма и практическая часть (плачу Easypay

  • Автор темы den777
  • Дата начала
Статус
Закрыто для дальнейших ответов.
D

den777

#1
Здравствуйте срочно нужно описание алгоритма и практическая часть этого архиватора.(курсовая 2-й курс).
Посмотреть вложение _________.rar

[codebox]

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, jpeg, ExtCtrls, Menus;

type
TFCompressFile = class(TForm)
Image1: TImage;
cmdCompress: TButton;
cmdUncompress: TButton;
cmbLevel: TComboBox;
lblLevel: TLabel;
EditFile: TEdit;
SbFile: TSpeedButton;
lblFile: TLabel;
OpenDialog: TOpenDialog;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
procedure cmdCompressClick(Sender: TObject);
procedure SbFileClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cmdUncompressClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
private
{ Private declarations }
gsExePath : string;
public
{ Public declarations }
end;

var
FCompressFile: TFCompressFile;

implementation

{$R *.dfm}
uses UtilityPasZlib, Unit1, Unit3;

procedure TFCompressFile.SbFileClick(Sender: TObject);
var
sPath: string;
begin
with OpenDialog do
begin
DefaultExt:='';
Options:=[ofFileMustExist];
sPath:=ExtractFilePath(EditFile.Text);
if sPath=''
then sPath:=gsExePath;
InitialDir:=sPath;
FileName:='';
if Execute
then
begin
if UpperCase(gsExePath)=UpperCase(ExtractFilePath(FileName))
then EditFile.Text:=ExtractFileName(FileName)
else EditFile.Text:=FileName;
end;
end;
end;

procedure TFCompressFile.FormCreate(Sender: TObject);
begin
gsExePath:=ExtractFilePath(Application.ExeName);
end;

procedure TFCompressFile.N2Click(Sender: TObject);
var
sPath: string;
begin
with OpenDialog do
begin
DefaultExt:='';
Options:=[ofFileMustExist];
sPath:=ExtractFilePath(EditFile.Text);
if sPath=''
then sPath:=gsExePath;
InitialDir:=sPath;
FileName:='';
if Execute
then
begin
if UpperCase(gsExePath)=UpperCase(ExtractFilePath(FileName))
then EditFile.Text:=ExtractFileName(FileName)
else EditFile.Text:=FileName;
end;
end;
end;

procedure TFCompressFile.N3Click(Sender: TObject);
begin
close;
end;

procedure TFCompressFile.N5Click(Sender: TObject);
begin
form1.showmodal;
end;

procedure TFCompressFile.N6Click(Sender: TObject);
begin
form3.showmodal ;
end;

function CutExt(s: string): string;
begin
Result:=Copy(s,1,length(s)-length(ExtractFileExt(s)));
end;

procedure TFCompressFile.cmdCompressClick(Sender: TObject);
var
sFilename: string;
Level: TCompLevel;
begin
Screen.Cursor:=crHourGlass;
Level:=clDefault;
try
sFilename:=trim(EditFile.Text);
if sFilename<>''
then
begin
if cmbLevel.Text='Слабый'
then Level:=clNone
else
if cmbLevel.Text='Сильный'
then Level:=clMax;
CompressFile(sFilename,sFilename+'.zip',Level);
ShowMessage('Операция завершена успешно!');
end;
finally
Screen.Cursor:=crDefault;
end;
end;

procedure TFCompressFile.cmdUncompressClick(Sender: TObject);
var
sFilename, sDestFile: string;
begin
Screen.Cursor:=crHourGlass;
try
sFilename:=trim(EditFile.Text);
if sFilename<>''
then
begin
sDestFile:=sFilename;
if UpperCase(ExtractFileExt(sFileName))<>'.ZIP'
then
begin
sDestFile:=sFilename;
sFilename:=sDestFile+'.zip';
end
else sDestFile:=CutExt(sFilename);
UnCompressFile(sFilename,sDestFile);
ShowMessage('Файл успешно разархивирован!');
end;
finally
Screen.Cursor := crDefault;
end;
end;

end.






unit UtilityPasZlib;

// by Andrea Russo - Italy - 2005
// email: andrusso@libero.it

interface

//Unit zlib is icluded into the latest version of Delphi (from Delphi 6), but in old versions is
//included into the Delphi cd.
// Otherwise if do you want to use paszlib library change the uses.

//If do you want to use zlib included into Delphi

uses zlib, Classes;

//If do you want to use paszlib library
//uses dzlib, Classes;

type TCompLevel = (clNone, clFastest, clDefault, clMax);

procedure CompressFile(const sFileIn : string; const sFileOut : string; const Level : TCompLevel = clDefault);
procedure UnCompressFile(const sFileIn : string; const sFileOut : string);

procedure CompressStream(inStream, outStream :TStream; const Level : TCompLevel = clDefault);
procedure ExpandStream(inStream, outStream :TStream);

implementation

procedure CompressFile(const sFileIn : string; const sFileOut : string; const Level : TCompLevel = clDefault);
var
inStream, outStream: TMemoryStream;
begin
inStream:=TMemoryStream.Create;
outStream:=TMemoryStream.Create;
try
inStream.LoadFromFile(sFileIn);
with TCompressionStream.Create(TCompressionLevel(Level), outStream) do
try
CopyFrom(inStream, inStream.Size);
finally
Free;
end;
outStream.SaveToFile(sFileOut);
finally
outStream.Free;
inStream.Free;
end;
end;

procedure UnCompressFile(const sFileIn : string; const sFileOut : string);
var
inStream, outStream: TMemoryStream;
begin
inStream:=TMemoryStream.Create;
outStream:=TMemoryStream.Create;
try
inStream.LoadFromFile(sFileIn);
ExpandStream(inStream, outStream);
outStream.SaveToFile(sFileOut);
finally
inStream.Free;
outStream.Free;
end;
end;

procedure CompressStream(inStream, outStream :TStream; const Level : TCompLevel = clDefault);
begin
with TCompressionStream.Create(TCompressionLevel(Level), outStream) do
try
CopyFrom(inStream, inStream.Size);
finally
Free;
end;
end;

procedure ExpandStream(inStream, outStream :TStream);
const
BufferSize = 4096;
var
Count: integer;
ZStream: TDecompressionStream;
Buffer: array[0..BufferSize-1] of Byte;
begin
ZStream:=TDecompressionStream.Create(InStream);
try
while true do
begin
Count:=ZStream.Read(Buffer, BufferSize);
if Count<>0
then OutStream.WriteBuffer(Buffer, Count)
else Break;
end;
finally
ZStream.Free;
end;
end;

end.
[/codebox]

Плачу Easypay.
e-mail deniskrauch@yandex.ru
 

Вложения

Статус
Закрыто для дальнейших ответов.