📄 dfunrar.pas
字号:
{
TDFUnRar for Delphi (tested with D5)
should work for all Windows-versions from Win95
Copyright (C) 2003 by Dirk Frischalowski, All rights reserved
eMail: dfrischalowski@del-net.com
free, also for commercial use
}
unit DFUnRar;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, untUnRar, StdCtrls;
type
// Testing is the same as listening - so check the file-status in the event OnFileProcessing
TDFRarMode = (DFRAR_EXTRACT, DFRAR_LIST);
// Used for Status Messages in the event OnStatus
TRarStatus = (RAR_ONOPEN, RAR_ONBEFOREOPEN, RAR_AFTERCLOSE, RAR_ONPASSWORD);
// Override Options for overriding files
TOverrideOptions = (OR_ALWAYS, OR_NEVER, OR_EVENT);
// translated original header for easier usability
TDFRARHeaderData = record
ArchiveName : string; // Archiv-Name
FileName : string; // FileName in Archiv with relativ Path
FlagContinueNextVol : boolean; // File are continue in the next volumn
FlagContinuePrevVol : boolean; // more of a File are in the previous volumn
FlagNeedPassword : boolean; // you need a password to extract this file
IsDirectory : boolean; // this is a directory entry
DictionarySize : Integer; // size of the dictionary (not used here)
PackSize : cardinal; // packed filesize
UnpSize : cardinal; // unpacked filesize
HostOS : string; // Name of Host Operation System
FileCRC : string; // CRC-Code of File as 'F4F5F6F7'
FileTime : TDateTime; // FileTime (Delphi-Format)
MajorVersionNeeded : Cardinal; // Major Version needed to extract a file
MinorVersionNeeded : Cardinal; // Minor Version needed to extract a file
Method : string; // Compress Method - see constants in untUnRar.pas - COMPRESSMETHODxxxxx
FAArchive : boolean; // FileAttribute Archiv is set
FACompressed : boolean; // FileAttribute compressed is set
FADirectory : boolean; // FileAttribute directory is set
FAHidden : boolean; // FileAttribute hidden is set
FANormal : boolean; // FileAttribute normal is set
FAOffLine : boolean; // FileAttribute Offline is set
FAReadOnly : boolean; // FileAttribute Readonly is set
FASystem : boolean; // FileAttribute System is set
FATempporary : boolean; // FileAttribute Temp is set
end;
// Function pointers for Events
TRARProgress = procedure(Sender: TObject; FilesProcessed, FileCount, SizeProcessed, SizeCount: Cardinal) of object;
TRAROverrideEvent = procedure(Sender: TObject; FileName: string; var CanOverride: boolean) of object;
TRarErrorEvent = procedure(Sender: TObject; Message: string; MessageID: integer) of object;
TRarStatusEvent = procedure(Sender: TObject; Message: string; status: TRarStatus) of object;
TRarHeaderEvent = procedure(Sender: TObject; hdrData: TDFRARHeaderData; status: Integer) of object;
TRarCommentEvent = procedure(Sender: TObject; Comment: string) of object;
TRarChangeVolEvent = procedure(Sender: TObject; ArcName: PChar; Mode: integer) of object;
TRarPromptPassEvent = procedure(Sender: TObject; var Password: string) of object;
TDFUnRar = class(TComponent)
private
// Helper Data
frmPass: TForm; // Form-Variable for Password-Dialog
frmVol: TForm; // Form-Variable for Volumn-Dialog
Comment: PChar; // Temporary place for the archive comment
CommentResult: Cardinal; // Result for Loading the archive comment
ArchiveHandle: Cardinal; // After opening y have to use this for accessing
RAROpenMode: Cardinal; // OpenMode for Archive RAR_TEST or RAR_EXTRACT
IsLoaded: boolean; // Is UnRar.dll loaded
openArchiveStruc: TRAROpenArchiveData; // Data structure for opening a archive
hdrData: TRARHeaderData; // Data for File-Headers - original
hdrDFData: TDFRARHeaderData; // Data for File-Headers - translated
// for properties
FArchivComment: string; // Comments for archive
FCanProgress: boolean; // Use Progress - takes another UnRar-Operation for calculating file count and file size
FCommentSize: Cardinal; // size of comments
FDirectory: string; // Target directory for extracting
FDllVersion: integer; // Version of Unrar.dll
FFileCount: Cardinal; // Files in Archive - only used if property CanProgress is true
FFileList: TStringList; // List of files to extract (full PathName required)
FFileName: string; // Archive-FileName
FFilesProcessed: Cardinal; // Files processed form archiv (not working if y use a filelist)
FMode: TDFRarMode; // Opening mode (DFRAR_EXTRACT or DFRAR_LIST)
FOverrideEvent: TOverrideOptions; // what to do if file exists
FPassword: string; // Password
FPromptForPass: boolean; // using Eventhandler for Password
FPromptForVolumn: boolean; // should prompt for volumn or use Event FOnVolChange
FSizeCount: Cardinal; // Size of all files in archiv
FSizeProcessed: Cardinal; // processed file size (not working if y use a filelist)
FStopProcessing: boolean; // Flag for stop unrar
FOnComment: TRarCommentEvent; // Eventhandler for Archiv Comment
FOnError: TRarErrorEvent; // Eventhandler for Errors
FOnFileProcessing: TRarHeaderEvent; // Eventhandler for processing one file
FOnOverride: TRAROverrideEvent; // Eventhandler if FOverrideEvent is OR_EVENT
FOnPassword: TRarPromptPassEvent; // Eventhandler for password
FOnProgress: TRARProgress; // EventHandler for Progress
FOnRarStatus: TRarStatusEvent; // Eventhandler for status messages
FOnVolChange: TRarChangeVolEvent; // Eventhandler if new Volumn needed (if UnRar.dll cant find it automaticly)
procedure ConvertHeader;
function DoUnRarCallBack(msg: Cardinal; UserData, P1, P2: longint): integer; stdcall;
procedure DoError(Message: string; MessageID: Integer);
procedure DoStatus(Message: string; status: TRarStatus);
procedure InitRAROpenArchiveStruct;
procedure OpenRARArchive;
procedure CloseRARArchive;
procedure SetRARPassword;
procedure ProcessFileHeader(ReadFileHeaderResult: integer);
function ProcessFile(hArcData: THandle; Operation: Integer; DestPath, DestName: PChar): Integer;
procedure SetMode(value: TDFRarMode);
procedure ShowPasswordDialog(var Passwd: string);
function ShowPromptDialog(OldVolName: string; NewVolName: PChar): boolean;
procedure btnPassDlgClick(Sender: TObject);
procedure btnVolDlgClick(Sender: TObject);
procedure CalcProgress;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// extract or list archive content
procedure Extract;
// returns false if any erros occours
function Test: boolean;
published
property ArchivComment: string read FArchivComment;
property CanProgress: boolean read FCanProgress write FCanProgress;
property CommentSize: Cardinal read FCommentSize;
property Directory: string read FDirectory write FDirectory;
property DllVersion: integer read FDllVersion;
property FileList: TStringList read FFileList write FFileList;
property FileName: string read FFileName write FFileName;
property Mode: TDFRarMode read FMode write SetMode default DFRAR_LIST;
property OverrideEvent: TOverrideOptions read FOverrideEvent write FOverrideEvent;
property Password: string read FPassword write FPassword;
property PromptForPass: boolean read FPromptForPass write FPromptForPass;
property PromptForVolumn: boolean read FPromptForVolumn write FPromptForVolumn;
property StopProcessing: boolean read FStopProcessing write FStopProcessing;
property OnComment: TRarCommentEvent read FOnComment write FOnComment;
property OnError: TRarErrorEvent read FOnError write FOnError;
property OnFileProcessing: TRarHeaderEvent read FOnFileProcessing write FOnFileProcessing;
property OnOverride: TRAROverrideEvent read FOnOverride write FOnOverride;
property OnPassword: TRarPromptPassEvent read FOnPassword write FOnPassword;
property OnProgress: TRARProgress read FOnProgress write FOnProgress;
property OnRarStatus: TRarStatusEvent read FOnRarStatus write FOnRarStatus;
property OnVolChange: TRarChangeVolEvent read FOnVolChange write FOnVolChange;
end;
procedure Register;
implementation
var
MySelf: Pointer;
procedure Register;
begin
RegisterComponents('DFrisch', [TDFUnRar]);
end;
function UnRarCallBack(msg: Cardinal; UserData, P1, P2: longint): integer; stdcall;
begin
Result := TDFUnRar(MySelf).DoUnRarCallBack(msg, UserData, P1, P2);
end;
procedure TDFUnRar.CloseRARArchive;
begin
if RARCloseArchive(ArchiveHandle) = ERAR_ECLOSE then
DoError(MSG1, ERAR_ECLOSE);
DoStatus('', RAR_AFTERCLOSE);
end;
procedure TDFUnRar.ConvertHeader;
var
ft: _FILETIME;
st: TSystemTime;
begin
with hdrDFData do
begin
ArchiveName := StrPas(hdrData.ArcName);
FileName := StrPas(hdrData.FileName);
FlagContinuePrevVol := (hdrData.Flags and $00000001) = $00000001;
FlagContinueNextVol := (hdrData.Flags and $00000002) = $00000002;
FlagNeedPassword := (hdrData.Flags and $00000004) = $00000004;
IsDirectory := (hdrData.Flags and $00000070) = $00000070;
DictionarySize := ((hdrData.Flags and $00000070) shr 4) * 64 * 1024;
PackSize := hdrData.PackSize;
UnpSize := hdrData.UnpSize;
FileCRC := Format('%x', [hdrData.FileCRC]);
case hdrData.HostOS of
0: HostOS := 'DOS';
1: HostOS := 'IBM OS/2';
2: HostOS := 'Windows';
3: HostOS := 'Unix';
end;
// Konverting MSDOS-Date to TDateTime-Format
DosDateTimeToFileTime(HiWord(hdrData.FileTime),
LoWord(hdrData.FileTime),
ft);
FileTimeToSystemTime(ft, st);
FileTime := SystemTimeToDateTime(st);
// Version = MajorVersion * 10 + MonirVersion
MinorVersionNeeded := hdrData.UnpVer mod 10;
MajorVersionNeeded := (hdrData.UnpVer - MinorVersionNeeded) div 10;
// Checking for Compress-Method - NOT IN UNRAR.DLL - Description so be carefully
case hdrData.Method of
48: Method := COMPRESSMETHODSTORE;
49: Method := COMPRESSMETHODFASTEST;
50: Method := COMPRESSMETHODFAST;
51: Method := COMPRESSMETHODNORMAL;
52: Method := COMPRESSMETHODGOOD;
53: Method := COMPRESSMETHODBEST;
end;
// Checking File Attributes
FAArchive := (hdrData.FileAttr and FILE_ATTRIBUTE_ARCHIVE) > 0;
FACompressed := (hdrData.FileAttr and FILE_ATTRIBUTE_COMPRESSED) > 0;
FADirectory := (hdrData.FileAttr and FILE_ATTRIBUTE_DIRECTORY) > 0;
FAHidden := (hdrData.FileAttr and FILE_ATTRIBUTE_HIDDEN) > 0;
FANormal := (hdrData.FileAttr and FILE_ATTRIBUTE_NORMAL) > 0;
FAOffLine := (hdrData.FileAttr and FILE_ATTRIBUTE_OFFLINE) > 0;
FAReadOnly := (hdrData.FileAttr and FILE_ATTRIBUTE_READONLY) > 0;
FASystem := (hdrData.FileAttr and FILE_ATTRIBUTE_SYSTEM) > 0;
FATempporary := (hdrData.FileAttr and FILE_ATTRIBUTE_TEMPORARY) > 0;
end;
end;
constructor TDFUnRar.Create(AOwner: TComponent);
begin
inherited;
LoadRarLibrary;
IsLoaded := IsRarLoaded;
if IsLoaded then
FDllVersion := RARGetDllversion;
FFileList := TStringList.Create;
end;
destructor TDFUnRar.Destroy;
begin
if IsLoaded then
UnLoadRarLibrary;
FFileList.Free;
inherited;
end;
procedure TDFUnRar.DoError(Message: string; MessageID: Integer);
begin
if assigned(FOnError) then
FOnError(self, Message, MessageID);
end;
procedure TDFUnRar.DoStatus(Message: string; status: TRarStatus);
begin
if assigned(FOnRarStatus) then
FOnRarStatus(self, Message, status);
end;
function TDFUnRar.DoUnRarCallBack(msg: Cardinal; UserData, P1,
P2: Integer): integer;
var
UnRarRef: TDFUnRar;
FileName: string;
// Size: Integer;
Passwd: string;
begin
UnRarRef := TDFUnRar(MySelf);
case msg of
UCM_CHANGEVOLUME: begin
FileName := StrPas(Pointer(P1));
case P2 of
RAR_VOL_ASK: begin
// >= 0 => Weiter, -1 => Stop
Result := 0;
if assigned(FOnVolChange) then
FOnVolChange(self, Pointer(P1), RAR_VOL_ASK)
else if FPromptForVolumn then
begin
if ShowPromptDialog(StrPas(hdrData.ArcName), Pointer(P1)) then
begin
if StrPas(hdrData.ArcName) = StrPas(Pointer(P1)) then
Result := -1
else
Result := 0
end
else
Result := -1;
end;
if StrPas(Pointer(P1)) = '' then
Result := -1;
end;
RAR_VOL_NOTIFY: begin
// if assigned(FOnVolChange) then
// FOnVolChange(self, nil, RAR_VOL_NOTIFY);
// >= 0 => Weiter, -1 => Stop
Result := 0;
end;
end;
end;
UCM_NEEDPASSWORD: begin
Passwd := Password;
if assigned(FOnPassword) then
FOnPassword(self, Passwd)
else if FPromptForPass then
begin
ShowPasswordDialog(Passwd);
end
else
DoError(MSG2, 0);
StrPCopy(Pointer(P1), Copy(Passwd, 1, P2));
DoStatus(MSG3 + Password, RAR_ONPASSWORD);
end;
UCM_PROCESSDATA: begin
// >= 0 => Weiter, -1 => Stop
// never used - use OnFileProcessing instead
// Size := P2;
if UnRarRef.StopProcessing then
Result := -1
else
Result := 0;
end;
end;
if UnRarRef.StopProcessing then
Result := -1;
end;
procedure TDFUnRar.Extract;
var
ReadFileHeaderResult: integer;
ReadFileResult: Integer;
begin
StopProcessing := false;
if not IsLoaded then
begin
DoError(MSG4, 0);
exit;
end;
FFilesProcessed := 0;
FSizeProcessed := 0;
if FCanProgress then
CalcProgress;
MySelf := self;
InitRAROpenArchiveStruct;
if FStopProcessing then
exit;
OpenRARArchive;
try
if FStopProcessing then
exit;
RARSetCallback(ArchiveHandle, UnRarCallBack, 0);
SetRARPassword;
ReadFileResult := RAR_SUCCESS;
repeat
ReadFileHeaderResult := RARReadHeader(ArchiveHandle, @hdrData);
if ReadFileHeaderResult = ERAR_END_ARCHIVE then
break;
ProcessFileHeader(ReadFileHeaderResult);
if FStopProcessing then
exit;
if ReadFileHeaderResult = RAR_SUCCESS then
ReadFileResult := ProcessFile(ArchiveHandle, RAROpenMode, PChar(Directory), nil);
case ReadFileResult of
ERAR_BAD_DATA : DoError(MSG5, ERAR_BAD_DATA);
ERAR_BAD_ARCHIVE : DoError(MSG6, ERAR_BAD_ARCHIVE);
ERAR_UNKNOWN_FORMAT : DoError(MSG7, ERAR_UNKNOWN_FORMAT);
ERAR_EOPEN : DoError(MSG8, ERAR_EOPEN);
ERAR_ECREATE : DoError(MSG9, ERAR_ECREATE);
ERAR_ECLOSE : DoError(MSG10, ERAR_ECLOSE);
ERAR_EREAD : DoError(MSG11, ERAR_EREAD);
ERAR_EWRITE : DoError(MSG12, ERAR_EWRITE);
end;
if StopProcessing then
exit;
// alternativ y can try to unpack the next file and check only for ERAR_END_ARCHIVE
until (ReadFileResult <> RAR_SUCCESS);
finally
CloseRARArchive;
end;
end;
// Init Open
procedure TDFUnRar.InitRAROpenArchiveStruct;
begin
CommentResult := 0;
with openArchiveStruc do
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -