mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
942 lines
29 KiB
ObjectPascal
942 lines
29 KiB
ObjectPascal
{
|
|
Double commander
|
|
-------------------------------------------------------------------------
|
|
Archive File support - class for manage WCX plugins (Version 2.20)
|
|
|
|
Copyright (C) 2006-2024 Alexander Koblov (alexx2000@mail.ru)
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
}
|
|
|
|
unit uWCXmodule;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$include calling.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLType, Classes, Dialogs, DCClassesUtf8, dynlibs, SysUtils, uExtension,
|
|
uWCXprototypes, WcxPlugin, Extension, DCBasicTypes, DCXmlConfig, uClassesEx;
|
|
|
|
Type
|
|
TWCXOperation = (OP_EXTRACT, OP_PACK, OP_DELETE);
|
|
|
|
{ EWcxModuleException }
|
|
|
|
EWcxModuleException = class(EOSError)
|
|
public
|
|
constructor Create(AErrorCode: Integer);
|
|
end;
|
|
|
|
{ TWCXHeaderData }
|
|
|
|
{ Handles THeaderData and THeaderDataEx }
|
|
TWCXHeader = class(TObjectEx)
|
|
private
|
|
FileTime: LongInt;
|
|
FDateTime: TDateTime;
|
|
FNanoTime: TWinFileTime;
|
|
private
|
|
function GetDateTime: TDateTime;
|
|
function PCharLToUTF8(CharString: PChar; MaxSize: Integer): String;
|
|
public
|
|
ArcName: String;
|
|
FileName: String;
|
|
Flags,
|
|
HostOS,
|
|
FileCRC,
|
|
UnpVer,
|
|
Method: Longint;
|
|
FileAttr: TFileAttrs;
|
|
PackSize,
|
|
UnpSize: Int64;
|
|
Cmt: String;
|
|
CmtState: Longint;
|
|
|
|
function Clone: TWCXHeader; override;
|
|
|
|
constructor Create(const Data: PHeaderData); overload;
|
|
constructor Create(const Data: PHeaderDataEx); overload;
|
|
constructor Create(const Data: PHeaderDataExW); overload;
|
|
constructor Create; overload; // allows creating empty record
|
|
|
|
property DateTime: TDateTime read GetDateTime write FDateTime;
|
|
end;
|
|
|
|
|
|
{ TWcxModule }
|
|
|
|
TWcxModule = class(TDcxModule)
|
|
private
|
|
FModuleName: String;
|
|
FBackgroundFlags: Integer;
|
|
|
|
public
|
|
// module's functions
|
|
{ Mandatory }
|
|
OpenArchive : TOpenArchive;
|
|
ReadHeader : TReadHeader;
|
|
ProcessFile : TProcessFile;
|
|
CloseArchive : TCloseArchive;
|
|
{ Optional }
|
|
ReadHeaderEx : TReadHeaderEx;
|
|
PackFiles : TPackFiles;
|
|
DeleteFiles : TDeleteFiles;
|
|
GetPackerCaps : TGetPackerCaps;
|
|
ConfigurePacker : TConfigurePacker;
|
|
SetChangeVolProc : TSetChangeVolProc;
|
|
SetProcessDataProc : TSetProcessDataProc;
|
|
StartMemPack : TStartMemPack;
|
|
PackToMem : TPackToMem;
|
|
DoneMemPack : TDoneMemPack;
|
|
CanYouHandleThisFile : TCanYouHandleThisFile;
|
|
PackSetDefaultParams : TPackSetDefaultParams;
|
|
PkSetCryptCallback : TPkSetCryptCallback;
|
|
GetBackgroundFlags: TGetBackgroundFlags;
|
|
{ Unicode }
|
|
OpenArchiveW: TOpenArchiveW;
|
|
ReadHeaderExW: TReadHeaderExW;
|
|
ProcessFileW: TProcessFileW;
|
|
SetChangeVolProcW: TSetChangeVolProcW;
|
|
SetProcessDataProcW:TSetProcessDataProcW;
|
|
PackFilesW: TPackFilesW;
|
|
DeleteFilesW: TDeleteFilesW;
|
|
StartMemPackW: TStartMemPackW;
|
|
CanYouHandleThisFileW: TCanYouHandleThisFileW;
|
|
PkSetCryptCallbackW : TPkSetCryptCallbackW;
|
|
{ Extension API }
|
|
ExtensionInitialize: TExtensionInitializeProc;
|
|
ExtensionFinalize: TExtensionFinalizeProc;
|
|
|
|
private
|
|
function LoadModule(const sName:String):Boolean; {Load WCX plugin}
|
|
procedure UnloadModule; {UnLoad WCX plugin}
|
|
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
|
|
{ Reads WCX header using ReadHeaderEx if available or ReadHeader. }
|
|
function ReadWCXHeader(hArcData: TArcHandle;
|
|
out HeaderData: TWCXHeader): Integer;
|
|
|
|
function OpenArchiveHandle(FileName: String; anOpenMode: Longint; out OpenResult: Longint): TArcHandle;
|
|
function WcxProcessFile(hArcData: TArcHandle; Operation: LongInt; DestPath, DestName: String): LongInt;
|
|
function WcxPackFiles(PackedFile, SubPath, SrcPath, AddList: String; Flags: LongInt): LongInt;
|
|
function WcxDeleteFiles(PackedFile, DeleteList: String): LongInt;
|
|
function WcxCanYouHandleThisFile(FileName: String): LongBool;
|
|
function WcxStartMemPack(Options: LongInt; FileName: String): TArcHandle;
|
|
procedure WcxSetChangeVolProc(hArcData: TArcHandle); overload;
|
|
procedure WcxSetChangeVolProc(hArcData: TArcHandle; ChangeVolProcA: TChangeVolProc; ChangeVolProcW: TChangeVolProcW); overload;
|
|
procedure WcxSetProcessDataProc(hArcData: TArcHandle; ProcessDataProcA: TProcessDataProc; ProcessDataProcW: TProcessDataProcW);
|
|
procedure WcxSetCryptCallback(CryptoNr, Flags: Integer; PkCryptProcA: TPkCryptProc; PkCryptProcW: TPkCryptProcW);
|
|
|
|
procedure VFSConfigure(Parent: HWND);
|
|
function GetPluginCapabilities: Integer;
|
|
|
|
function IsLoaded: Boolean;
|
|
|
|
property ModuleName: String read FModuleName;
|
|
property BackgroundFlags: Integer read FBackgroundFlags write FBackgroundFlags;
|
|
end;
|
|
|
|
{ TWCXModuleList }
|
|
|
|
TWCXModuleList = class(TStringList)
|
|
private
|
|
FModuleList: TStringListEx;
|
|
private
|
|
function GetAEnabled(Index: Integer): Boolean;
|
|
function GetAExt(Index: Integer): String;
|
|
function GetAFileName(Index: Integer): String;
|
|
function GetAFlags(Index: Integer): PtrInt;
|
|
procedure SetAEnabled(Index: Integer; const AValue: Boolean);
|
|
procedure SetAFileName(Index: Integer; const AValue: String);
|
|
procedure SetAFlags(Index: Integer; const AValue: PtrInt);
|
|
procedure SetExt(Index: Integer; const AValue: String);
|
|
public
|
|
constructor Create; reintroduce;
|
|
destructor Destroy; override;
|
|
public
|
|
procedure Load(AConfig: TXmlConfig; ANode: TXmlNode);
|
|
procedure Save(AConfig: TXmlConfig; ANode: TXmlNode);
|
|
function ComputeSignature(seed: dword): dword;
|
|
function Add(Ext: String; Flags: PtrInt; FileName: String): Integer; reintroduce;
|
|
function Add(Ext: String; Flags: PtrInt; AEnabled: Boolean; FileName: String): Integer; reintroduce;
|
|
function FindFirstEnabledByName(Name: String): Integer;
|
|
function Find(const aFileName, aExt: String): Integer; overload;
|
|
function LoadModule(const FileName: String): TWcxModule;
|
|
|
|
property FileName[Index: Integer]: String read GetAFileName write SetAFileName;
|
|
property Flags[Index: Integer]: PtrInt read GetAFlags write SetAFlags;
|
|
property Ext[Index: Integer]: String read GetAExt write SetExt;
|
|
property Enabled[Index: Integer]: Boolean read GetAEnabled write SetAEnabled;
|
|
end;
|
|
|
|
function GetErrorMsg(iErrorMsg : Integer): String;
|
|
|
|
implementation
|
|
|
|
uses
|
|
//Lazarus, Free-Pascal, etc.
|
|
SysConst, LazUTF8, FileUtil,
|
|
|
|
//DC
|
|
uDCUtils, uComponentsSignature, uGlobsPaths, uLng, uOSUtils, DCOSUtils, uOSForms,
|
|
DCDateTimeUtils, DCConvertEncoding, fDialogBox, uDebug, uShowMsg, uLog, uGlobs;
|
|
|
|
const
|
|
WcxIniFileName = 'wcx.ini';
|
|
|
|
function ChangeVolProc(var ArcName : String; Mode: LongInt): LongInt;
|
|
begin
|
|
Result:= 1;
|
|
case Mode of
|
|
PK_VOL_ASK:
|
|
begin
|
|
if not ShowInputQuery('Double Commander', rsMsgSelLocNextVol, ArcName) then
|
|
Result := 0; // Abort operation
|
|
end;
|
|
PK_VOL_NOTIFY:
|
|
if log_arc_op in gLogOptions then
|
|
LogWrite(rsMsgNextVolUnpack + #32 + ArcName);
|
|
end;
|
|
end;
|
|
|
|
function ChangeVolProcA(ArcName : PAnsiChar; Mode: LongInt): LongInt; dcpcall;
|
|
var
|
|
sArcName: String;
|
|
begin
|
|
sArcName:= CeSysToUtf8(StrPas(ArcName));
|
|
Result:= ChangeVolProc(sArcName, Mode);
|
|
if (Mode = PK_VOL_ASK) and (Result <> 0) then
|
|
StrPLCopy(ArcName, CeUtf8ToSys(sArcName), MAX_PATH);
|
|
end;
|
|
|
|
function ChangeVolProcW(ArcName : PWideChar; Mode: LongInt): LongInt; dcpcall;
|
|
var
|
|
sArcName: String;
|
|
begin
|
|
sArcName:= UTF16ToUTF8(UnicodeString(ArcName));
|
|
Result:= ChangeVolProc(sArcName, Mode);
|
|
if (Mode = PK_VOL_ASK) and (Result <> 0) then
|
|
StrPLCopy(ArcName, CeUtf8ToUtf16(sArcName), MAX_PATH);
|
|
end;
|
|
|
|
{ EWcxModuleException }
|
|
|
|
constructor EWcxModuleException.Create(AErrorCode: Integer);
|
|
begin
|
|
ErrorCode:= AErrorCode;
|
|
inherited Create(GetErrorMsg(ErrorCode));
|
|
end;
|
|
|
|
constructor TWcxModule.Create;
|
|
begin
|
|
FModuleHandle := 0;
|
|
end;
|
|
|
|
destructor TWcxModule.Destroy;
|
|
begin
|
|
if IsLoaded then
|
|
begin
|
|
if Assigned(ExtensionFinalize) then
|
|
ExtensionFinalize(nil);
|
|
//------------------------------------------------------
|
|
UnloadModule;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TWcxModule.OpenArchiveHandle(FileName: String; anOpenMode: Longint; out OpenResult: Longint): TArcHandle;
|
|
var
|
|
ArcFile: tOpenArchiveData;
|
|
ArcFileW: tOpenArchiveDataW;
|
|
AnsiFileName: AnsiString;
|
|
WideFileName: WideString;
|
|
begin
|
|
if (anOpenMode >= PK_OM_LIST) and (anOpenMode <= PK_OM_EXTRACT) then
|
|
begin
|
|
if Assigned(OpenArchiveW) then
|
|
begin
|
|
FillChar(ArcFileW, SizeOf(ArcFileW), #0);
|
|
WideFileName := CeUtf8ToUtf16(FileName);
|
|
ArcFileW.ArcName := PWideChar(WideFileName); // Pointer to local variable.
|
|
ArcFileW.OpenMode := anOpenMode;
|
|
Result := OpenArchiveW(ArcFileW);
|
|
if Result = 0 then
|
|
OpenResult := ArcFileW.OpenResult
|
|
else
|
|
OpenResult := E_SUCCESS;
|
|
end
|
|
else if Assigned(OpenArchive) then
|
|
begin
|
|
FillChar(ArcFile, SizeOf(ArcFile), #0);
|
|
AnsiFileName := mbFileNameToSysEnc(FileName);
|
|
ArcFile.ArcName := PAnsiChar(AnsiFileName); // Pointer to local variable.
|
|
ArcFile.OpenMode := anOpenMode;
|
|
Result := OpenArchive(ArcFile);
|
|
if Result = 0 then
|
|
OpenResult := ArcFile.OpenResult
|
|
else
|
|
OpenResult := E_SUCCESS;
|
|
end;
|
|
end
|
|
else
|
|
raise Exception.Create('Invalid WCX open mode');
|
|
end;
|
|
|
|
function TWcxModule.WcxProcessFile(hArcData: TArcHandle; Operation: LongInt;
|
|
DestPath, DestName: String): LongInt;
|
|
begin
|
|
if Assigned(ProcessFileW) then
|
|
begin
|
|
if DestPath = EmptyStr then
|
|
Result:= ProcessFileW(hArcData, Operation, nil, PWideChar(CeUtf8ToUtf16(DestName)))
|
|
else
|
|
Result:= ProcessFileW(hArcData, Operation, PWideChar(CeUtf8ToUtf16(DestPath)), PWideChar(CeUtf8ToUtf16(DestName)));
|
|
end
|
|
else if Assigned(ProcessFile) then
|
|
begin
|
|
if DestPath = EmptyStr then
|
|
Result:= ProcessFile(hArcData, Operation, nil, PAnsiChar(CeUtf8ToSys(DestName)))
|
|
else
|
|
Result:= ProcessFile(hArcData, Operation, PAnsiChar(CeUtf8ToSys(DestPath)), PAnsiChar(CeUtf8ToSys(DestName)));
|
|
end;
|
|
end;
|
|
|
|
function TWcxModule.WcxPackFiles(PackedFile, SubPath, SrcPath,
|
|
AddList: String; Flags: LongInt): LongInt;
|
|
begin
|
|
if Assigned(PackFilesW) then
|
|
begin
|
|
if SubPath = EmptyStr then
|
|
Result:= PackFilesW(PWideChar(CeUtf8ToUtf16(PackedFile)), nil,
|
|
PWideChar(CeUtf8ToUtf16(SrcPath)), PWideChar(CeUtf8ToUtf16(AddList)), Flags)
|
|
else
|
|
Result:= PackFilesW(PWideChar(CeUtf8ToUtf16(PackedFile)), PWideChar(CeUtf8ToUtf16(SubPath)),
|
|
PWideChar(CeUtf8ToUtf16(SrcPath)), PWideChar(CeUtf8ToUtf16(AddList)), Flags);
|
|
end
|
|
else if Assigned(PackFiles) then
|
|
begin
|
|
if SubPath = EmptyStr then
|
|
Result:= PackFiles(PAnsiChar(CeUtf8ToSys(PackedFile)), nil,
|
|
PAnsiChar(CeUtf8ToSys(SrcPath)), PAnsiChar(CeUtf8ToSys(AddList)), Flags)
|
|
else
|
|
Result:= PackFiles(PAnsiChar(CeUtf8ToSys(PackedFile)), PAnsiChar(CeUtf8ToSys(SubPath)),
|
|
PAnsiChar(CeUtf8ToSys(SrcPath)), PAnsiChar(CeUtf8ToSys(AddList)), Flags);
|
|
end;
|
|
end;
|
|
|
|
function TWcxModule.WcxDeleteFiles(PackedFile, DeleteList: String): LongInt;
|
|
begin
|
|
if Assigned(DeleteFilesW) then
|
|
Result:= DeleteFilesW(PWideChar(CeUtf8ToUtf16(PackedFile)), PWideChar(CeUtf8ToUtf16(DeleteList)))
|
|
else if Assigned(DeleteFiles) then
|
|
Result:= DeleteFiles(PAnsiChar(CeUtf8ToSys(PackedFile)), PAnsiChar(CeUtf8ToSys(DeleteList)));
|
|
end;
|
|
|
|
function TWcxModule.WcxCanYouHandleThisFile(FileName: String): LongBool;
|
|
begin
|
|
if Assigned(CanYouHandleThisFileW) then
|
|
Result:= CanYouHandleThisFileW(PWideChar(CeUtf8ToUtf16(FileName)))
|
|
else if Assigned(CanYouHandleThisFile) then
|
|
Result:= CanYouHandleThisFile(PAnsiChar(CeUtf8ToSys(FileName)))
|
|
else
|
|
Result:= True;
|
|
end;
|
|
|
|
function TWcxModule.WcxStartMemPack(Options: LongInt; FileName: String): TArcHandle;
|
|
begin
|
|
if Assigned(StartMemPackW) then
|
|
Result:= StartMemPackW(Options, PWideChar(CeUtf8ToUtf16(FileName)))
|
|
else if Assigned(StartMemPack) then
|
|
Result:= StartMemPack(Options, PAnsiChar(CeUtf8ToSys(FileName)));
|
|
end;
|
|
|
|
procedure TWcxModule.WcxSetChangeVolProc(hArcData: TArcHandle);
|
|
begin
|
|
WcxSetChangeVolProc(hArcData, @ChangeVolProcA, @ChangeVolProcW);
|
|
end;
|
|
|
|
procedure TWcxModule.WcxSetChangeVolProc(hArcData: TArcHandle;
|
|
ChangeVolProcA: TChangeVolProc; ChangeVolProcW: TChangeVolProcW);
|
|
begin
|
|
if Assigned(SetChangeVolProcW) then
|
|
SetChangeVolProcW(hArcData, ChangeVolProcW);
|
|
if Assigned(SetChangeVolProc) then
|
|
SetChangeVolProc(hArcData, ChangeVolProcA);
|
|
end;
|
|
|
|
procedure TWcxModule.WcxSetProcessDataProc(hArcData: TArcHandle;
|
|
ProcessDataProcA: TProcessDataProc; ProcessDataProcW: TProcessDataProcW);
|
|
begin
|
|
if Assigned(SetProcessDataProcW) then
|
|
SetProcessDataProcW(hArcData, ProcessDataProcW);
|
|
if Assigned(SetProcessDataProc) then
|
|
SetProcessDataProc(hArcData, ProcessDataProcA);
|
|
end;
|
|
|
|
procedure TWcxModule.WcxSetCryptCallback(CryptoNr, Flags: Integer;
|
|
PkCryptProcA: TPkCryptProc; PkCryptProcW: TPkCryptProcW);
|
|
begin
|
|
if Assigned(PkSetCryptCallbackW) then
|
|
PkSetCryptCallbackW(PkCryptProcW, CryptoNr, Flags);
|
|
if Assigned(PkSetCryptCallback) then
|
|
PkSetCryptCallback(PkCryptProcA, CryptoNr, Flags);
|
|
end;
|
|
|
|
function TWcxModule.LoadModule(const sName:String):Boolean;
|
|
var
|
|
StartupInfo: TExtensionStartupInfo;
|
|
PackDefaultParamStruct : TPackDefaultParamStruct;
|
|
begin
|
|
if FModuleHandle <> 0 then Exit(True);
|
|
FModuleName := ExtractFileName(sName);
|
|
FModulePath := mbExpandFileName(sName);
|
|
FModuleHandle := mbLoadLibrary(FModulePath);
|
|
if FModuleHandle = 0 then Exit(False);
|
|
|
|
DCDebug('WCX module loaded ' + sName + ' at ' + hexStr(Pointer(FModuleHandle)));
|
|
|
|
// Mandatory functions
|
|
OpenArchive:= TOpenArchive(GetProcAddress(FModuleHandle,'OpenArchive'));
|
|
ReadHeader:= TReadHeader(GetProcAddress(FModuleHandle,'ReadHeader'));
|
|
ReadHeaderEx:= TReadHeaderEx(GetProcAddress(FModuleHandle,'ReadHeaderEx'));
|
|
ProcessFile:= TProcessFile(GetProcAddress(FModuleHandle,'ProcessFile'));
|
|
CloseArchive:= TCloseArchive(GetProcAddress(FModuleHandle,'CloseArchive'));
|
|
// Unicode
|
|
OpenArchiveW:= TOpenArchiveW(GetProcAddress(FModuleHandle,'OpenArchiveW'));
|
|
ReadHeaderExW:= TReadHeaderExW(GetProcAddress(FModuleHandle,'ReadHeaderExW'));
|
|
ProcessFileW:= TProcessFileW(GetProcAddress(FModuleHandle,'ProcessFileW'));
|
|
|
|
Result:= (OpenArchive <> nil) and (ReadHeader <> nil) and (ProcessFile <> nil);
|
|
if (Result = False) then
|
|
begin
|
|
OpenArchive:= nil;
|
|
ReadHeader:= nil;
|
|
ProcessFile:= nil;
|
|
Result:= (OpenArchiveW <> nil) and (ReadHeaderExW <> nil) and (ProcessFileW <> nil);
|
|
end;
|
|
|
|
if (Result = False) or (CloseArchive = nil) then
|
|
begin
|
|
OpenArchiveW:= nil;
|
|
ReadHeaderExW:= nil;
|
|
ProcessFileW:= nil;
|
|
CloseArchive:= nil;
|
|
Exit(False);
|
|
end;
|
|
|
|
// Optional functions
|
|
PackFiles:= TPackFiles(GetProcAddress(FModuleHandle,'PackFiles'));
|
|
DeleteFiles:= TDeleteFiles(GetProcAddress(FModuleHandle,'DeleteFiles'));
|
|
GetPackerCaps:= TGetPackerCaps(GetProcAddress(FModuleHandle,'GetPackerCaps'));
|
|
ConfigurePacker:= TConfigurePacker(GetProcAddress(FModuleHandle,'ConfigurePacker'));
|
|
SetChangeVolProc:= TSetChangeVolProc(GetProcAddress(FModuleHandle,'SetChangeVolProc'));
|
|
SetProcessDataProc:= TSetProcessDataProc(GetProcAddress(FModuleHandle,'SetProcessDataProc'));
|
|
StartMemPack:= TStartMemPack(GetProcAddress(FModuleHandle,'StartMemPack'));
|
|
PackToMem:= TPackToMem(GetProcAddress(FModuleHandle,'PackToMem'));
|
|
DoneMemPack:= TDoneMemPack(GetProcAddress(FModuleHandle,'DoneMemPack'));
|
|
CanYouHandleThisFile:= TCanYouHandleThisFile(GetProcAddress(FModuleHandle,'CanYouHandleThisFile'));
|
|
PackSetDefaultParams:= TPackSetDefaultParams(GetProcAddress(FModuleHandle,'PackSetDefaultParams'));
|
|
PkSetCryptCallback:= TPkSetCryptCallback(GetProcAddress(FModuleHandle,'PkSetCryptCallback'));
|
|
GetBackgroundFlags:= TGetBackgroundFlags(GetProcAddress(FModuleHandle,'GetBackgroundFlags'));
|
|
// Unicode
|
|
SetChangeVolProcW:= TSetChangeVolProcW(GetProcAddress(FModuleHandle,'SetChangeVolProcW'));
|
|
SetProcessDataProcW:= TSetProcessDataProcW(GetProcAddress(FModuleHandle,'SetProcessDataProcW'));
|
|
PackFilesW:= TPackFilesW(GetProcAddress(FModuleHandle,'PackFilesW'));
|
|
DeleteFilesW:= TDeleteFilesW(GetProcAddress(FModuleHandle,'DeleteFilesW'));
|
|
StartMemPackW:= TStartMemPackW(GetProcAddress(FModuleHandle,'StartMemPackW'));
|
|
CanYouHandleThisFileW:= TCanYouHandleThisFileW(GetProcAddress(FModuleHandle,'CanYouHandleThisFileW'));
|
|
PkSetCryptCallbackW:= TPkSetCryptCallbackW(GetProcAddress(FModuleHandle,'PkSetCryptCallbackW'));
|
|
// Extension API
|
|
ExtensionInitialize:= TExtensionInitializeProc(GetProcAddress(FModuleHandle,'ExtensionInitialize'));
|
|
ExtensionFinalize:= TExtensionFinalizeProc(GetProcAddress(FModuleHandle,'ExtensionFinalize'));
|
|
|
|
if Assigned(PackSetDefaultParams) then
|
|
begin
|
|
with PackDefaultParamStruct do
|
|
begin
|
|
Size := SizeOf(PackDefaultParamStruct);
|
|
PluginInterfaceVersionLow := 22;
|
|
PluginInterfaceVersionHi := 2;
|
|
DefaultIniName := mbFileNameToSysEnc(gpCfgDir + WcxIniFileName);
|
|
end;
|
|
PackSetDefaultParams(@PackDefaultParamStruct);
|
|
end;
|
|
|
|
if not Assigned(GetBackgroundFlags) then
|
|
FBackgroundFlags:= 0
|
|
else
|
|
FBackgroundFlags:= GetBackgroundFlags();
|
|
|
|
// Extension API
|
|
if Assigned(ExtensionInitialize) then
|
|
begin
|
|
InitializeExtension(@StartupInfo);
|
|
|
|
ExtensionInitialize(@StartupInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure TWcxModule.UnloadModule;
|
|
begin
|
|
if FModuleHandle <> NilHandle then
|
|
begin
|
|
FreeLibrary(FModuleHandle);
|
|
FModuleHandle := NilHandle;
|
|
end;
|
|
// Mandatory
|
|
OpenArchive:= nil;
|
|
ReadHeader:= nil;
|
|
ReadHeaderEx:= nil;
|
|
ProcessFile:= nil;
|
|
CloseArchive:= nil;
|
|
// Optional
|
|
PackFiles:= nil;
|
|
DeleteFiles:= nil;
|
|
GetPackerCaps:= nil;
|
|
ConfigurePacker:= nil;
|
|
SetChangeVolProc:= nil;
|
|
SetProcessDataProc:= nil;
|
|
StartMemPack:= nil;
|
|
PackToMem:= nil;
|
|
DoneMemPack:= nil;
|
|
CanYouHandleThisFile:= nil;
|
|
PackSetDefaultParams:= nil;
|
|
PkSetCryptCallback:= nil;
|
|
GetBackgroundFlags:= nil;
|
|
// Unicode
|
|
OpenArchiveW:= nil;
|
|
ReadHeaderExW:= nil;
|
|
ProcessFileW:= nil;
|
|
SetChangeVolProcW:= nil;
|
|
SetProcessDataProcW:= nil;
|
|
PackFilesW:= nil;
|
|
DeleteFilesW:= nil;
|
|
StartMemPackW:= nil;
|
|
CanYouHandleThisFileW:= nil;
|
|
PkSetCryptCallbackW:= nil;
|
|
// Extension API
|
|
ExtensionInitialize:= nil;
|
|
ExtensionFinalize:= nil;
|
|
end;
|
|
|
|
function GetErrorMsg(iErrorMsg : Integer): String;
|
|
begin
|
|
case iErrorMsg of
|
|
E_END_ARCHIVE : Result := rsMsgErrEndArchive;
|
|
E_NO_MEMORY : Result := rsMsgErrNoMemory;
|
|
E_BAD_DATA : Result := rsMsgErrBadData;
|
|
E_BAD_ARCHIVE : Result := rsMsgErrBadArchive;
|
|
E_UNKNOWN_FORMAT : Result := rsMsgErrUnknownFormat;
|
|
E_EOPEN : Result := rsMsgErrEOpen;
|
|
E_ECREATE : Result := rsMsgErrECreate;
|
|
E_ECLOSE : Result := rsMsgErrEClose;
|
|
E_EREAD : Result := rsMsgErrERead;
|
|
E_EWRITE : Result := rsMsgErrEWrite;
|
|
E_SMALL_BUF : Result := rsMsgErrSmallBuf;
|
|
E_EABORTED : Result := rsMsgErrEAborted;
|
|
E_NO_FILES : Result := rsMsgErrNoFiles;
|
|
E_TOO_MANY_FILES : Result := rsMsgErrTooManyFiles;
|
|
E_NOT_SUPPORTED : Result := rsMsgErrNotSupported;
|
|
else Result := Format(SUnknownErrorCode, [iErrorMsg]);
|
|
end;
|
|
end;
|
|
|
|
procedure TWcxModule.VFSConfigure(Parent: HWND);
|
|
begin
|
|
if Assigned(ConfigurePacker) then
|
|
ConfigurePacker(GetWindowHandle(Parent), FModuleHandle);
|
|
end;
|
|
|
|
function TWcxModule.ReadWCXHeader(hArcData: TArcHandle;
|
|
out HeaderData: TWCXHeader): Integer;
|
|
var
|
|
ArcHeader : THeaderData;
|
|
ArcHeaderEx : THeaderDataEx;
|
|
ArcHeaderExW : THeaderDataExW;
|
|
begin
|
|
HeaderData := nil;
|
|
|
|
if Assigned(ReadHeaderExW) then
|
|
begin
|
|
FillChar(ArcHeaderExW, SizeOf(ArcHeaderExW), #0);
|
|
Result := ReadHeaderExW(hArcData, ArcHeaderExW);
|
|
if Result = E_SUCCESS then
|
|
begin
|
|
HeaderData := TWCXHeader.Create(PHeaderDataExW(@ArcHeaderExW));
|
|
end;
|
|
end
|
|
else if Assigned(ReadHeaderEx) then
|
|
begin
|
|
FillChar(ArcHeaderEx, SizeOf(ArcHeaderEx), #0);
|
|
Result := ReadHeaderEx(hArcData, ArcHeaderEx);
|
|
if Result = E_SUCCESS then
|
|
begin
|
|
HeaderData := TWCXHeader.Create(PHeaderDataEx(@ArcHeaderEx));
|
|
end;
|
|
end
|
|
else if Assigned(ReadHeader) then
|
|
begin
|
|
FillChar(ArcHeader, SizeOf(ArcHeader), #0);
|
|
Result := ReadHeader(hArcData, ArcHeader);
|
|
if Result = E_SUCCESS then
|
|
begin
|
|
HeaderData := TWCXHeader.Create(PHeaderData(@ArcHeader));
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Result := E_NOT_SUPPORTED;
|
|
end;
|
|
end;
|
|
|
|
function TWcxModule.GetPluginCapabilities: Integer;
|
|
begin
|
|
if Assigned(GetPackerCaps) then
|
|
Result := GetPackerCaps()
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TWcxModule.IsLoaded: Boolean;
|
|
begin
|
|
Result := (FModuleHandle <> NilHandle);
|
|
end;
|
|
|
|
{ TWCXModuleList }
|
|
|
|
function TWCXModuleList.GetAEnabled(Index: Integer): Boolean;
|
|
begin
|
|
Result:= Boolean(PtrInt(Objects[Index]));
|
|
end;
|
|
|
|
function TWCXModuleList.GetAExt(Index: Integer): String;
|
|
begin
|
|
Result:= Names[Index];
|
|
end;
|
|
|
|
function TWCXModuleList.GetAFileName(Index: Integer): String;
|
|
var
|
|
sCurrPlugin: String;
|
|
iPosComma : Integer;
|
|
begin
|
|
sCurrPlugin:= ValueFromIndex[Index];
|
|
iPosComma:= Pos(',', sCurrPlugin);
|
|
//get file name
|
|
Result:= Copy(sCurrPlugin, iPosComma + 1, Length(sCurrPlugin) - iPosComma);
|
|
end;
|
|
|
|
function TWCXModuleList.GetAFlags(Index: Integer): PtrInt;
|
|
var
|
|
sCurrPlugin: String;
|
|
iPosComma : Integer;
|
|
begin
|
|
sCurrPlugin:= ValueFromIndex[Index];
|
|
iPosComma:= Pos(',', sCurrPlugin);
|
|
// get packer flags
|
|
Result:= StrToInt(Copy(sCurrPlugin, 1, iPosComma-1));
|
|
end;
|
|
|
|
procedure TWCXModuleList.SetAEnabled(Index: Integer; const AValue: Boolean);
|
|
begin
|
|
Objects[Index]:= TObject(PtrInt(AValue));
|
|
end;
|
|
|
|
procedure TWCXModuleList.SetAFileName(Index: Integer; const AValue: String);
|
|
begin
|
|
ValueFromIndex[Index]:= IntToStr(GetAFlags(Index)) + #44 + AValue;
|
|
end;
|
|
|
|
procedure TWCXModuleList.SetAFlags(Index: Integer; const AValue: PtrInt);
|
|
begin
|
|
ValueFromIndex[Index]:= IntToStr(AValue) + #44 + GetAFileName(Index);
|
|
end;
|
|
|
|
procedure TWCXModuleList.SetExt(Index: Integer; const AValue: String);
|
|
var
|
|
sValue : String;
|
|
begin
|
|
sValue:= ValueFromIndex[Index];
|
|
Self[Index]:= AValue + '=' + sValue;
|
|
end;
|
|
|
|
constructor TWCXModuleList.Create;
|
|
begin
|
|
FModuleList:= TStringListEx.Create;
|
|
FModuleList.Sorted:= True;
|
|
end;
|
|
|
|
destructor TWCXModuleList.Destroy;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I:= 0 to FModuleList.Count - 1 do
|
|
begin
|
|
TWcxModule(FModuleList.Objects[I]).Free;
|
|
end;
|
|
FreeAndNil(FModuleList);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TWCXModuleList.Load(AConfig: TXmlConfig; ANode: TXmlNode);
|
|
var
|
|
I: Integer;
|
|
AExt, APath: String;
|
|
AFlags: Integer;
|
|
begin
|
|
Clear;
|
|
|
|
ANode := ANode.FindNode('WcxPlugins');
|
|
if Assigned(ANode) then
|
|
begin
|
|
ANode := ANode.FirstChild;
|
|
while Assigned(ANode) do
|
|
begin
|
|
if ANode.CompareName('WcxPlugin') = 0 then
|
|
begin
|
|
if AConfig.TryGetValue(ANode, 'ArchiveExt', AExt) and
|
|
AConfig.TryGetValue(ANode, 'Path', APath) then
|
|
begin
|
|
AFlags := AConfig.GetValue(ANode, 'Flags', 0);
|
|
I := Add(AExt, AFlags, APath);
|
|
Enabled[I] := AConfig.GetAttr(ANode, 'Enabled', True);
|
|
end
|
|
else
|
|
DCDebug('Invalid entry in configuration: ' + AConfig.GetPathFromNode(ANode) + '.');
|
|
end;
|
|
ANode := ANode.NextSibling;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWCXModuleList.Save(AConfig: TXmlConfig; ANode: TXmlNode);
|
|
var
|
|
I: Integer;
|
|
SubNode: TXmlNode;
|
|
begin
|
|
ANode := AConfig.FindNode(ANode, 'WcxPlugins', True);
|
|
AConfig.ClearNode(ANode);
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
SubNode := AConfig.AddNode(ANode, 'WcxPlugin');
|
|
AConfig.SetAttr(SubNode, 'Enabled', Enabled[I]);
|
|
AConfig.AddValue(SubNode, 'ArchiveExt', Ext[I]);
|
|
AConfig.AddValue(SubNode, 'Path', FileName[I]);
|
|
AConfig.AddValue(SubNode, 'Flags', Flags[I]);
|
|
end;
|
|
end;
|
|
|
|
{ TWCXModuleList.ComputeSignature }
|
|
function TWCXModuleList.ComputeSignature(seed: dword): dword;
|
|
var
|
|
iIndex: integer;
|
|
begin
|
|
result := seed;
|
|
for iIndex := 0 to pred(Count) do
|
|
begin
|
|
result := ComputeSignatureBoolean(result, Enabled[iIndex]);
|
|
result := ComputeSignatureString(result, Ext[iIndex]);
|
|
result := ComputeSignatureString(result, FileName[iIndex]);
|
|
result := ComputeSignaturePtrInt(result, Flags[iIndex]);
|
|
end;
|
|
end;
|
|
|
|
{ TWCXModuleList.Add }
|
|
function TWCXModuleList.Add(Ext: String; Flags: PtrInt; FileName: String): Integer;
|
|
begin
|
|
Result:= AddObject(Ext + '=' + IntToStr(Flags) + #44 + FileName, TObject(True));
|
|
end;
|
|
|
|
function TWCXModuleList.Add(Ext: String; Flags: PtrInt; AEnabled: Boolean;
|
|
FileName: String): Integer;
|
|
begin
|
|
Result:= AddObject(Ext + '=' + IntToStr(Flags) + #44 + FileName, TObject(UIntPtr(AEnabled)));
|
|
end;
|
|
|
|
function TWCXModuleList.FindFirstEnabledByName(Name: String): Integer;
|
|
begin
|
|
Result:=0;
|
|
while Result < Count do
|
|
begin
|
|
if Enabled[Result] and (DoCompareText(Names[Result], Name) = 0) then
|
|
Exit
|
|
else
|
|
Result := Result + 1;
|
|
end;
|
|
if Result=Count then Result:=-1;
|
|
end;
|
|
|
|
function TWCXModuleList.Find(const aFileName, aExt: String): Integer;
|
|
begin
|
|
Result:=0;
|
|
while Result < Count do
|
|
begin
|
|
if (DoCompareText(Ext[Result], aExt) = 0) and (DoCompareText(FileName[Result], aFileName) = 0) then
|
|
Exit
|
|
else
|
|
Result := Result + 1;
|
|
end;
|
|
if Result=Count then Result:=-1;
|
|
end;
|
|
|
|
function TWCXModuleList.LoadModule(const FileName: String): TWcxModule;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
if FModuleList.Find(FileName, Index) then
|
|
Result := TWcxModule(FModuleList.Objects[Index])
|
|
else begin
|
|
Result := TWcxModule.Create;
|
|
if not Result.LoadModule(FileName) then
|
|
FreeAndNil(Result)
|
|
else begin
|
|
FModuleList.AddObject(FileName, Result);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TWCXHeader }
|
|
|
|
constructor TWCXHeader.Create(const Data: PHeaderData);
|
|
begin
|
|
ArcName := PCharLToUTF8(Data^.ArcName, SizeOf(Data^.ArcName));
|
|
FileName := PCharLToUTF8(Data^.FileName, SizeOf(Data^.FileName));
|
|
Flags := Data^.Flags;
|
|
HostOS := Data^.HostOS;
|
|
FileCRC := Data^.FileCRC;
|
|
FileTime := Data^.FileTime;
|
|
UnpVer := Data^.UnpVer;
|
|
Method := Data^.Method;
|
|
FileAttr := TFileAttrs(Data^.FileAttr);
|
|
PackSize := Data^.PackSize;
|
|
UnpSize := Data^.UnpSize;
|
|
if Assigned(Data^.CmtBuf) then
|
|
Cmt := PCharLToUTF8(Data^.CmtBuf, Data^.CmtSize);
|
|
CmtState := Data^.CmtState;
|
|
end;
|
|
|
|
constructor TWCXHeader.Create(const Data: PHeaderDataEx);
|
|
|
|
function Combine64(High, Low: LongWord): Int64;
|
|
begin
|
|
Result := Int64(High) shl (SizeOf(Int64) shl 2);
|
|
Result := Result + Int64(Low);
|
|
end;
|
|
|
|
begin
|
|
ArcName := PCharLToUTF8(Data^.ArcName, SizeOf(Data^.ArcName));
|
|
FileName := PCharLToUTF8(Data^.FileName, SizeOf(Data^.FileName));
|
|
Flags := Data^.Flags;
|
|
HostOS := Data^.HostOS;
|
|
FileCRC := Data^.FileCRC;
|
|
FileTime := Data^.FileTime;
|
|
UnpVer := Data^.UnpVer;
|
|
Method := Data^.Method;
|
|
FileAttr := TFileAttrs(Data^.FileAttr);
|
|
PackSize := Combine64(Data^.PackSizeHigh, Data^.PackSize);
|
|
UnpSize := Combine64(Data^.UnpSizeHigh, Data^.UnpSize);
|
|
if Assigned(Data^.CmtBuf) then
|
|
Cmt := PCharLToUTF8(Data^.CmtBuf, Data^.CmtSize);
|
|
CmtState := Data^.CmtState;
|
|
end;
|
|
|
|
constructor TWCXHeader.Create(const Data: PHeaderDataExW);
|
|
|
|
function Combine64(High, Low: LongWord): Int64;
|
|
begin
|
|
Result := Int64(High) shl (SizeOf(Int64) shl 2);
|
|
Result := Result + Int64(Low);
|
|
end;
|
|
|
|
begin
|
|
ArcName := UTF16ToUTF8(UnicodeString(Data^.ArcName));
|
|
FileName := UTF16ToUTF8(UnicodeString(Data^.FileName));
|
|
Flags := Data^.Flags;
|
|
HostOS := Data^.HostOS;
|
|
FileCRC := Data^.FileCRC;
|
|
FileTime := Data^.FileTime;
|
|
UnpVer := Data^.UnpVer;
|
|
Method := Data^.Method;
|
|
FileAttr := TFileAttrs(Data^.FileAttr);
|
|
PackSize := Combine64(Data^.PackSizeHigh, Data^.PackSize);
|
|
UnpSize := Combine64(Data^.UnpSizeHigh, Data^.UnpSize);
|
|
if Assigned(Data^.CmtBuf) then
|
|
Cmt := PCharLToUTF8(Data^.CmtBuf, Data^.CmtSize);
|
|
CmtState := Data^.CmtState;
|
|
FNanoTime:= Data^.MfileTime;
|
|
end;
|
|
|
|
constructor TWCXHeader.Create;
|
|
begin
|
|
end;
|
|
|
|
function TWCXHeader.GetDateTime: TDateTime;
|
|
begin
|
|
if FDateTime <> 0 then
|
|
Result:= FDateTime
|
|
else begin
|
|
if (FNanoTime > 0) then
|
|
FDateTime:= WinFileTimeToDateTime(FNanoTime)
|
|
else begin
|
|
if (FileTime = 0) then
|
|
FDateTime:= DATE_TIME_NULL
|
|
else begin
|
|
FDateTime:= WcxFileTimeToDateTime(FileTime);
|
|
end;
|
|
end;
|
|
Result:= FDateTime;
|
|
end;
|
|
end;
|
|
|
|
function TWCXHeader.PCharLToUTF8(CharString: PChar; MaxSize: Integer): String;
|
|
var
|
|
NameLength: Integer;
|
|
TempString: AnsiString;
|
|
begin
|
|
NameLength := strlen(CharString);
|
|
if NameLength > MaxSize then
|
|
NameLength := MaxSize;
|
|
|
|
SetString(TempString, CharString, NameLength);
|
|
Result := CeSysToUtf8(TempString);
|
|
end;
|
|
|
|
function TWCXHeader.Clone: TWCXHeader;
|
|
begin
|
|
Result:= TWCXHeader.Create;
|
|
|
|
Result.ArcName:= ArcName;
|
|
Result.FileName:= FileName;
|
|
Result.Flags:= Flags;
|
|
Result.HostOS:= HostOS;
|
|
Result.FileCRC:= FileCRC;
|
|
Result.FileTime:= FileTime;
|
|
Result.UnpVer:= UnpVer;
|
|
Result.Method:= Method;
|
|
Result.FileAttr:=FileAttr;
|
|
Result.PackSize:= PackSize;
|
|
Result.UnpSize:= UnpSize;
|
|
Result.Cmt:= Cmt;
|
|
Result.CmtState:= CmtState;
|
|
Result.FNanoTime:= FNanoTime;
|
|
Result.FDateTime:= FDateTime;
|
|
end;
|
|
|
|
end.
|