home *** CD-ROM | disk | FTP | other *** search
Wrap
// ô¥ìçâAü[âJâCâoâRâôâ|ü[âlâôâg for Delphi/C++Builder // Common Archivers Component for Delphi/C++Builder // Copyright(C) NORG1964/M.Yoneda 1997,1998,1999,2000 // // UNLHA32.DLLòù îoë▀ò\Īâ_âCâAâìâO LHPRGDLG.PAS // // v1.27:âfâéé╔é▒é╠âéâWâàü[âïé≡Æ╟ë┴ // v1.32:UnpackFiles/PackFiles/RemoveItemsé╚é╟é╠âüâ\âbâhé≡Æ╟ë┴ // v1.36:é▒é╠âtâHü[âÇé╠ò\Īé╔ ShowModal é≡Ägéñéµéñé╔é╡é╜üB // â_âCâAâìâOâCâôâXâ^âôâXé≡É╢ɼé╡é─Ägùpé╖éΘ(ìLï`é╠)âüâ\âbâhé≡Æ╟ë┴ // unit LHPRGDLG; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, Archives; const WM_EXECMETHOD = WM_USER+100; type TArchiverMethod = function:Integer of object; TArchiverMethodAndParams = class private FMethod: TArchiverMethod; FArchiveFIle: TArchiveFIle; FOptions: TArchiverOptions; FBaseDir: string; FFileList: TStringList; FBuffer: Pointer; FdwBuffSize: DWORD; FArchiverResult: integer; public constructor Create( Method:TArchiverMethod;ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:string;FileList:array of const;Buffer:Pointer;dwBuffSize:DWORD ); destructor Destroy; override; procedure ExecMethod; public dwWriteSize: DWORD; public property ArchiveFile: TArchiveFile read FArchiveFile; property Options: TArchiverOptions read FOptions; property BaseDir: string read FBaseDir; property FileList: TStringList read FFileList; property Buffer: Pointer read FBuffer; property dwBuffSize: DWORD read FdwBuffSize; property ArchiverResult: integer read FArchiverResult; end; TdlgArchiverProgress = class( TForm ) ProgressBar1: TProgressBar; cmdCancel: TButton; lblArchiveFileName: TLabel; lblSrcFileName1: TLabel; lblSrcFileName2: TLabel; lblWriteSize: TLabel; lblCount: TLabel; Label1: TLabel; Label3: TLabel; Label5: TLabel; Label6: TLabel; Label4: TLabel; procedure FormShow( Sender:TObject ); procedure cmdCancelClick( Sender:TObject ); procedure ArchiveFileProgress( Sender:TObject;State:Integer;lpEis:LPEXTRACTINGINFOEX;var Abort:Boolean ); private FFileCount1: integer; FFileCount2: integer; FFileCount3: integer; FCanceled: boolean; FOrgProgress: TArchiverProgressEvent; procedure SetArchiveFileName( const Value:string ); protected procedure DoShow; override; procedure DoHide; override; procedure BeforeExec( ArchiveFile:TArchiveFile ); procedure AfterExec( ArchiveFile:TArchiveFile ); private FArchiver: TArchiverMethodAndParams; function DoUnpackFiles :Integer; function DoPackFiles :Integer; function DoRemoveItems :Integer; function DoUpdateArchive:Integer; function DoMakeSfx :Integer; function DoUnpackToMem :Integer; // function DoCheckArchive :integer; procedure ExecMethod( var msg:TMessage ); message WM_EXECMETHOD; public property ArchiveFileName: string write SetArchiveFileName; function UnpackFiles ( ArchiveFile:TArchiveFile;Options:TArchiverOptions;DstPath:String;FileList:array of const ):Integer; function PackFiles ( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; function RemoveItems ( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; function UpdateArchive( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; function MakeSfx ( ArchiveFile:TArchiveFile;Options:TArchiverOptions;DstPath:String ):Integer; function UnpackToMem ( ArchiveFile:TArchiveFile;Options:TArchiverOptions;FileName:string;lpvBuffer:LPVOID;dwSize:DWORD;lpdwWriteSize:LPDWORD ):Integer; end; var dlgArchiverProgress: TdlgArchiverProgress; implementation uses Filters; {$OPTIMIZATION ON} // é▒éΩé≡ôⁿéΩé╚éóé╞ C++ Builder 3 é┼îδô«ì∞ {$BOOLEVAL OFF} {$IFNDEF VER90} // not Delphi 2 ? {$IFNDEF VER100} // not Delphi 3 ? {$HPPEMIT '#include "LHPRSTUB.h"'} {$ObjExportAll On} {$ENDIF} {$ENDIF} {$R *.DFM} procedure TdlgArchiverProgress.FormShow( Sender:TObject ); begin PostMessage( Handle,WM_EXECMETHOD,0,0 ); end; procedure TdlgArchiverProgress.ExecMethod; begin BeforeExec( FArchiver.ArchiveFile ); try FArchiver.ExecMethod; finally AfterExec( FArchiver.ArchiveFile ); ModalResult := mrOk; end; end; procedure TDlgArchiverProgress.ArchiveFileProgress( Sender:TObject;State:Integer;lpEis:LPEXTRACTINGINFOEX;var Abort: Boolean ); begin Application.ProcessMessages; ABort := FCanceled; if lpEis = nil then exit; with lpEis^,lpEis^.exinfo do begin lblSrcFileName1.Caption := ExtractFileName( szSourceFileName ); if State <> 5 then begin lblSrcFileName2.Caption := szDestFileName; lblWriteSize .Caption := IntToStr( dwWriteSize ); if dwFileSize <> 0 then ProgressBar1 .Position := dwWriteSize * 100 div dwFileSize else ProgressBar1 .Position := 0; end; end; case State of ARCEXTRACT_BEGIN: // èYôûâtâ@âCâïé╠Åêù¥é╠èJÄn if FFileCount1 > 0 then begin Inc( FFileCount2 ); lblCount.Caption := '[' + IntToStr( FFileCount2 ) + '/' + IntToStr( FFileCount1 ) + ']'; end else begin if FFileCount3 > 0 then begin Inc( FFileCount2 ); lblCount.Caption := '[' + IntToStr( FFileCount2 ) + '/' + IntToStr( FFileCount3 ) + ']'; end; end; ARCEXTRACT_INPROCESS: // èYôûâtâ@âCâïé╠ôWèJÆå ; ARCEXTRACT_COPY: // âÅü[âNâtâ@âCâïé╠Åæé½û▀é╡ begin Label4.Visible := False; Label5.Visible := True; lblSrcFileName2.Visible := False; cmdCancel.Enabled := False; end; ARCEXTRACT_END: // Åêù¥ÅIù╣üAè╓ÿAâüâéâèé≡èJò· ; ARCEXTRACT_OPEN: // èYôûÅæî╔é╠Åêù¥é╠èJÄn ; 5: // âAü[âJâCâo DLL é╔éµéΘâtâ@âCâïû╝Ä√ÅWÆåüH begin Inc( FFileCount1 ); lblCount.Caption := '[' + IntToStr( FFileCount1 ) + ']'; end; $805: // ôαòöâtâBâïâ^é╔éµéΘâtâ@âCâïû╝Ä√ÅWÆåüH begin Inc( FFileCount3 ); lblCount.Caption := '[' + IntToStr( FFileCount3 ) + ']'; end; 6: // ê│Åké╠ÅΩìçé═üCé▒é╠âüâbâZü[âWé┼Äné▀é─æSé─é╠âüâôâoé¬ùLî°é╞é╚éΘ ; end; end; procedure TdlgArchiverProgress.BeforeExec( ArchiveFile:TArchiveFile ); begin FOrgProgress := ArchiveFile.OnProgress; ArchiveFile.OnProgress := ArchiveFileProgress; ArchiveFileName := ArchiveFile.FileName; // Show; // Update; end; procedure TdlgArchiverProgress.AfterExec( ArchiveFile:TArchiveFile ); begin ArchiveFile.OnProgress := FOrgProgress; // Hide; end; procedure TDlgArchiverProgress.DoShow; begin FFileCount1 := 0; FFileCount2 := 0; FFileCount3 := 0; lblCount. Caption := ''; lblWriteSize .Caption := ''; lblSrcFileName2.Caption := ''; lblSrcFileName2.Visible := True; Label4.Visible := True; Label5.Visible := False; ProgressBar1 .Position := 0; FCanceled := False; inherited; end; procedure TDlgArchiverProgress.DoHide; begin cmdCancel.Enabled := True; end; procedure TDlgArchiverProgress.SetArchiveFileName( const Value:string ); begin lblArchiveFileName.Caption := Value; end; procedure TdlgArchiverProgress.cmdCancelClick( Sender:TObject ); begin FCanceled := True; end; function TdlgArchiverProgress.MakeSfx( ArchiveFile:TArchiveFile;Options:TArchiverOptions;DstPath:String ):Integer; begin Assert( Self <> nil,'dlgArchiverProgress not assigned' ); FArchiver := TArchiverMethodAndParams.Create( DoMakeSfx,ArchiveFile,Options,DstPath,[nil],nil,0 ); try Caption := 'Ä⌐î╚ë≡ôÇÅæî╔ì∞ɼ'; Label4.Caption := 'ê│Åkâtâ@âCâïüF'; ShowModal; Result := FArchiver.ArchiverResult; finally FArchiver.Free; FArchiver := nil; end; end; function TdlgArchiverProgress.PackFiles( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; begin Assert( Self <> nil,'dlgArchiverProgress not assigned' ); FArchiver := TArchiverMethodAndParams.Create( DoPackFiles,ArchiveFile,Options,BaseDir,FileList,nil,0 ); try Caption := 'ê│ÅkÅ≤ï╡'; Label4.Caption := 'ê│Åkâtâ@âCâïüF'; ShowModal; Result := FArchiver.ArchiverResult; finally FArchiver.Free; FArchiver := nil; end; end; function TdlgArchiverProgress.RemoveItems( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; begin Assert( Self <> nil,'dlgArchiverProgress not assigned' ); FArchiver := TArchiverMethodAndParams.Create( DoRemoveItems,ArchiveFile,Options,BaseDir,FileList,nil,0 ); try Caption := 'ìφÅ£Å≤ï╡'; Label4.Caption := 'ìφÅ£âtâ@âCâïüF'; ShowModal; Result := FArchiver.ArchiverResult; finally FArchiver.Free; FArchiver := nil; end; end; function TdlgArchiverProgress.UnpackFiles( ArchiveFile:TArchiveFile;Options:TArchiverOptions;DstPath:String;FileList:array of const ):Integer; begin Assert( Self <> nil,'dlgArchiverProgress not assigned' ); FArchiver := TArchiverMethodAndParams.Create( DoUnpackFiles,ArchiveFile,Options,DstPath,FileList,nil,0 ); try Caption := 'ë≡ôÇÅ≤ï╡'; Label4.Caption := 'ë≡ôÇɵü@ü@ü@üF'; ShowModal; Result := FArchiver.ArchiverResult; finally FArchiver.Free; FArchiver := nil; end; end; function TdlgArchiverProgress.UnpackToMem( ArchiveFile:TArchiveFile;Options:TArchiverOptions;FileName:string;lpvBuffer:LPVOID;dwSize:DWORD;lpdwWriteSize:LPDWORD ):Integer; begin Assert( Self <> nil,'dlgArchiverProgress not assigned' ); FArchiver := TArchiverMethodAndParams.Create( DoUnpackToMem,ArchiveFile,Options,'',[FileName],nil,0 ); try Caption := 'ë≡ôÇÅ≤ï╡'; Label4.Caption := ''; ShowModal; Result := FArchiver.ArchiverResult; finally FArchiver.Free; FArchiver := nil; end; end; function TdlgArchiverProgress.UpdateArchive( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; begin Assert( Self <> nil,'dlgArchiverProgress not assigned' ); FArchiver := TArchiverMethodAndParams.Create( DoUpdateArchive,ArchiveFile,Options,BaseDir,FileList,nil,0 ); try Caption := 'ê│ÅkÅ≤ï╡'; Label4.Caption := 'ê│Åkâtâ@âCâïüF'; ShowModal; Result := FArchiver.ArchiverResult; finally FArchiver.Free; FArchiver := nil; end; end; function TdlgArchiverProgress.DoUnpackFiles:Integer; begin with FArchiver do Result := ArchiveFile.UnpackFiles( Handle,Options,BaseDir,[FileList] ); end; function TdlgArchiverProgress.DoPackFiles:Integer; begin with FArchiver do Result := ArchiveFile.PackFiles( Handle,Options,BaseDir,[FileList] ); end; function TdlgArchiverProgress.DoRemoveItems:Integer; begin with FArchiver do Result := ArchiveFile.RemoveItems( Handle,Options,BaseDir,[FileList] ); end; function TdlgArchiverProgress.DoUpdateArchive:Integer; begin with FArchiver do Result := ArchiveFile.UpdateArchive( Handle,Options,BaseDir,[FileList] ); end; function TdlgArchiverProgress.DoMakeSfx:Integer; begin with FArchiver do Result := ArchiveFile.MakeSfx( Handle,Options,BaseDir ); end; function TdlgArchiverProgress.DoUnpackToMem:Integer; begin with FArchiver do Result := ArchiveFile.UnpackToMem( Handle,Options,FileList[0],Buffer,dwBuffSize,@dwWriteSize ); end; constructor TArchiverMethodAndParams.Create( Method:TArchiverMethod;ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:string;FileList:array of const;Buffer:Pointer;dwBuffSize:DWORD ); begin FMethod := Method; FArchiveFile := ArchiveFIle; FOptions := Options; FBaseDir := BaseDir; FFileList := ArrayToList( FileList ); FBuffer := Buffer; FdwBuffSize := dwBuffSize; end; destructor TArchiverMethodAndParams.Destroy; begin FFileList.Free; inherited; end; procedure TArchiverMethodAndParams.ExecMethod; begin FArchiverResult := FMethod; end; function UnpackFiles( ArchiveFile:TArchiveFile;Options:TArchiverOptions;DstPath:String;FileList:array of const ):Integer; var dlgArchiverProgress: TdlgArchiverProgress; begin dlgArchiverProgress := TdlgArchiverProgress.Create( Application ); try Result := dlgArchiverProgress.UnpackFiles( ArchiveFile,Options,DstPath,FileList ) finally dlgArchiverProgress.Free; end; end; function PackFiles( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; var dlgArchiverProgress: TdlgArchiverProgress; begin dlgArchiverProgress := TdlgArchiverProgress.Create( Application ); try Result := dlgArchiverProgress.PackFiles( ArchiveFile,Options,BaseDir,FileList ) finally dlgArchiverProgress.Free; end; end; function RemoveItems( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; var dlgArchiverProgress: TdlgArchiverProgress; begin dlgArchiverProgress := TdlgArchiverProgress.Create( Application ); try Result := dlgArchiverProgress.RemoveItems( ArchiveFile,Options,BaseDir,FileList ) finally dlgArchiverProgress.Free; end; end; function UpdateArchive( ArchiveFile:TArchiveFile;Options:TArchiverOptions;BaseDir:String;FileList:array of const ):Integer; var dlgArchiverProgress: TdlgArchiverProgress; begin dlgArchiverProgress := TdlgArchiverProgress.Create( Application ); try Result := dlgArchiverProgress.UpdateArchive( ArchiveFile,Options,BaseDir,FileList ) finally dlgArchiverProgress.Free; end; end; function MakeSfx( ArchiveFile:TArchiveFile;Options:TArchiverOptions;DstPath:String ):Integer; var dlgArchiverProgress: TdlgArchiverProgress; begin dlgArchiverProgress := TdlgArchiverProgress.Create( Application ); try Result := dlgArchiverProgress.MakeSfx( ArchiveFile,Options,DstPath ) finally dlgArchiverProgress.Free; end; end; function UnpackToMem( ArchiveFile:TArchiveFile;Options:TArchiverOptions;FileName:string;lpvBuffer:LPVOID;dwSize:DWORD;lpdwWriteSize:LPDWORD ):Integer; begin dlgArchiverProgress := TdlgArchiverProgress.Create( Application ); try Result := dlgArchiverProgress.UnpackToMem( ArchiveFile,Options,FileName,lpvBuffer,dwSize,lpdwWriteSize ); finally dlgArchiverProgress.Free; end; end; end.