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

Тема в разделе "Предложения работы", создана пользователем den777, 18 июн 2008.

Статус темы:
Закрыта.
  1. den777

    den777 Гость

    Здравствуйте срочно нужно описание алгоритма и практическая часть этого архиватора.(курсовая 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
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей