mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: SevenZip - Unix support

Browse source
This commit is contained in:
Alexander Koblov 2024-11-17 16:20:04 +03:00
commit ef6d192b0f
15 changed files with 1533 additions and 613 deletions
Download patch file Download diff file Expand all files Collapse all files

4
plugins/wcx/sevenzip/src/SevenZipCodecs.pas
View file

@ -102,7 +102,7 @@ var
implementation
uses
LazUTF8, FileUtil, SevenZipHlp;
LazUTF8, FileUtil, DCOSUtils, SevenZipHlp;
{ TCompressCodecsInfo }
@ -251,7 +251,7 @@ begin
AFiles:= FindAllFiles(ExtractFilePath(SevenzipLibraryName) + 'Codecs', '*.' + SharedSuffix);
for Index:= 0 to AFiles.Count - 1 do
begin
Handle:= System.LoadLibrary(AFiles[Index]);
Handle:= mbLoadLibrary(AFiles[Index]);
if Handle <> 0 then
begin
ALibraryInfo:= TLibraryInfo.Create;

337
plugins/wcx/sevenzip/src/SevenZipDlg.lfm Normal file
View file

@ -0,0 +1,337 @@
object DialogBox: TDialogBox
Left = 552
Height = 408
Top = 310
Width = 377
AutoSize = True
BorderStyle = bsDialog
Caption = 'Options'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 12
ClientHeight = 408
ClientWidth = 377
DesignTimePPI = 108
OnShow = DialogBoxShow
Position = poOwnerFormCenter
LCLVersion = '3.6.0.0'
object pnlCompression: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 12
Height = 266
Top = 12
Width = 357
AutoSize = True
BevelOuter = bvNone
ChildSizing.VerticalSpacing = 6
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 266
ClientWidth = 357
TabOrder = 0
object lblArchiveFormat: TLabel
Left = 0
Height = 26
Top = 0
Width = 215
Caption = 'Archive &format:'
Layout = tlCenter
ParentColor = False
end
object cbArchiveFormat: TComboBox
Left = 237
Height = 26
Top = 0
Width = 120
ItemHeight = 26
Style = csDropDownList
TabOrder = 0
OnChange = ComboBoxChange
end
object lblCompressionLevel: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 32
Width = 215
Caption = 'Compression &level:'
Layout = tlCenter
ParentColor = False
end
object cbCompressionLevel: TComboBox
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Left = 237
Height = 26
Top = 32
Width = 120
BorderSpacing.Left = 22
ItemHeight = 26
Style = csDropDownList
TabOrder = 2
OnChange = ComboBoxChange
end
object lblCompressionMethod: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 64
Width = 215
Caption = 'Compression &method:'
Layout = tlCenter
ParentColor = False
end
object cbCompressionMethod: TComboBox
AnchorSideRight.Side = asrBottom
Left = 237
Height = 26
Top = 64
Width = 120
ItemHeight = 26
Style = csDropDownList
TabOrder = 1
OnChange = ComboBoxChange
end
object lblCompressionDictionary: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 96
Width = 215
Caption = '&Dictionary size:'
Layout = tlCenter
ParentColor = False
end
object cbCompressionDictionary: TComboBox
AnchorSideRight.Side = asrBottom
Left = 237
Height = 26
Top = 96
Width = 120
ItemHeight = 26
Style = csDropDownList
TabOrder = 3
OnChange = ComboBoxChange
end
object lblCompressionWord: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 128
Width = 215
Caption = '&Word size:'
Layout = tlCenter
ParentColor = False
end
object cbCompressionWord: TComboBox
AnchorSideRight.Side = asrBottom
Left = 237
Height = 26
Top = 128
Width = 120
ItemHeight = 26
Style = csDropDownList
TabOrder = 4
OnChange = ComboBoxChange
end
object lblCompressionSolid: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 160
Width = 215
Caption = '&Solid Block size:'
Layout = tlCenter
ParentColor = False
end
object cbCompressionSolid: TComboBox
AnchorSideRight.Side = asrBottom
Left = 237
Height = 26
Top = 160
Width = 120
ItemHeight = 26
Style = csDropDownList
TabOrder = 5
OnChange = ComboBoxChange
end
object lblThreads: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 26
Top = 192
Width = 215
Caption = '&Number of CPU threads:'
Layout = tlCenter
ParentColor = False
end
object pnlThreads: TPanel
Left = 237
Height = 26
Top = 192
Width = 120
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 120
TabOrder = 6
object cbThreads: TComboBox
AnchorSideLeft.Control = pnlThreads
AnchorSideTop.Control = pnlThreads
Left = 0
Height = 26
Top = 0
Width = 112
ItemHeight = 26
Style = csDropDownList
TabOrder = 0
OnChange = ComboBoxChange
end
object lblMaxThreads: TLabel
AnchorSideLeft.Control = cbThreads
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbThreads
AnchorSideTop.Side = asrCenter
Left = 119
Height = 1
Top = 13
Width = 1
BorderSpacing.Left = 7
end
end
object lblMemoryCompression: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 18
Top = 224
Width = 215
Caption = 'Memory usage for Compressing:'
Layout = tlCenter
ParentColor = False
end
object lblMemoryCompressionValue: TLabel
AnchorSideTop.Side = asrCenter
Left = 237
Height = 18
Top = 224
Width = 120
Layout = tlCenter
ParentColor = False
end
object lblMemoryDecompression: TLabel
AnchorSideTop.Side = asrCenter
Left = 0
Height = 18
Top = 248
Width = 215
Caption = 'Memory usage for Decompressing:'
Layout = tlCenter
ParentColor = False
end
object lblMemoryDecompressionValue: TLabel
AnchorSideTop.Side = asrCenter
Left = 237
Height = 18
Top = 248
Width = 120
Layout = tlCenter
ParentColor = False
end
end
object lblParameters: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = pnlCompression
AnchorSideTop.Side = asrBottom
Left = 12
Height = 18
Top = 292
Width = 75
BorderSpacing.Top = 14
Caption = '&Parameters:'
end
object edtParameters: TEdit
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = lblParameters
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = pnlCompression
AnchorSideRight.Side = asrBottom
Left = 12
Height = 26
Top = 317
Width = 357
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 7
TabOrder = 1
end
object pnlButtons: TPanel
AnchorSideLeft.Control = pnlCompression
AnchorSideTop.Control = edtParameters
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = pnlCompression
AnchorSideRight.Side = asrBottom
Left = 12
Height = 29
Top = 361
Width = 357
Anchors = [akTop, akLeft, akRight]
AutoSize = True
BorderSpacing.Top = 18
BevelOuter = bvNone
ClientHeight = 29
ClientWidth = 357
TabOrder = 2
object btnOK: TBitBtn
AnchorSideTop.Control = btnCancel
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnCancel
Left = -7
Height = 29
Top = 0
Width = 112
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 14
Constraints.MinWidth = 112
Default = True
DefaultCaption = True
Kind = bkOK
ModalResult = 1
OnClick = ButtonClick
TabOrder = 0
end
object btnCancel: TBitBtn
AnchorSideTop.Control = btnApply
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnApply
Left = 119
Height = 29
Top = 0
Width = 112
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 14
Cancel = True
Constraints.MinWidth = 112
DefaultCaption = True
Kind = bkCancel
ModalResult = 2
OnClick = ButtonClick
TabOrder = 1
end
object btnApply: TBitBtn
AnchorSideTop.Control = pnlButtons
AnchorSideRight.Control = pnlButtons
AnchorSideRight.Side = asrBottom
Left = 245
Height = 29
Top = 0
Width = 112
Anchors = [akTop, akRight]
AutoSize = True
Caption = 'Apply'
Constraints.MinWidth = 112
OnClick = ButtonClick
TabOrder = 2
end
end
end

841
plugins/wcx/sevenzip/src/SevenZipDlg.pas Normal file
View file

@ -0,0 +1,841 @@
{
Double Commander
-------------------------------------------------------------------------
SevenZip archiver plugin, dialogs unit
Copyright (C) 2014-2024 Alexander Koblov (alexx2000@mail.ru)
Based on 7-Zip 15.06 (http://7-zip.org)
7-Zip Copyright (C) 1999-2015 Igor Pavlov
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
}
unit SevenZipDlg;
{$mode delphi}
interface
uses
Classes, SysUtils, Windows, Math, SevenZipOpt, SevenZipLng, JclCompression, Extension;
procedure ShowConfigurationDialog(Parent: HWND);
function ShowPasswordQuery(var Encrypt: Boolean; var Password: WideString): Boolean;
{Extension API}
procedure ExtensionInitialize(StartupInfo: PExtensionStartupInfo); winapi;
implementation
uses
LazUTF8, SevenZipCodecs, SevenZipHlp;
{$R SevenZipDlg.lfm}
{$R SevenZipPwd.lfm}
const
IDC_PASSWORD = 'edtPassword';
IDC_SHOW_PASSWORD = 'cbShowPassword';
IDC_ENCRYPT_HEADER = 'cbEncryptNames';
const
IDC_APPLY_BUTTON = 'btnApply';
IDC_COMP_FORMAT = 'cbArchiveFormat';
IDC_COMP_METHOD = 'cbCompressionMethod';
IDC_COMP_LEVEL = 'cbCompressionLevel';
IDC_COMP_DICT = 'cbCompressionDictionary';
IDC_COMP_WORD = 'cbCompressionWord';
IDC_COMP_SOLID = 'cbCompressionSolid';
IDC_COMP_THREAD = 'cbThreads';
IDC_MAX_THREAD = 'lblMaxThreads';
IDC_PARAMETERS = 'edtParameters';
IDC_MEMORY_COMP = 'lblMemoryCompressionValue';
IDC_MEMORY_DECOMP = 'lblMemoryDecompressionValue';
type
PPasswordData = ^TPasswordData;
TPasswordData = record
Password: String;
EncryptHeader: Boolean;
end;
var
gStartupInfo: TExtensionStartupInfo;
procedure SetDlgItemText(hDlg: HWND; const DlgItemName: String; lpString: PAnsiChar);
var
Data: PtrInt absolute lpString;
begin
gStartupInfo.SendDlgMsg(hDlg, PAnsiChar(DlgItemName), DM_SETTEXT, Data, 0);
end;
function GetComboBox(pDlg: PtrUInt; DlgItemName: PAnsiChar): PtrInt;
var
Index: IntPtr;
begin
with gStartupInfo do
begin
Index:= SendDlgMsg(pDlg, DlgItemName, DM_LISTGETITEMINDEX, 0, 0);
if (Index < 0) then
Result:= Index
else begin
Result:= SendDlgMsg(pDlg, DlgItemName, DM_LISTGETDATA, Index, 0);
end;
end;
end;
procedure SetComboBox(pDlg: PtrUInt; DlgItemName: PAnsiChar; ItemData: PtrInt);
var
Index, Count: Integer;
begin
with gStartupInfo do
begin
Count:= SendDlgMsg(pDlg, DlgItemName, DM_LISTGETCOUNT, 0, 0);
for Index:= 0 to Count - 1 do
begin
if SendDlgMsg(pDlg, DlgItemName, DM_LISTGETDATA, Index, 0) = ItemData then
begin
SendDlgMsg(pDlg, DlgItemName, DM_LISTSETITEMINDEX, Index, 0);
Exit;
end;
end;
end;
end;
function ComboBoxAdd(pDlg: PtrUInt; DlgItemName: PAnsiChar; ItemText: String; ItemData: PtrInt): IntPtr;
var
P: PAnsiChar;
AText: IntPtr absolute P;
begin
P:= PAnsiChar(ItemText);
Result:= gStartupInfo.SendDlgMsg(pDlg, DlgItemName, DM_LISTADD, AText, ItemData);
end;
procedure SaveArchiver(hwndDlg: HWND);
var
Data: PtrInt;
Format: TArchiveFormat;
Parameters: PAnsiChar absolute Data;
begin
Format:= TArchiveFormat(gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_GETDLGDATA, 0, 0));
PluginConfig[Format].Level:= GetComboBox(hwndDlg, IDC_COMP_LEVEL);
PluginConfig[Format].Method:= GetComboBox(hwndDlg, IDC_COMP_METHOD);
if PluginConfig[Format].Level <> PtrInt(clStore) then
begin
PluginConfig[Format].Dictionary:= GetComboBox(hwndDlg, IDC_COMP_DICT);
PluginConfig[Format].WordSize:= GetComboBox(hwndDlg, IDC_COMP_WORD);
PluginConfig[Format].SolidSize:= GetComboBox(hwndDlg, IDC_COMP_SOLID);
PluginConfig[Format].ThreadCount:= GetComboBox(hwndDlg, IDC_COMP_THREAD);
end;
Data:= gStartupInfo.SendDlgMsg(hwndDlg, IDC_PARAMETERS, DM_GETTEXT, 0, 0);
PluginConfig[Format].Parameters:= Parameters;
SaveConfiguration;
end;
function GetMemoryUsage(hwndDlg: HWND; out decompressMemory: Int64): Int64;
var
size: Int64 = 0;
Dictionary, hs,
numThreads, numThreads1,
numBlockThreads: Cardinal;
size1, chunkSize: Int64;
Level: TCompressionLevel;
Method: TJclCompressionMethod;
begin
Level := TCompressionLevel(GetComboBox(hwndDlg, IDC_COMP_LEVEL));
if (level = clStore) then
begin
decompressMemory := (1 shl 20);
Exit(decompressMemory);
end;
decompressMemory := -1;
Dictionary := Cardinal(GetComboBox(hwndDlg, IDC_COMP_DICT));
Method := TJclCompressionMethod(GetComboBox(hwndDlg, IDC_COMP_METHOD));
if (Method <> cmDeflate) and (Method <> cmDeflate64) and (level >= clUltra) then
size += (12 shl 20) * 2 + (5 shl 20);
numThreads := GetComboBox(hwndDlg, IDC_COMP_THREAD);
case (method) of
cmLZMA,
cmLZMA2:
begin
hs := dictionary - 1;
hs := hs or (hs shr 1);
hs := hs or (hs shr 2);
hs := hs or (hs shr 4);
hs := hs or (hs shr 8);
hs := hs shr 1;
hs := hs or $FFFF;
if (hs > (1 shl 24)) then
hs := hs shr 1;
Inc(hs);
size1 := Int64(hs) * 4;
size1 += Int64(dictionary) * 4;
if (level >= clNormal) then
size1 += Int64(dictionary) * 4;
size1 += (2 shl 20);
numThreads1 := 1;
if (numThreads > 1) and (level >= clNormal) then
begin
size1 += (2 shl 20) + (4 shl 20);
numThreads1 := 2;
end;
numBlockThreads := numThreads div numThreads1;
if (method = cmLZMA) or (numBlockThreads = 1) then
size1 += Int64(dictionary) * 3 div 2
else
begin
chunkSize := Int64(dictionary) shl 2;
chunkSize := Max(chunkSize, Int64(1 shl 20));
chunkSize := Min(chunkSize, Int64(1 shl 28));
chunkSize := Max(chunkSize, Int64(dictionary));
size1 += chunkSize * 2;
end;
size += size1 * numBlockThreads;
decompressMemory := Int64(dictionary) + (2 shl 20);
Exit(size);
end;
cmPPMd:
begin
decompressMemory := Int64(dictionary) + (2 shl 20);
Exit(size + decompressMemory);
end;
cmDeflate,
cmDeflate64:
begin
if (level >= clMaximum) then
size += (1 shl 20);
size += 3 shl 20;
decompressMemory := (2 shl 20);
Exit(size);
end;
cmBZip2:
begin
decompressMemory := (7 shl 20);
size1 := (10 shl 20);
Exit(size + size1 * numThreads);
end;
end;
Result := -1;
end;
procedure UpdateMemoryUsage(hwndDlg: HWND);
var
Comp, Decomp: Int64;
begin
if (GetComboBox(hwndDlg, IDC_COMP_METHOD) > cmMaximum) then
begin
SetDlgItemText(hwndDlg, IDC_MEMORY_COMP, '?');
SetDlgItemText(hwndDlg, IDC_MEMORY_DECOMP, '?');
end
else begin
Comp := GetMemoryUsage(hwndDlg, Decomp);
SetDlgItemText(hwndDlg, IDC_MEMORY_COMP, PAnsiChar(IntToStr(Comp div cMega) + 'Mb'));
SetDlgItemText(hwndDlg, IDC_MEMORY_DECOMP, PAnsiChar(IntToStr(Decomp div cMega) + 'Mb'));
end;
end;
procedure SetDefaultOptions(hwndDlg: HWND);
var
Value: PtrInt;
Level: TCompressionLevel;
Method: TJclCompressionMethod;
begin
Value:= GetComboBox(hwndDlg, IDC_COMP_METHOD);
if (Value <= cmMaximum) then
begin
// Get compression method
Method:= TJclCompressionMethod(Value);
// Get compression level
Level:= TCompressionLevel(GetComboBox(hwndDlg, IDC_COMP_LEVEL));
case Method of
cmDeflate,
cmDeflate64:
begin
case Level of
clFastest,
clFast,
clNormal:
SetComboBox(hwndDlg, IDC_COMP_WORD, 32);
clMaximum:
SetComboBox(hwndDlg, IDC_COMP_WORD, 64);
clUltra:
SetComboBox(hwndDlg, IDC_COMP_WORD, 128);
end;
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_DICT, DM_LISTSETITEMINDEX, 0, 0);
end;
cmBZip2:
begin
case Level of
clFastest:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 100 * cKilo);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 8 * cKilo);
end;
clFast:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 500 * cKilo);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 32 * cKilo);
end;
clNormal,
clMaximum,
clUltra:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 900 * cKilo);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 64 * cKilo);
end;
end;
end;
cmLZMA,
cmLZMA2:
begin
case Level of
clFastest:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 64 * cKilo);
SetComboBox(hwndDlg, IDC_COMP_WORD, 32);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 8 * cKilo);
end;
clFast:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 32);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 128 * cKilo);
end;
clNormal:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 16 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 32);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 2 * cMega);
end;
clMaximum:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 32 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 64);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 4 * cMega);
end;
clUltra:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 64 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 64);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 4 * cMega);
end;
end;
end;
cmPPMd:
begin
case Level of
clFastest,
clFast:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 4 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 4);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 512 * cKilo);
end;
clNormal:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 16 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 6);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 2 * cMega);
end;
clMaximum:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 64 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 16);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 4 * cMega);
end;
clUltra:
begin
SetComboBox(hwndDlg, IDC_COMP_DICT, 192 * cMega);
SetComboBox(hwndDlg, IDC_COMP_WORD, 16);
SetComboBox(hwndDlg, IDC_COMP_SOLID, 4 * cMega);
end;
end;
end;
end;
end;
UpdateMemoryUsage(hwndDlg);
end;
procedure UpdateSolid(hwndDlg: HWND);
var
Index: Integer;
Format: TArchiveFormat;
Level: TCompressionLevel;
begin
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_SOLID, DM_LISTCLEAR, 0, 0);
// Get compression level
Level:= TCompressionLevel(GetComboBox(hwndDlg, IDC_COMP_LEVEL));
Format:= TArchiveFormat(gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_GETDLGDATA, 0, 0));
if (Format in [afSevenZip]) and (Level <> clStore) then
begin
ComboBoxAdd(hwndDlg, IDC_COMP_SOLID, rsSolidBlockNonSolid, kNoSolidBlockSize);
for Index:= Low(SolidBlock) to High(SolidBlock) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_SOLID, FormatFileSize(Int64(SolidBlock[Index]) * cKilo), PtrInt(SolidBlock[Index]));
end;
ComboBoxAdd(hwndDlg, IDC_COMP_SOLID, rsSolidBlockSolid, kSolidBlockSize);
end;
end;
procedure UpdateThread(hwndDlg: HWND; dwAlgoThreadMax: LongWord);
var
Index: LongWord;
wsMaxThread: String;
dwMaxThread: LongWord;
dwDefaultValue: DWORD;
dwHardwareThreads: DWORD;
begin
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_THREAD, DM_LISTCLEAR, 0, 0);
dwHardwareThreads:= GetNumberOfProcessors;
dwDefaultValue:= dwHardwareThreads;
dwMaxThread:= dwHardwareThreads * 2;
if dwMaxThread > dwAlgoThreadMax then dwMaxThread:= dwAlgoThreadMax;
if dwAlgoThreadMax < dwDefaultValue then dwDefaultValue:= dwAlgoThreadMax;
for Index:= 1 to dwMaxThread do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_THREAD, IntToStr(Index), Index);
end;
wsMaxThread:= '/ ' + IntToStr(dwHardwareThreads);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_THREAD, DM_LISTSETITEMINDEX, dwDefaultValue - 1, 0);
SetDlgItemText(hwndDlg, IDC_MAX_THREAD, PAnsiChar(wsMaxThread));
end;
procedure UpdateMethod(hwndDlg: HWND);
var
Index: PtrInt;
Format: TArchiveFormat;
dwAlgoThreadMax: LongWord = 1;
Method: TJclCompressionMethod;
begin
// Clear comboboxes
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_DICT, DM_LISTCLEAR, 0, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_WORD, DM_LISTCLEAR, 0, 0);
Format:= TArchiveFormat(gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_GETDLGDATA, 0, 0));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_DICT, DM_ENABLE, PtrInt(not (Format in [afTar, afWim])), 0);
// Get Compression method
Index:= GetComboBox(hwndDlg, IDC_COMP_METHOD);
if Index > cmMaximum then
begin
dwAlgoThreadMax:= GetNumberOfProcessors;
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_DICT, DM_ENABLE, PtrInt(False), 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_WORD, DM_ENABLE, PtrInt(False), 0);
end
else begin
Method:= TJclCompressionMethod(Index);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_WORD, DM_ENABLE, PtrInt((Format in [afSevenZip, afGzip, afXz, afZip]) and (Method <> cmBZip2)), 0);
case Method of
cmDeflate:
begin
for Index:= Low(DeflateDict) to High(DeflateDict) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_DICT, FormatFileSize(DeflateDict[Index]), PtrInt(DeflateDict[Index]));
end;
for Index:= Low(DeflateWordSize) to High(DeflateWordSize) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_WORD, IntToStr(DeflateWordSize[Index]), PtrInt(DeflateWordSize[Index]));
end;
end;
cmDeflate64:
begin
for Index:= Low(Deflate64Dict) to High(Deflate64Dict) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_DICT, FormatFileSize(Deflate64Dict[Index]), PtrInt(Deflate64Dict[Index]));
end;
for Index:= Low(Deflate64WordSize) to High(Deflate64WordSize) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_WORD, IntToStr(Deflate64WordSize[Index]), PtrInt(Deflate64WordSize[Index]));
end;
end;
cmLZMA,
cmLZMA2:
begin
for Index:= Low(LZMADict) to High(LZMADict) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_DICT, FormatFileSize(LZMADict[Index], False), PtrInt(LZMADict[Index]));
end;
for Index:= Low(LZMAWordSize) to High(LZMAWordSize) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_WORD, IntToStr(LZMAWordSize[Index]), PtrInt(LZMAWordSize[Index]));
end;
dwAlgoThreadMax:= IfThen(Method = cmLZMA, 2, 32);
end;
cmBZip2:
begin
for Index:= Low(BZip2Dict) to High(BZip2Dict) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_DICT, FormatFileSize(BZip2Dict[Index]), PtrInt(BZip2Dict[Index]));
end;
dwAlgoThreadMax:= 32;
end;
cmPPMd:
begin
for Index:= Low(PPMdDict) to High(PPMdDict) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_DICT, FormatFileSize(PPMdDict[Index], False), PtrInt(PPMdDict[Index]));
end;
for Index:= Low(PPMdWordSize) to High(PPMdWordSize) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_WORD, IntToStr(PPMdWordSize[Index]), PtrInt(PPMdWordSize[Index]));
end;
end;
end;
if Format = afZip then dwAlgoThreadMax:= 128;
end;
UpdateThread(hwndDlg, dwAlgoThreadMax);
end;
procedure FillMethod(hwndDlg: HWND);
var
Index: Integer;
Format: TArchiveFormat;
begin
// Clear combobox
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_METHOD, DM_LISTCLEAR, 0, 0);
Format:= TArchiveFormat(gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_GETDLGDATA, 0, 0));
case Format of
afSevenZip:
begin
// Fill compression method
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'LZMA', PtrInt(cmLZMA));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'LZMA2', PtrInt(cmLZMA2));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'PPMd', PtrInt(cmPPMd));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'BZip2', PtrInt(cmBZip2));
if Assigned(ACodecs) then begin
for Index:= 0 to ACodecs.Count - 1 do begin
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, UTF8Encode(ACodecs[Index].Name), PtrInt(ACodecs[Index].ID));
end;
end;
SetComboBox(hwndDlg, IDC_COMP_METHOD, PluginConfig[Format].Method);
end;
afBzip2:
begin
// Fill compression method
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'BZip2', PtrInt(cmBZip2));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_METHOD, DM_LISTSETITEMINDEX, 0, 0);
end;
afGzip:
begin
// Fill compression method
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'Deflate', PtrInt(cmDeflate));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_METHOD, DM_LISTSETITEMINDEX, 0, 0);
end;
afXz:
begin
// Fill compression method
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'LZMA2', PtrInt(cmLZMA2));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_METHOD, DM_LISTSETITEMINDEX, 0, 0);
end;
afZip:
begin
// Fill compression method
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'Deflate', PtrInt(cmDeflate));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'Deflate64', PtrInt(cmDeflate64));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'BZip2', PtrInt(cmBZip2));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'LZMA', PtrInt(cmLZMA));
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, 'PPMd', PtrInt(cmPPMd));
end;
end;
end;
procedure UpdateFormat(hwndDlg: HWND);
var
Format: TArchiveFormat;
begin
// Clear comboboxes
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_LEVEL, DM_LISTCLEAR, 0, 0);
// Get archive format
Format:= TArchiveFormat(GetComboBox(hwndDlg, IDC_COMP_FORMAT));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_SETDLGDATA, PtrInt(Format), 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_SOLID, DM_ENABLE, PtrInt(Format = afSevenZip), 0);
// 7Zip and Zip
if Format in [afSevenZip, afZip] then
begin
// Fill compression level
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelStore, PtrInt(clStore));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelFastest, PtrInt(clFastest));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelFast, PtrInt(clFast));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelNormal, PtrInt(clNormal));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelMaximum, PtrInt(clMaximum));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelUltra, PtrInt(clUltra));
end
else if Format in [afBzip2, afXz] then
begin
// Fill compression level
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelFastest, PtrInt(clFastest));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelFast, PtrInt(clFast));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelNormal, PtrInt(clNormal));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelMaximum, PtrInt(clMaximum));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelUltra, PtrInt(clUltra));
end
else if Format in [afGzip] then
begin
// Fill compression level
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelFast, PtrInt(clFast));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelNormal, PtrInt(clNormal));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelMaximum, PtrInt(clMaximum));
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelUltra, PtrInt(clUltra));
end
else begin
// Fill compression level
ComboBoxAdd(hwndDlg, IDC_COMP_LEVEL, rsCompressionLevelStore, PtrInt(clStore));
end;
FillMethod(hwndDlg);
end;
procedure UpdateLevel(hwndDlg: HWND; First: Boolean);
var
MethodStd: Boolean;
Format: TArchiveFormat;
Level: TCompressionLevel;
begin
Format:= TArchiveFormat(gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_GETDLGDATA, 0, 0));
// Get compression level
Level:= TCompressionLevel(GetComboBox(hwndDlg, IDC_COMP_LEVEL));
// Get compression method
MethodStd:= (GetComboBox(hwndDlg, IDC_COMP_METHOD) <= cmMaximum);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_DICT, DM_ENABLE, PtrInt((Level <> clStore) and MethodStd), 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_WORD, DM_ENABLE, PtrInt((Level <> clStore) and MethodStd), 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_SOLID, DM_ENABLE, PtrInt((Format = afSevenZip) and (Level <> clStore)), 0);
if Level = clStore then
begin
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_METHOD, DM_LISTCLEAR, 0, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_DICT, DM_LISTCLEAR, 0, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_WORD, DM_LISTCLEAR, 0, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_SOLID, DM_LISTCLEAR, 0, 0);
ComboBoxAdd(hwndDlg, IDC_COMP_METHOD, UTF8Encode(MethodName[cmCopy]), PtrInt(cmCopy));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_METHOD, DM_LISTSETITEMINDEX, 0, 0);
UpdateThread(hwndDlg, 1);
end
else if not First then
begin
FillMethod(hwndDlg);
PluginConfig[Format].Method:= DefaultConfig[Format].Method;
SetComboBox(hwndDlg, IDC_COMP_METHOD, PluginConfig[Format].Method);
UpdateMethod(hwndDlg);
UpdateSolid(hwndDlg);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_SOLID, DM_ENABLE, PtrInt(Format = afSevenZip), 0);
end;
end;
procedure SelectFormat(hwndDlg: HWND);
var
Format: TArchiveFormat;
begin
UpdateFormat(hwndDlg);
Format:= TArchiveFormat(gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_GETDLGDATA, 0, 0));
SetComboBox(hwndDlg, IDC_COMP_LEVEL, PluginConfig[Format].Level);
SetComboBox(hwndDlg, IDC_COMP_METHOD, PluginConfig[Format].Method);
UpdateMethod(hwndDlg);
UpdateLevel(hwndDlg, True);
UpdateSolid(hwndDlg);
SetComboBox(hwndDlg, IDC_COMP_DICT, PluginConfig[Format].Dictionary);
SetComboBox(hwndDlg, IDC_COMP_WORD, PluginConfig[Format].WordSize);
SetComboBox(hwndDlg, IDC_COMP_SOLID, PluginConfig[Format].SolidSize);
SetComboBox(hwndDlg, IDC_COMP_THREAD, PluginConfig[Format].ThreadCount);
SetDlgItemText(hwndDlg, IDC_PARAMETERS, PAnsiChar(Utf16ToUtf8(PluginConfig[Format].Parameters)));
UpdateMemoryUsage(hwndDlg);
end;
function DlgProc(hwndDlg: PtrUInt; DlgItemName: PAnsiChar; Msg, wParam, lParam: PtrInt): PtrInt; winapi;
var
Index: TArchiveFormat;
begin
Result:= 0;
case Msg of
DN_INITDIALOG:
begin
for Index:= Low(ArchiveExtension) to High(ArchiveExtension) do
begin
ComboBoxAdd(hwndDlg, IDC_COMP_FORMAT, UTF8Encode(ArchiveExtension[Index]), PtrInt(Index));
end;
gStartupInfo.SendDlgMsg(hwndDlg, IDC_COMP_FORMAT, DM_LISTSETITEMINDEX, 0, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_APPLY_BUTTON, DM_SETDLGDATA, PtrInt(afSevenZip), 0);
SelectFormat(hwndDlg);
Result:= 1;
end;
DN_CHANGE:
begin
if DlgItemName = IDC_COMP_FORMAT then
begin
SelectFormat(hwndDlg);
end
else if DlgItemName = IDC_COMP_METHOD then
begin
UpdateMethod(hwndDlg);
SetDefaultOptions(hwndDlg);
end
else if DlgItemName = IDC_COMP_LEVEL then
begin
UpdateLevel(hwndDlg, False);
SetDefaultOptions(hwndDlg);
end
else if (DlgItemName = IDC_COMP_DICT) or
(DlgItemName = IDC_COMP_WORD) or
(DlgItemName = IDC_COMP_THREAD) then
begin
UpdateMemoryUsage(hwndDlg);
end;
end;
DN_CLICK:
begin
if DlgItemName = 'btnOK' then
begin
SaveArchiver(hwndDlg);
gStartupInfo.SendDlgMsg(hwndDlg, nil, DM_CLOSE, 1, 0);
end;
if DlgItemName = 'btnCancel' then
gStartupInfo.SendDlgMsg(hwndDlg, nil, DM_CLOSE, 2, 0);
if DlgItemName = IDC_APPLY_BUTTON then
SaveArchiver(hwndDlg);
end;
else begin
Result:= 0;
end;
end;
end;
function PasswordDialog(hwndDlg: PtrUInt; DlgItemName: PAnsiChar; Msg, wParam, lParam: PtrInt): PtrInt; winapi;
var
Data: PtrInt;
AText: PAnsiChar absolute Data;
PasswordData: PPasswordData absolute lParam;
begin
Result:= 0;
case Msg of
DN_INITDIALOG:
begin
lParam:= gStartupInfo.SendDlgMsg(hwndDlg, nil, DM_GETDLGDATA, 0, 0);
AText:= PAnsiChar(PasswordData^.Password);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_PASSWORD, DM_SETTEXT, Data, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_PASSWORD, DM_SETMAXTEXTLENGTH, MAX_PATH, 0);
gStartupInfo.SendDlgMsg(hwndDlg, IDC_ENCRYPT_HEADER, DM_ENABLE, PtrInt(PasswordData^.EncryptHeader), 0)
end;
DN_CHANGE:
begin
if DlgItemName = IDC_SHOW_PASSWORD then
begin
Data:= gStartupInfo.SendDlgMsg(hwndDlg, IDC_SHOW_PASSWORD, DM_GETCHECK, 0, 0);
wParam:= IfThen(Data <> 0, 0, Ord('*'));
gStartupInfo.SendDlgMsg(hwndDlg, IDC_PASSWORD, DM_SETPASSWORDCHAR, wParam, 0);
end;
end;
DN_CLICK:
begin
if DlgItemName = 'btnOK' then
begin
lParam:= gStartupInfo.SendDlgMsg(hwndDlg, nil, DM_GETDLGDATA, 0, 0);
PasswordData^.EncryptHeader:= gStartupInfo.SendDlgMsg(hwndDlg, IDC_ENCRYPT_HEADER, DM_GETCHECK, 0, 0) <> 0;
Data:= gStartupInfo.SendDlgMsg(hwndDlg, IDC_PASSWORD, DM_GETTEXT, 0, 0);
PasswordData^.Password:= AText;
gStartupInfo.SendDlgMsg(hwndDlg, nil, DM_CLOSE, 1, 0);
end
else if DlgItemName = 'btnCancel' then
begin
gStartupInfo.SendDlgMsg(hwndDlg, nil, DM_CLOSE, 2, 0);
end;
end
else begin
Result:= 0;
end;
end;
end;
function ShowPasswordQuery(var Encrypt: Boolean; var Password: WideString): Boolean;
var
ResData: Pointer;
ResSize: LongWord;
PasswordData: TPasswordData;
ResHandle: TFPResourceHandle;
ResGlobal: TFPResourceHGLOBAL;
begin
ResHandle := FindResource(HINSTANCE, PAnsiChar('TPasswordBox'), MAKEINTRESOURCE(10) {RT_RCDATA});
if ResHandle <> 0 then
begin
ResGlobal := LoadResource(HINSTANCE, ResHandle);
if ResGlobal <> 0 then
try
ResData := LockResource(ResGlobal);
ResSize := SizeofResource(HINSTANCE, ResHandle);
with gStartupInfo do
begin
PasswordData.EncryptHeader:= Encrypt;
PasswordData.Password:= UTF16ToUTF8(Password);
Result:= DialogBoxParam(ResData, ResSize, @PasswordDialog, DB_LRS, @PasswordData, nil) <> 0;
if Result then
begin
Encrypt:= PasswordData.EncryptHeader;
Password:= UTF8ToUTF16(PasswordData.Password);
end;
end;
finally
UnlockResource(ResGlobal);
FreeResource(ResGlobal);
end;
end;
end;
procedure ShowConfigurationDialog(Parent: HWND);
var
ResSize: LongWord;
ResData: Pointer = nil;
ResHandle: TFPResourceHandle;
ResGlobal: TFPResourceHGLOBAL;
begin
ResHandle := FindResource(HINSTANCE, PChar('TDIALOGBOX'), MAKEINTRESOURCE(10) {RT_RCDATA});
if ResHandle <> 0 then
begin
ResGlobal := LoadResource(HINSTANCE, ResHandle);
if ResGlobal <> 0 then
try
ResData := LockResource(ResGlobal);
ResSize := SizeofResource(HINSTANCE, ResHandle);
with gStartupInfo do
begin
DialogBoxLRS(ResData, ResSize, @DlgProc);
end;
finally
UnlockResource(ResGlobal);
FreeResource(ResGlobal);
end;
end;
end;
procedure ExtensionInitialize(StartupInfo: PExtensionStartupInfo); winapi;
begin
gStartupInfo:= StartupInfo^;
MessageBoxFunction:= gStartupInfo.MessageBox;
end;
end.

100
plugins/wcx/sevenzip/src/SevenZipFunc.pas
View file

@ -3,7 +3,7 @@
-------------------------------------------------------------------------
SevenZip archiver plugin
Copyright (C) 2014-2022 Alexander Koblov (alexx2000@mail.ru)
Copyright (C) 2014-2024 Alexander Koblov (alexx2000@mail.ru)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -16,8 +16,7 @@
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
License along with this library. If not, see <http://www.gnu.org/licenses/>.
}
unit SevenZipFunc;
@ -32,24 +31,25 @@ uses
WcxPlugin;
{ Mandatory }
function OpenArchiveW(var ArchiveData : tOpenArchiveDataW) : TArcHandle;stdcall;
function ReadHeaderExW(hArcData : TArcHandle; var HeaderData: THeaderDataExW) : Integer;stdcall;
function ProcessFileW(hArcData : TArcHandle; Operation : Integer; DestPath, DestName : PWideChar) : Integer;stdcall;
function CloseArchive (hArcData : TArcHandle) : Integer;stdcall;
procedure SetChangeVolProcW(hArcData : TArcHandle; pChangeVolProc : TChangeVolProcW);stdcall;
procedure SetProcessDataProcW(hArcData : TArcHandle; pProcessDataProc : TProcessDataProcW);stdcall;
function OpenArchiveW(var ArchiveData : tOpenArchiveDataW) : TArcHandle; winapi;
function ReadHeaderExW(hArcData : TArcHandle; var HeaderData: THeaderDataExW) : Integer; winapi;
function ProcessFileW(hArcData : TArcHandle; Operation : Integer; DestPath, DestName : PWideChar) : Integer; winapi;
function CloseArchive (hArcData : TArcHandle) : Integer; winapi;
procedure SetChangeVolProcW(hArcData : TArcHandle; pChangeVolProc : TChangeVolProcW); winapi;
procedure SetProcessDataProcW(hArcData : TArcHandle; pProcessDataProc : TProcessDataProcW); winapi;
{ Optional }
function PackFilesW(PackedFile: PWideChar; SubPath: PWideChar; SrcPath: PWideChar; AddList: PWideChar; Flags: Integer): Integer; stdcall;
function DeleteFilesW(PackedFile, DeleteList: PWideChar): Integer; stdcall;
function CanYouHandleThisFileW(FileName: PWideChar): Boolean; stdcall;
procedure PackSetDefaultParams(dps: PPackDefaultParamStruct); stdcall;
procedure ConfigurePacker(Parent: HWND; DllInstance: THandle); stdcall;
function PackFilesW(PackedFile: PWideChar; SubPath: PWideChar; SrcPath: PWideChar; AddList: PWideChar; Flags: Integer): Integer; winapi;
function DeleteFilesW(PackedFile, DeleteList: PWideChar): Integer; winapi;
function CanYouHandleThisFileW(FileName: PWideChar): Boolean; winapi;
procedure PackSetDefaultParams(dps: PPackDefaultParamStruct); winapi;
procedure ConfigurePacker(Parent: HWND; DllInstance: THandle); winapi;
implementation
uses
Windows, SysUtils, Classes, JclCompression, SevenZip, SevenZipAdv, fpTimer, DCOSUtils,
SevenZipDlg, SevenZipLng, SevenZipOpt, LazFileUtils, SyncObjs, LazUTF8, SevenZipCodecs, DCFileAttributes;
SevenZipDlg, SevenZipLng, SevenZipOpt, LazFileUtils, SyncObjs, LazUTF8, SevenZipCodecs,
DCFileAttributes, DCConvertEncoding, SevenZipHlp;
type
@ -145,13 +145,28 @@ begin
end;
end;
function OpenArchiveW(var ArchiveData : tOpenArchiveDataW) : TArcHandle; stdcall;
function Verify: Boolean;
begin
Result:= Is7ZipLoaded;
if not Result then
begin
MessageBox(Format(rsSevenZipLoadError, [SevenZipDefaultLibraryName]),
'SevenZip', MB_OK or MB_ICONERROR);
end;
end;
function OpenArchiveW(var ArchiveData : tOpenArchiveDataW) : TArcHandle; winapi;
var
I: Integer;
ResultHandle: TSevenZipHandle;
Archive: TJclDecompressArchive;
AFormats: TJclDecompressArchiveClassArray;
begin
if not Verify then
begin
ArchiveData.OpenResult:= E_HANDLED;
Exit(0);
end;
ResultHandle:= TSevenZipHandle.Create;
with ResultHandle do
begin
@ -197,7 +212,7 @@ begin
Result:= 0;
end;
function ReadHeaderExW(hArcData : TArcHandle; var HeaderData: THeaderDataExW) : Integer; stdcall;
function ReadHeaderExW(hArcData : TArcHandle; var HeaderData: THeaderDataExW) : Integer; winapi;
var
FileNameW: UnicodeString;
Item: TJclCompressionItem;
@ -213,7 +228,7 @@ begin
HeaderData.PackSize:= Int64Rec(Item.PackedSize).Lo;
HeaderData.PackSizeHigh:= Int64Rec(Item.PackedSize).Hi;
if ipAttributes in Item.ValidProperties then
HeaderData.FileAttr:= WinToWcxFileAttr(Item.Attributes)
HeaderData.FileAttr:= SevenZipToWcxAttr(Item.Attributes)
else begin
HeaderData.FileAttr:= GENERIC_ATTRIBUTE_FILE;
end;
@ -236,7 +251,7 @@ begin
Result:= E_SUCCESS;
end;
function ProcessFileW(hArcData: TArcHandle; Operation: Integer; DestPath, DestName: PWideChar): Integer; stdcall;
function ProcessFileW(hArcData: TArcHandle; Operation: Integer; DestPath, DestName: PWideChar): Integer; winapi;
var
Handle: TSevenZipHandle absolute hArcData;
begin
@ -270,7 +285,7 @@ begin
end;
end;
function CloseArchive(hArcData: TArcHandle): Integer; stdcall;
function CloseArchive(hArcData: TArcHandle): Integer; winapi;
var
Handle: TSevenZipHandle absolute hArcData;
begin
@ -288,12 +303,12 @@ begin
end;
end;
procedure SetChangeVolProcW(hArcData : TArcHandle; pChangeVolProc : TChangeVolProcW); stdcall;
procedure SetChangeVolProcW(hArcData : TArcHandle; pChangeVolProc : TChangeVolProcW); winapi;
begin
end;
procedure SetProcessDataProcW(hArcData : TArcHandle; pProcessDataProc : TProcessDataProcW); stdcall;
procedure SetProcessDataProcW(hArcData : TArcHandle; pProcessDataProc : TProcessDataProcW); winapi;
var
Handle: TSevenZipHandle absolute hArcData;
begin
@ -305,7 +320,7 @@ begin
end;
function PackFilesW(PackedFile: PWideChar; SubPath: PWideChar;
SrcPath: PWideChar; AddList: PWideChar; Flags: Integer): Integer; stdcall;
SrcPath: PWideChar; AddList: PWideChar; Flags: Integer): Integer; winapi;
var
I, J: Integer;
Encrypt: Boolean;
@ -320,26 +335,28 @@ var
Archive: TJclCompressArchive;
AFormats: TJclCompressArchiveClassArray;
begin
if not Verify then Exit(E_HANDLED);
FileNameUTF8 := Utf16ToUtf8(WideString(PackedFile));
// If update existing archive
if (mbFileGetAttr(FileNameUTF8) <> faInvalidAttributes) then
AFormats := TJclCompressArchiveClassArray(FindUpdateFormats(FileNameUTF8))
else begin
if not SameText(ExtractFileExt(FileNameUTF8), '.exe') then
if not SameText(ExtractFileExt(FileNameUTF8), SevenZipSfxExt) then
AFormats := FindCompressFormats(FileNameUTF8)
else begin
// Only 7-Zip supports self-extract
SfxModule := ExtractFilePath(SevenzipLibraryName) + '7z.sfx';
SfxModule := ExtractFilePath(SevenzipLibraryName) + SevenZipSfxName;
if FileExistsUTF8(SfxModule) then
begin
SetLength(AFormats, 1);
AFormats[0] := TJcl7zCompressArchive;
end
else begin
AMessage := SysErrorMessage(GetLastError) + LineEnding;
AMessage := SysErrorMessage(GetLastOSError) + LineEnding;
AMessage += rsSevenZipSfxNotFound + LineEnding + SfxModule;
MessageBoxW(0, PWideChar(UTF8ToUTF16(AMessage)), nil, MB_OK or MB_ICONERROR);
MessageBox(AMessage, nil, MB_OK or MB_ICONERROR);
Exit(E_NO_FILES);
end;
end;
@ -431,7 +448,7 @@ begin
Result:= E_NOT_SUPPORTED;
end;
function DeleteFilesW(PackedFile, DeleteList: PWideChar): Integer; stdcall;
function DeleteFilesW(PackedFile, DeleteList: PWideChar): Integer; winapi;
var
I: Integer;
PathEnd : WideChar;
@ -483,18 +500,19 @@ begin
Result:= E_NOT_SUPPORTED;
end;
function CanYouHandleThisFileW(FileName: PWideChar): Boolean; stdcall;
function CanYouHandleThisFileW(FileName: PWideChar): Boolean; winapi;
begin
if not Is7ZipLoaded then Exit(False);
Result:= FindDecompressFormats(Utf16ToUtf8(WideString(FileName))) <> nil;
end;
procedure PackSetDefaultParams(dps: PPackDefaultParamStruct); stdcall;
procedure PackSetDefaultParams(dps: PPackDefaultParamStruct); winapi;
var
ModulePath: AnsiString;
ModulePath: String;
begin
// Save configuration file name
ConfigFile:= ExtractFilePath(dps^.DefaultIniName);
ConfigFile:= WinCPToUTF8(ConfigFile) + DefaultIniName;
ConfigFile:= CeSysToUtf8(ConfigFile) + DefaultIniName;
// Get plugin path
ModulePath:= ExtractFilePath(mbGetModuleName);
// Use configuration from plugin path
@ -515,6 +533,17 @@ begin
SevenzipLibraryName:= ModulePath + SevenzipDefaultLibraryName;
end;
end;
if (SevenzipLibraryName = SevenzipDefaultLibraryName) then
begin
ModulePath:= mbGetEnvironmentVariable('COMMANDER_PATH') + PathDelim;
if mbFileExists(ModulePath + SevenzipDefaultLibraryName) then
SevenZipLibraryName:= ModulePath + SevenzipDefaultLibraryName
else begin
ModulePath:= mbExpandEnvironmentStrings(SevenZipDefaultLibraryPath);
if mbFileExists(ModulePath + SevenZipDefaultLibraryName) then
SevenZipLibraryName:= ModulePath + SevenZipDefaultLibraryName;
end;
end;
// Process Xz files as archives
GetArchiveFormats.RegisterFormat(TJclXzDecompressArchive);
// Replace TJclXzCompressArchive by TJclXzCompressArchiveEx
@ -526,13 +555,14 @@ begin
if (Is7ZipLoaded or Load7Zip) then
LoadLibraries
else begin
MessageBoxW(0, PWideChar(UTF8ToUTF16(rsSevenZipLoadError)), 'SevenZip', MB_OK or MB_ICONERROR);
MessageBox(Format(rsSevenZipLoadError, [SevenZipDefaultLibraryName]) +
LineEnding + GetLoadErrorStr, 'SevenZip', MB_OK or MB_ICONERROR);
end;
// Create password cache object
PasswordCache:= TPasswordCache.Create;
end;
procedure ConfigurePacker(Parent: WcxPlugin.HWND; DllInstance: THandle); stdcall;
procedure ConfigurePacker(Parent: WcxPlugin.HWND; DllInstance: THandle); winapi;
begin
ShowConfigurationDialog(Parent);
end;
@ -623,7 +653,7 @@ begin
on E: Exception do
begin
ReturnValue:= GetArchiveError(E);
MessageBoxW(0, PWideChar(UTF8ToUTF16(E.Message)), nil, MB_OK or MB_ICONERROR);
MessageBox(E.Message, nil, MB_OK or MB_ICONERROR);
end;
end;
Terminate;

4
plugins/wcx/sevenzip/src/SevenZipLng.pas
View file

@ -30,8 +30,8 @@ uses
Classes, SysUtils;
resourcestring
rsSevenZipLoadError = 'Failed to load 7z.dll';
rsSevenZipSfxNotFound = 'Cannot find specified SFX module';
rsSevenZipLoadError = 'Failed to load 7-Zip library (%s)!';
rsSevenZipSfxNotFound = 'Cannot find specified SFX module!';
resourcestring
rsCompressionLevelStore = 'Store';

12
plugins/wcx/sevenzip/src/SevenZipOpt.pas
View file

@ -163,12 +163,6 @@ type
TArchiveFormat = (afSevenZip, afBzip2, afGzip, afTar, afWim, afXz, afZip);
PPasswordData = ^TPasswordData;
TPasswordData = record
EncryptHeader: Boolean;
Password: array[0..MAX_PATH] of WideChar;
end;
TFormatOptions = record
Level: PtrInt;
Method: PtrInt;
@ -436,7 +430,7 @@ begin
SetArchiveCustom(AJclArchive, Index);
except
on E: Exception do
MessageBoxW(0, PWideChar(UTF8ToUTF16(E.Message)), nil, MB_OK or MB_ICONERROR);
MessageBox(E.Message, nil, MB_OK or MB_ICONERROR);
end;
Exit;
@ -471,7 +465,7 @@ begin
end;
except
on E: Exception do
MessageBoxW(0, PWideChar(UTF8ToUTF16(E.Message)), nil, MB_OK or MB_ICONERROR);
MessageBox(E.Message, nil, MB_OK or MB_ICONERROR);
end;
end;
@ -501,7 +495,7 @@ begin
end;
except
on E: Exception do
MessageBoxW(0, PWideChar(UTF8ToUTF16(E.Message)), nil, MB_OK or MB_ICONERROR);
MessageBox(E.Message, nil, MB_OK or MB_ICONERROR);
end;
end;

104
plugins/wcx/sevenzip/src/SevenZipPwd.lfm Normal file
View file

@ -0,0 +1,104 @@
object DialogBox: TPasswordBox
Left = 256
Height = 168
Top = 145
Width = 320
AutoSize = True
BorderStyle = bsDialog
Caption = 'Enter password'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 12
ChildSizing.VerticalSpacing = 6
ClientHeight = 168
ClientWidth = 320
Constraints.MinWidth = 300
OnShow = DialogBoxShow
Position = poOwnerFormCenter
LCLVersion = '3.0.0.1'
object lblPassword: TLabel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 12
Height = 15
Top = 12
Width = 83
Caption = '&Enter password:'
end
object edtPassword: TEdit
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = lblPassword
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 12
Height = 23
Top = 33
Width = 296
Anchors = [akTop, akLeft, akRight]
EchoMode = emPassword
PasswordChar = '*'
TabOrder = 0
end
object cbShowPassword: TCheckBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = edtPassword
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 62
Width = 100
Caption = '&Show password'
TabOrder = 1
OnChange = CheckBoxChange
end
object cbEncryptNames: TCheckBox
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cbShowPassword
AnchorSideTop.Side = asrBottom
Left = 12
Height = 19
Top = 87
Width = 115
Caption = 'Encrypt file &names'
TabOrder = 2
end
object btnOK: TBitBtn
AnchorSideTop.Control = btnCancel
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnCancel
Left = 98
Height = 26
Top = 126
Width = 100
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 10
Constraints.MinWidth = 100
Default = True
DefaultCaption = True
Kind = bkOK
ModalResult = 1
OnClick = ButtonClick
TabOrder = 3
end
object btnCancel: TBitBtn
AnchorSideTop.Control = cbEncryptNames
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 208
Height = 26
Top = 126
Width = 100
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Top = 20
Cancel = True
Constraints.MinWidth = 100
DefaultCaption = True
Kind = bkCancel
ModalResult = 2
OnClick = ButtonClick
TabOrder = 4
end
end

30
plugins/wcx/sevenzip/src/SevenZipWcx.dpr
View file

@ -1,49 +1,53 @@
library SevenZipWcx;
uses
CMem, FPCAdds, SevenZipFunc, SevenZipDlg, WcxPlugin, SevenZipAdv, SevenZipLng,
SevenZipCodecs;
CMem,
{$IFDEF UNIX}
CThreads,
{$ENDIF}
FPCAdds, SevenZipFunc, WcxPlugin, SevenZipAdv, SevenZipLng,
SevenZipCodecs, SevenZipDlg;
function OpenArchive(var ArchiveData : tOpenArchiveData) : TArcHandle; stdcall;
function OpenArchive(var ArchiveData : tOpenArchiveData) : TArcHandle; winapi;
begin
Result:= 0;
ArchiveData.OpenResult:= E_NOT_SUPPORTED;
end;
function ReadHeader(hArcData : TArcHandle; var HeaderData: THeaderData) : Integer; stdcall;
function ReadHeader(hArcData : TArcHandle; var HeaderData: THeaderData) : Integer; winapi;
begin
Result:= E_NOT_SUPPORTED;
end;
function ProcessFile (hArcData : TArcHandle; Operation : Integer; DestPath, DestName : PAnsiChar) : Integer; stdcall;
function ProcessFile (hArcData : TArcHandle; Operation : Integer; DestPath, DestName : PAnsiChar) : Integer; winapi;
begin
Result:= E_NOT_SUPPORTED;
end;
procedure SetChangeVolProc (hArcData : TArcHandle; pChangeVolProc : PChangeVolProc); stdcall;
procedure SetChangeVolProc (hArcData : TArcHandle; pChangeVolProc : PChangeVolProc); winapi;
begin
end;
procedure SetProcessDataProc (hArcData : TArcHandle; pProcessDataProc : TProcessDataProc); stdcall;
procedure SetProcessDataProc (hArcData : TArcHandle; pProcessDataProc : TProcessDataProc); winapi;
begin
end;
function PackFiles(PackedFile, SubPath, SrcPath, AddList: PAnsiChar; Flags: Integer): Integer; stdcall;
function PackFiles(PackedFile, SubPath, SrcPath, AddList: PAnsiChar; Flags: Integer): Integer; winapi;
begin
Result:= E_NOT_SUPPORTED;
end;
function DeleteFiles(PackedFile, DeleteList: PAnsiChar): Integer; stdcall;
function DeleteFiles(PackedFile, DeleteList: PAnsiChar): Integer; winapi;
begin
Result:= E_NOT_SUPPORTED;
end;
function GetBackgroundFlags: Integer; stdcall;
function GetBackgroundFlags: Integer; winapi;
begin
Result:= BACKGROUND_UNPACK or BACKGROUND_PACK;
end;
function GetPackerCaps : Integer; stdcall;
function GetPackerCaps : Integer; winapi;
begin
Result:= PK_CAPS_NEW or PK_CAPS_DELETE or PK_CAPS_MODIFY
or PK_CAPS_MULTIPLE or PK_CAPS_OPTIONS or PK_CAPS_ENCRYPT;
@ -71,7 +75,9 @@ exports
ConfigurePacker,
GetBackgroundFlags,
PackSetDefaultParams,
CanYouHandleThisFileW
CanYouHandleThisFileW,
{ Extension }
ExtensionInitialize
;
{$R *.res}

5
plugins/wcx/sevenzip/src/SevenZipWcx.lpi
View file

@ -21,8 +21,8 @@
<VersionInfo>
<UseVersionInfo Value="True"/>
<MajorVersionNr Value="24"/>
<MinorVersionNr Value="7"/>
<RevisionNr Value="29"/>
<MinorVersionNr Value="11"/>
<RevisionNr Value="17"/>
<CharSet Value="04B0"/>
<StringTable FileDescription="SevenZip archiver plugin" InternalName="SevenZip" LegalCopyright="Copyright (C) 2014-2024 Alexander Koblov"/>
</VersionInfo>
@ -108,6 +108,7 @@
<Unit3>
<Filename Value="SevenZipDlg.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
</Unit3>
<Unit4>
<Filename Value="SevenZipLng.pas"/>

75
plugins/wcx/sevenzip/src/jcl/DCJclAlternative.pas
View file

@ -3,7 +3,7 @@
-------------------------------------------------------------------------
SevenZip archiver plugin
Copyright (C) 2015 Alexander Koblov (alexx2000@mail.ru)
Copyright (C) 2015-2024 Alexander Koblov (alexx2000@mail.ru)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -27,7 +27,7 @@ unit DCJclAlternative;
interface
uses
Classes, SysUtils, fgl, Windows;
Classes, SysUtils, fgl;
// JclBase.pas -----------------------------------------------------------------
type
@ -76,9 +76,6 @@ type
function StreamCopy(Source, Target: TStream): Int64;
// JclDateTime.pas -------------------------------------------------------------
function LocalDateTimeToFileTime(DateTime: TDateTime): TFileTime;
// JclFileUtils.pas ------------------------------------------------------------
const
DirDelimiter = DirectorySeparator;
@ -93,20 +90,18 @@ function PathRemoveSeparator(const Path: String): String; inline;
function PathGetRelativePath(const Base, Path: String): String; inline;
function PathCanonicalize(const Path: WideString): WideString;
function IsFileNameMatch(const FileName, Mask: WideString): Boolean; inline;
function IsFileNameMatch(const FileName, Mask: String): Boolean; inline;
procedure BuildFileList(const SourceFile: String; FileAttr: Integer; InnerList: TStrings; Dummy: Boolean);
procedure EnumFiles(const Path: String; OnAddFile: TJclOnAddFile; ExcludeAttributes: Integer);
procedure EnumDirectories(const Path: String; OnAddDirectory: TJclOnAddDirectory;
DummyBoolean: Boolean; const DummyString: String; DummyPointer: Pointer);
function FileDelete(const FileName: String): Boolean; inline;
function FindUnusedFileName(const FileName, FileExt: String): String;
function FileMove(const OldName, NewName: String; Replace: Boolean = False): Boolean;
// JclSysUtils.pas -------------------------------------------------------------
type
TModuleHandle = HINST;
TModuleHandle = TLibHandle;
const
INVALID_MODULEHANDLE_VALUE = TModuleHandle(0);
@ -152,30 +147,16 @@ type
property Strings[Index: Integer]: WideString read Get write Put; default;
end;
// SysUtils.pas -----------------------------------------------------------------
function FileExists(const FileName: String): Boolean; inline;
// Windows.pas -----------------------------------------------------------------
function CreateFile(lpFileName: LPCSTR; dwDesiredAccess: DWORD; dwShareMode: DWORD; lpSecurityAttributes: LPSECURITY_ATTRIBUTES;
dwCreationDisposition: DWORD; dwFlagsAndAttributes: DWORD; hTemplateFile: HANDLE): HANDLE; inline;
function GetFileAttributesEx(lpFileName: LPCSTR; fInfoLevelId: TGET_FILEEX_INFO_LEVELS; lpFileInformation: Pointer): BOOL; inline;
implementation
uses
LazUTF8, LazFileUtils;
LazUTF8, LazFileUtils, Masks, DCOSUtils;
function StreamCopy(Source, Target: TStream): Int64;
begin
Result:= Target.CopyFrom(Source, Source.Size);
end;
function LocalDateTimeToFileTime(DateTime: TDateTime): TFileTime;
begin
Int64(Result) := Round((Extended(DateTime) + 109205.0) * 864000000000.0);
Windows.LocalFileTimeToFileTime(@Result, @Result);
end;
function PathAddSeparator(const Path: String): String;
begin
Result:= IncludeTrailingPathDelimiter(Path);
@ -191,22 +172,14 @@ begin
Result:= ExtractRelativePath(Base, Path);
end;
function PathMatchSpecW(pszFile, pszSpec: LPCWSTR): BOOL; stdcall; external 'shlwapi.dll';
function PathCanonicalizeW(lpszDst, lpszSrc: LPCWSTR): BOOL; stdcall; external 'shlwapi.dll';
function PathCanonicalize(const Path: WideString): WideString;
begin
SetLength(Result, MAX_PATH);
if PathCanonicalizeW(PWideChar(Result), PWideChar(Path)) then
Result:= PWideChar(Result)
else begin
Result:= EmptyWideStr;
end;
Result:= ExpandFileName(Path);
end;
function IsFileNameMatch(const FileName, Mask: WideString): Boolean;
function IsFileNameMatch(const FileName, Mask: String): Boolean;
begin
Result:= PathMatchSpecW(PWideChar(FileName), PWideChar(Mask));
Result:= MatchesMask(FileName, Mask);
end;
procedure BuildFileList(const SourceFile: String; FileAttr: Integer;
@ -226,11 +199,6 @@ begin
raise Exception.Create('Not implemented');
end;
function FileDelete(const FileName: String): Boolean;
begin
Result:= DeleteFileW(PWideChar(UTF8ToUTF16(FileName)));
end;
function FindUnusedFileName(const FileName, FileExt: String): String;
var
Counter: Int64 = 0;
@ -243,14 +211,6 @@ begin
until not FileExists(Result);
end;
function FileMove(const OldName, NewName: String; Replace: Boolean): Boolean;
const
dwFlags: array[Boolean] of DWORD = (0, MOVEFILE_REPLACE_EXISTING);
begin
Result:= MoveFileExW(PWideChar(UTF8ToUTF16(OldName)), PWideChar(UTF8ToUTF16(NewName)),
dwFlags[Replace] or MOVEFILE_COPY_ALLOWED);
end;
function GUIDEquals(const GUID1, GUID2: TGUID): Boolean;
begin
Result:= IsEqualGUID(GUID1, GUID2);
@ -258,7 +218,7 @@ end;
class function JclSysUtils.LoadModule(var Module: TModuleHandle; FileName: String): Boolean;
begin
Module:= LoadLibraryW(PWideChar(UTF8ToUTF16(FileName)));
Module:= mbLoadLibrary(FileName);
Result:= Module <> INVALID_MODULEHANDLE_VALUE;
end;
@ -302,23 +262,6 @@ begin
end;
end;
function FileExists(const FileName: String): Boolean;
begin
Result:= FileExistsUTF8(FileName);
end;
function CreateFile(lpFileName: LPCSTR; dwDesiredAccess: DWORD; dwShareMode: DWORD; lpSecurityAttributes: LPSECURITY_ATTRIBUTES;
dwCreationDisposition: DWORD; dwFlagsAndAttributes: DWORD; hTemplateFile: HANDLE): HANDLE;
begin
Result:= CreateFileW(PWideChar(UTF8ToUTF16(lpFileName)), dwDesiredAccess, dwShareMode,
lpSecurityAttributes, dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile);
end;
function GetFileAttributesEx(lpFileName: LPCSTR; fInfoLevelId: TGET_FILEEX_INFO_LEVELS; lpFileInformation: Pointer): BOOL;
begin
Result:= GetFileAttributesExW(PWideChar(UTF8ToUTF16(lpFileName)), fInfoLevelId, lpFileInformation);
end;
{ TJclDynamicSplitStream }
function TJclDynamicSplitStream.LoadVolume: Boolean;

6
plugins/wcx/sevenzip/src/jcl/DCJclCompression.pas
View file

@ -3,7 +3,7 @@
-------------------------------------------------------------------------
SevenZip archiver plugin
Copyright (C) 2015 Alexander Koblov (alexx2000@mail.ru)
Copyright (C) 2015-2024 Alexander Koblov (alexx2000@mail.ru)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -27,7 +27,7 @@ unit DCJclCompression;
interface
uses
Classes, SysUtils, SevenZip;
Classes, SysUtils, SevenZip, ActiveX;
type
@ -52,7 +52,7 @@ type
implementation
uses
ActiveX, DCClassesUtf8;
DCClassesUtf8;
const
E_INVALIDARG = HRESULT($80070057);

36
plugins/wcx/sevenzip/src/jcl/common/JclCompression.pas
View file

@ -4086,7 +4086,7 @@ begin
(mbFileGetAttr(ExcludeTrailingPathDelimiter(Value), AFindData)) then
begin
FileSize := AFindData.Size;
Attributes := AFindData.Attr;
Attributes := SysAttrToSevenZip(AFindData.Attr);
CreationTime := Types.TFileTime(FileTimeToWinFileTime(AFindData.PlatformTime));
LastAccessTime := Types.TFileTime(FileTimeToWinFileTime(AFindData.LastAccessTime));
LastWriteTime := Types.TFileTime(FileTimeToWinFileTime(AFindData.LastWriteTime));
@ -5552,7 +5552,7 @@ begin
FreeAndNil(SrcStream);
if OwnsDestStream then
FreeAndNil(DestStream);
Handled := FileMove(SrcFileName, DestFileName, True);
Handled := FileMove(SrcFileName, DestFileName);
end
else
if (SrcFileName = '') and (DestFileName = '') and Assigned(SrcStream) and Assigned(DestStream) then
@ -5959,12 +5959,12 @@ begin
VT_LPWSTR:
begin
Result := True;
Setter(Value.pwszVal);
Setter(CWideCharToWideString(Value.pwszVal));
end;
VT_BSTR:
begin
Result := True;
Setter(Value.bstrVal);
Setter(BinaryToUnicode(Value.bstrVal));
SysFreeString(Value.bstrVal);
end;
VT_I1:
@ -6191,15 +6191,15 @@ var
PropNames: array of PWideChar;
PropValues: array of TPropVariant;
procedure AddProperty(const Name: PWideChar; const Value: TPropVariant);
procedure AddProperty(const Name: WideString; const Value: TPropVariant);
begin
SetLength(PropNames, Length(PropNames)+1);
PropNames[High(PropNames)] := Name;
PropNames[High(PropNames)] := WideToBinary(Name);
SetLength(PropValues, Length(PropValues)+1);
PropValues[High(PropValues)] := Value;
end;
procedure AddCardinalProperty(const Name: PWideChar; Value: Cardinal);
procedure AddCardinalProperty(const Name: WideString; Value: Cardinal);
var
PropValue: TPropVariant;
begin
@ -6208,7 +6208,7 @@ var
AddProperty(Name, PropValue);
end;
procedure AddWideStringProperty(const Name: PWideChar; const Value: WideString);
procedure AddWideStringProperty(const Name: WideString; const Value: WideString);
var
PropValue: TPropVariant;
begin
@ -6217,7 +6217,7 @@ var
AddProperty(Name, PropValue);
end;
procedure AddBooleanProperty(const Name: PWideChar; Value: Boolean);
procedure AddBooleanProperty(const Name: WideString; Value: Boolean);
var
PropValue: TPropVariant;
const
@ -6227,6 +6227,7 @@ var
PropValue.bstrVal := WideToBinary(BooleanValues[Value]);
AddProperty(Name, PropValue);
end;
const
EncryptionMethodNames: array [TJclEncryptionMethod] of WideString =
( '' {emNone},
@ -6266,7 +6267,7 @@ begin
if Supports(AJclArchive, IJclArchiveDictionarySize, DictionarySize) and Assigned(DictionarySize) and
Supports(AJclArchive, IJclArchiveCompressionMethod, CompressionMethod) and Assigned(CompressionMethod) and
(CompressionMethod.CompressionMethod in [cmBZip2,cmLZMA,cmLZMA2]) then
AddWideStringProperty('D', IntToStr(DictionarySize.DictionarySize) + 'B');
AddWideStringProperty('D', WideString(IntToStr(DictionarySize.DictionarySize) + 'B'));
if Supports(AJclArchive, IJclArchiveNumberOfPasses, NumberOfPasses) and Assigned(NumberOfPasses) then
AddCardinalProperty('PASS', NumberOfPasses.NumberOfPasses);
@ -6304,20 +6305,25 @@ begin
if Solid.SolidExtension then
AddWideStringProperty('S', 'E');
if Solid.SolidBlockSize > 0 then
AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'B')
AddWideStringProperty('S', WideString(IntToStr(Solid.SolidBlockSize) + 'B'))
else
AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'F');
AddWideStringProperty('S', WideString(IntToStr(Solid.SolidBlockSize) + 'F'));
end;
JclArchive := AJclArchive as TJclCompressionArchive;
for Index := Low(JclArchive.PropNames) to High(JclArchive.PropNames) do
begin
AddProperty(PWideChar(JclArchive.PropNames[Index]), JclArchive.PropValues[Index]);
AddProperty(JclArchive.PropNames[Index], JclArchive.PropValues[Index]);
end;
end;
if Length(PropNames) > 0 then
begin
try
SevenZipCheck(PropertySetter.SetProperties(@PropNames[0], @PropValues[0], Length(PropNames)));
finally
for Index:= 0 to High(PropNames) do
begin
SysFreeString(PropNames[Index]);
end;
SetLength(JclArchive.PropNames, 0); SetLength(JclArchive.PropValues, 0);
end;
end;
@ -6617,7 +6623,7 @@ begin
except
on E: Exception do
begin
case MessageBoxW(0, PWideChar(UTF8Decode(E.Message)), nil, MB_ABORTRETRYIGNORE or MB_ICONERROR) of
case MessageBox(E.Message, nil, MB_ABORTRETRYIGNORE or MB_ICONERROR) of
IDABORT: Exit(E_ABORT);
IDIGNORE:
begin

464
plugins/wcx/sevenzip/src/jcl/doublecmd.diff
View file

@ -1,464 +0,0 @@
jcl/source/common/JclCompression.pas | 180 ++++++++++++++++++++++++++++++-----
jcl/source/windows/sevenzip.pas | 10 +-
2 files changed, 161 insertions(+), 29 deletions(-)
diff --git a/jcl/source/common/JclCompression.pas b/jcl/source/common/JclCompression.pas
index e5e6a2f..80889a3 100644
--- a/jcl/source/common/JclCompression.pas
+++ b/jcl/source/common/JclCompression.pas
@@ -44,8 +44,7 @@
unit JclCompression;
-{$I jcl.inc}
-{$I crossplatform.inc}
+{$mode delphi}
interface
@@ -75,7 +74,10 @@ uses
ZLib,
{$ENDIF ZLIB_RTL}
{$ENDIF ~HAS_UNITSCOPE}
- zlibh, bzip2, JclWideStrings, JclBase, JclStreams;
+ {$IFNDEF FPC}
+ zlibh, bzip2,
+ {$ENDIF FPC}
+ DCJclAlternative; // Must be after Classes, SysUtils, Windows
{$IFDEF RTL230_UP}
{$HPPEMIT '// To avoid ambiguity with System::Zlib::z_stream_s we force using ours'}
@@ -180,6 +182,9 @@ uses
**************************************************************************************************}
type
+
+{$IFNDEF FPC}
+
TJclCompressionStream = class(TJclStream)
private
FOnProgress: TNotifyEvent;
@@ -562,8 +567,12 @@ type
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
end;
+{$ENDIF FPC}
+
EJclCompressionError = class(EJclError);
+{$IFNDEF FPC}
+
// callback type used in helper functions below:
TJclCompressStreamProgressCallback = procedure(FileSize, Position: Int64; UserData: Pointer) of object;
@@ -586,6 +595,8 @@ procedure BZip2Stream(SourceStream, DestinationStream: TStream; CompressionLevel
procedure UnBZip2Stream(SourceStream, DestinationStream: TStream;
ProgressCallback: TJclCompressStreamProgressCallback = nil; UserData: Pointer = nil);
+{$ENDIF FPC}
+
// archive ancestor classes
{$IFDEF MSWINDOWS}
type
@@ -595,6 +606,7 @@ type
var AVolumeMaxSize: Int64) of object;
TJclCompressionProgressEvent = procedure(Sender: TObject; const Value, MaxValue: Int64) of object;
TJclCompressionRatioEvent = procedure(Sender: TObject; const InSize, OutSize: Int64) of object;
+ TJclCompressionPasswordEvent = procedure(Sender: TObject; var Password: WideString) of object;
TJclCompressionItemProperty = (ipPackedName, ipPackedSize, ipPackedExtension,
ipFileSize, ipFileName, ipAttributes, ipCreationTime, ipLastAccessTime,
@@ -770,6 +782,7 @@ type
FOnRatio: TJclCompressionRatioEvent;
FOnVolume: TJclCompressionVolumeEvent;
FOnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent;
+ FOnPassword: TJclCompressionPasswordEvent;
FPassword: WideString;
FVolumeIndex: Integer;
FVolumeIndexOffset: Integer;
@@ -803,6 +816,9 @@ type
// function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
+ public
+ PropNames: array of WideString;
+ PropValues: array of TPropVariant;
public
class function MultipleItemContainer: Boolean; virtual;
class function VolumeAccess: TJclStreamAccess; virtual;
@@ -855,6 +871,7 @@ type
property OnVolume: TJclCompressionVolumeEvent read FOnVolume write FOnVolume;
property OnVolumeMaxSize: TJclCompressionVolumeMaxSizeEvent read FOnVolumeMaxSize
write FOnVolumeMaxSize;
+ property OnPassword: TJclCompressionPasswordEvent read FOnPassword write FOnPassword;
property Password: WideString read FPassword write FPassword;
property SupportsNestedArchive: Boolean read GetSupportsNestedArchive;
@@ -1193,6 +1210,7 @@ function GetArchiveFormats: TJclCompressionArchiveFormats;
type
TJclSevenzipCompressArchive = class(TJclCompressArchive, IInterface)
private
+ FSfxModule: String;
FOutArchive: IOutArchive;
protected
function GetItemClass: TJclCompressionItemClass; override;
@@ -1203,6 +1221,7 @@ type
destructor Destroy; override;
procedure Compress; override;
property OutArchive: IOutArchive read GetOutArchive;
+ property SfxModule: String read FSfxModule write FSfxModule;
end;
// file formats
@@ -2189,6 +2208,9 @@ function Create7zFile(const SourceFile, DestinationFile: TFileName; VolumeSize:
OnArchiveProgress: TJclCompressionProgressEvent = nil;
OnArchiveRatio: TJclCompressionRatioEvent = nil): Boolean; overload;
+var
+ JclCompressSharedFiles: Boolean = False;
+
{$ENDIF MSWINDOWS}
{$IFDEF UNITVERSIONING}
@@ -2206,8 +2228,7 @@ const
implementation
uses
- JclUnicode, // WideSameText
- JclDateTime, JclFileUtils, JclResources, JclStrings, JclSysUtils;
+ DCJclResources, DCJclCompression;
const
JclDefaultBufferSize = 131072; // 128k
@@ -2218,6 +2239,8 @@ var
GlobalStreamFormats: TObject;
GlobalArchiveFormats: TObject;
+{$IFNDEF FPC}
+
//=== { TJclCompressionStream } ==============================================
constructor TJclCompressionStream.Create(AStream: TStream);
@@ -3743,6 +3766,8 @@ begin
end;
end;
+{$ENDIF FPC}
+
{$IFDEF MSWINDOWS}
function OpenFileStream(const FileName: TFileName; StreamAccess: TJclStreamAccess): TStream;
@@ -3887,7 +3912,7 @@ end;
function TJclCompressionItem.GetNestedArchiveName: WideString;
var
ParentArchiveExtension, ArchiveFileName, ArchiveExtension: WideString;
- ExtensionMap: TJclWideStrings;
+ ExtensionMap: TStrings;
begin
if ipPackedName in ValidProperties then
Result := PackedName
@@ -3914,7 +3939,7 @@ begin
else
if ArchiveFileName <> '' then
begin
- ExtensionMap := TJclWideStringList.Create;
+ ExtensionMap := TStringList.Create;
try
ExtensionMap.Delimiter := ';';
ExtensionMap.DelimitedText := Archive.ArchiveSubExtensions;
@@ -3962,9 +3987,16 @@ begin
end;
function TJclCompressionItem.GetStream: TStream;
+var
+ AItemAccess: TJclStreamAccess;
begin
if not Assigned(FStream) and (FileName <> '') then
- FStream := OpenFileStream(FileName, Archive.ItemAccess);
+ begin
+ AItemAccess:= Archive.ItemAccess;
+ if (AItemAccess = saReadOnly) and JclCompressSharedFiles then
+ AItemAccess:= saReadOnlyDenyNone;
+ FStream := OpenFileStream(FileName, AItemAccess);
+ end;
Result := FStream;
end;
@@ -5544,6 +5576,18 @@ begin
end;
if not AllHandled then
raise EJclCompressionError.CreateRes(@RsCompressionReplaceError);
+ end
+ else begin
+ // Remove temporary files
+ for Index := 0 to FVolumes.Count - 1 do
+ begin
+ AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+ if AVolume.OwnsTmpStream then
+ begin
+ FreeAndNil(AVolume.FTmpStream);
+ FileDelete(AVolume.TmpFileName);
+ end;
+ end;
end;
end;
@@ -5791,6 +5835,8 @@ begin
FItemIndex := AItemIndex;
FStream := nil;
FOwnsStream := False;
+
+ NeedStream;
end;
constructor TJclSevenzipInStream.Create(AStream: TStream; AOwnsStream: Boolean);
@@ -6117,6 +6163,8 @@ end;
procedure SetSevenzipArchiveCompressionProperties(AJclArchive: IInterface; ASevenzipArchive: IInterface);
var
+ Index: Integer;
+ JclArchive: TJclCompressionArchive;
PropertySetter: Sevenzip.ISetProperties;
InArchive, OutArchive: Boolean;
Unused: IInterface;
@@ -6254,9 +6302,18 @@ begin
else
AddWideStringProperty('S', IntToStr(Solid.SolidBlockSize) + 'F');
end;
+
+ JclArchive := AJclArchive as TJclCompressionArchive;
+ for Index := Low(JclArchive.PropNames) to High(JclArchive.PropNames) do
+ begin
+ AddProperty(PWideChar(JclArchive.PropNames[Index]), JclArchive.PropValues[Index]);
+ end;
end;
if Length(PropNames) > 0 then
+ begin
SevenZipCheck(PropertySetter.SetProperties(@PropNames[0], @PropValues[0], Length(PropNames)));
+ SetLength(JclArchive.PropNames, 0); SetLength(JclArchive.PropValues, 0);
+ end;
end;
end;
@@ -6510,7 +6567,10 @@ begin
// kpidCharacts: ;
// kpidVa: ;
// kpidId: ;
- // kpidShortName: ;
+ kpidShortName:
+ begin
+ Value.vt := VT_EMPTY;
+ end;
// kpidCreatorApp: ;
// kpidSectorSize: ;
kpidPosixAttrib:
@@ -6525,6 +6585,11 @@ begin
// kpidLocalName: ;
// kpidProvider: ;
// kpidUserDefined: ;
+ kpidIsAltStream:
+ begin
+ Value.vt := VT_BOOL;
+ Value.bool := False;
+ end;
else
Value.vt := VT_EMPTY;
Result := S_FALSE;
@@ -6534,9 +6599,27 @@ end;
function TJclSevenzipUpdateCallback.GetStream(Index: Cardinal;
out InStream: ISequentialInStream): HRESULT;
begin
+ Result := E_FAIL;
FLastStream := Index;
- InStream := TJclSevenzipInStream.Create(FArchive, Index);
- Result := S_OK;
+ repeat
+ try
+ InStream := TJclSevenzipInStream.Create(FArchive, Index);
+ Result := S_OK;
+ except
+ on E: Exception do
+ begin
+ case MessageBox(0, PAnsiChar(E.Message), nil, MB_ABORTRETRYIGNORE or MB_ICONERROR) of
+ IDABORT: Exit(E_ABORT);
+ IDIGNORE:
+ begin
+ FArchive.Items[Index].OperationSuccess := osNoOperation;
+ FLastStream := MAXDWORD;
+ Exit(S_FALSE);
+ end;
+ end;
+ end;
+ end;
+ until Result = S_OK;
end;
function TJclSevenzipUpdateCallback.GetUpdateItemInfo(Index: Cardinal; NewData,
@@ -6595,17 +6678,20 @@ end;
function TJclSevenzipUpdateCallback.SetOperationResult(
OperationResult: Integer): HRESULT;
begin
- case OperationResult of
- kOK:
- FArchive.Items[FLastStream].OperationSuccess := osOK;
- kUnSupportedMethod:
- FArchive.Items[FLastStream].OperationSuccess := osUnsupportedMethod;
- kDataError:
- FArchive.Items[FLastStream].OperationSuccess := osDataError;
- kCRCError:
- FArchive.Items[FLastStream].OperationSuccess := osCRCError;
- else
- FArchive.Items[FLastStream].OperationSuccess := osUnknownError;
+ if FLastStream < MAXDWORD then
+ begin
+ case OperationResult of
+ kOK:
+ FArchive.Items[FLastStream].OperationSuccess := osOK;
+ kUnSupportedMethod:
+ FArchive.Items[FLastStream].OperationSuccess := osUnsupportedMethod;
+ kDataError:
+ FArchive.Items[FLastStream].OperationSuccess := osDataError;
+ kCRCError:
+ FArchive.Items[FLastStream].OperationSuccess := osCRCError;
+ else
+ FArchive.Items[FLastStream].OperationSuccess := osUnknownError;
+ end;
end;
Result := S_OK;
@@ -6681,7 +6767,10 @@ end;
procedure TJclSevenzipCompressArchive.Compress;
var
+ Value: HRESULT;
+ Index: Integer;
OutStream: IOutStream;
+ AVolume: TJclCompressionVolume;
UpdateCallback: IArchiveUpdateCallback;
SplitStream: TJclDynamicSplitStream;
begin
@@ -6692,12 +6781,32 @@ begin
SplitStream := TJclDynamicSplitStream.Create(False);
SplitStream.OnVolume := NeedStream;
SplitStream.OnVolumeMaxSize := NeedStreamMaxSize;
- OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False);
+ if Length(FSfxModule) > 0 then
+ OutStream := TSfxSevenzipOutStream.Create(SplitStream, FSfxModule)
+ else begin
+ OutStream := TJclSevenzipOutStream.Create(SplitStream, True, False);
+ end;
UpdateCallback := TJclSevenzipUpdateCallback.Create(Self);
SetSevenzipArchiveCompressionProperties(Self, OutArchive);
- SevenzipCheck(OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
+ Value:= OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback);
+
+ if Value <> S_OK then
+ begin
+ // Remove partial archives
+ for Index := 0 to FVolumes.Count - 1 do
+ begin
+ AVolume := TJclCompressionVolume(FVolumes.Items[Index]);
+ if AVolume.OwnsStream then
+ begin
+ FreeAndNil(AVolume.FStream);
+ FileDelete(AVolume.FileName);
+ end;
+ end;
+ end;
+
+ SevenzipCheck(Value);
finally
FCompressing := False;
// release volumes and other finalizations
@@ -7422,7 +7531,14 @@ function TJclSevenzipOpenCallback.CryptoGetTextPassword(
password: PBStr): HRESULT;
begin
if Assigned(password) then
+ begin
+ if Length(FArchive.FPassword) = 0 then
+ begin
+ if Assigned(FArchive.OnPassword) then
+ FArchive.OnPassword(FArchive, FArchive.FPassword);
+ end;
password^ := SysAllocString(PWideChar(FArchive.Password));
+ end;
Result := S_OK;
end;
@@ -7456,7 +7572,14 @@ function TJclSevenzipExtractCallback.CryptoGetTextPassword(
password: PBStr): HRESULT;
begin
if Assigned(password) then
+ begin
+ if Length(FArchive.FPassword) = 0 then
+ begin
+ if Assigned(FArchive.OnPassword) then
+ FArchive.OnPassword(FArchive, FArchive.FPassword);
+ end;
password^ := SysAllocString(PWideChar(FArchive.Password));
+ end;
Result := S_OK;
end;
@@ -8807,6 +8930,7 @@ end;
procedure TJclSevenzipUpdateArchive.Compress;
var
+ Value: HRESULT;
OutStream: IOutStream;
UpdateCallback: IArchiveUpdateCallback;
SplitStream: TJclDynamicSplitStream;
@@ -8824,7 +8948,13 @@ begin
SetSevenzipArchiveCompressionProperties(Self, OutArchive);
- SevenzipCheck(OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback));
+ Value:= OutArchive.UpdateItems(OutStream, ItemCount, UpdateCallback);
+
+ if Value <> S_OK then
+ begin
+ FReplaceVolumes:= False;
+ SevenzipCheck(Value);
+ end;
finally
FCompressing := False;
// release reference to volume streams
diff --git a/jcl/source/windows/sevenzip.pas b/jcl/source/windows/sevenzip.pas
index 06fb94f..68f4ae2 100644
--- a/jcl/source/windows/sevenzip.pas
+++ b/jcl/source/windows/sevenzip.pas
@@ -53,10 +53,11 @@
unit sevenzip;
+{$mode delphi}
+
interface
-{$I jcl.inc}
-{$I windowsonly.inc}
+{$DEFINE 7ZIP_LINKONREQUEST}
uses
{$IFDEF HAS_UNITSCOPE}
@@ -67,8 +68,7 @@ uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
- JclBase,
- JclSysUtils;
+ DCJclAlternative;
//DOM-IGNORE-BEGIN
@@ -251,6 +251,8 @@ const
kpidPosixAttrib = 53;
kpidLink = 54;
+ kpidIsAltStream = 63;
+
kpidTotalSize = $1100;
kpidFreeSpace = $1101;
kpidClusterSize = $1102;

119
plugins/wcx/sevenzip/src/platform/sevenziphlp.pas
View file

@ -7,21 +7,49 @@ interface
uses
Classes, SysUtils, ActiveX;
const
FILE_ATTRIBUTE_UNIX_EXTENSION = $8000;
const
{$IF DEFINED(MSWINDOWS)}
SevenZipSfxExt = '.exe';
SevenZipSfxName = '7z.sfx';
SevenZipDefaultLibraryPath = '%ProgramFiles%\7-Zip\';
{$ELSE}
SevenZipSfxExt = '.run';
SevenZipSfxName = '7zCon.sfx';
SevenZipDefaultLibraryPath = '/usr/lib/7zip/';
{$ENDIF}
function GetNumberOfProcessors: LongWord;
function SysAttrToSevenZip(Attr: Cardinal): Cardinal;
function SevenZipToWcxAttr(Attr: Cardinal): Cardinal;
function WideToBinary(const Value: WideString): TBstr;
procedure VarStringClear(var PropVariant: TPropVariant);
function BinaryToUnicode(const bstrVal: TBstr): UnicodeString;
function CWideCharToWideString(const Value: Pointer): WideString;
function MessageBox(const Text: String; Caption: PAnsiChar; Flags: LongInt): Integer; overload;
function FileMove(const OldName, NewName: String): Boolean;
type
TMessageBoxFunction = function(Text, Caption: PAnsiChar; Flags: LongInt): Integer; winapi;
var
MessageBoxFunction: TMessageBoxFunction = nil;
implementation
uses
Windows
{$IF DEFINED(UNIX)}
, SevenZip
{$IF DEFINED(MSWINDOWS)}
Windows, DCWindows
{$ELSE}
SevenZip, DCUnix, FileUtil, DCOSUtils, DCFileAttributes
{$ENDIF}
;
function GetNumberOfProcessors: LongWord;
{$IF DEFINED(MSWINDOWS)}
var
SystemInfo: TSYSTEMINFO;
SystemAffinityMask: DWORD_PTR = 0;
@ -36,6 +64,42 @@ begin
Result:= SystemInfo.dwNumberOfProcessors;
end;
end;
{$ELSEIF DEFINED(LINUX) OR DEFINED(DARWIN) OR DEFINED(FREEBSD)}
begin
Result:= sysconf(_SC_NPROCESSORS_ONLN);
end;
{$ELSE}
begin
Result:= 1;
end;
{$ENDIF}
function SysAttrToSevenZip(Attr: Cardinal): Cardinal;
{$IF DEFINED(MSWINDOWS)}
begin
Result:= Attr;
end;
{$ELSE}
begin
Result:= UnixToWinFileAttr(Attr);
Result:= Result or FILE_ATTRIBUTE_UNIX_EXTENSION or ((Attr and $FFFF) << 16);
end;
{$ENDIF}
function SevenZipToWcxAttr(Attr: Cardinal): Cardinal;
{$IF DEFINED(MSWINDOWS)}
begin
Result:= Attr;
end;
{$ELSE}
begin
if (Attr and FILE_ATTRIBUTE_UNIX_EXTENSION <> 0) then
Result:= (Attr >> 16)
else begin
Result:= WinToUnixFileAttr(Attr);
end;
end;
{$ENDIF}
procedure VarStringClear(var PropVariant: TPropVariant);
begin
@ -77,4 +141,53 @@ begin
end;
{$ENDIF}
function CWideCharToWideString(const Value: Pointer): WideString;
{$IF DEFINED(MSWINDOWS)}
begin
Result:= WideString(PWideChar(Value));
end;
{$ELSE}
var
P: PUCS4Char;
S: UCS4String;
Len: Integer = 0;
begin
P:= PUCS4Char(Value);
while (P^ <> 0) do
begin
Inc(P);
Inc(Len);
end;
SetLength(S, Len + 1);
Move(Value^, Pointer(S)^, Len * SizeOf(UCS4Char));
Result:= UCS4StringToUnicodeString(S);
end;
{$ENDIF}
function MessageBox(const Text: String; Caption: PAnsiChar; Flags: LongInt): Integer;
begin
if (@MessageBoxFunction = nil) then
Result:= -1
else begin
Result:= MessageBoxFunction(PAnsiChar(Text), Caption, Flags);
end;
end;
function FileMove(const OldName, NewName: String): Boolean;
{$IF DEFINED(MSWINDOWS)}
begin
Result:= MoveFileExW(PWideChar(UTF16LongName(OldName)), PWideChar(UTF16LongName(NewName)),
MOVEFILE_REPLACE_EXISTING or MOVEFILE_COPY_ALLOWED);
end;
{$ELSE}
begin
Result:= RenameFile(OldName, NewName);
if (not Result) and (GetLastOSError = ERROR_NOT_SAME_DEVICE) then
begin
Result:= CopyFile(OldName, NewName, [cffOverwriteFile, cffPreserveTime]);
if Result then mbDeleteFile(OldName);
end;
end;
{$ENDIF}
end.

9
plugins/wcx/sevenzip/src/platform/unix/windows.pas
View file

@ -13,6 +13,15 @@ const
E_OUTOFMEMORY = HRESULT($8007000E);
FILE_ATTRIBUTE_ARCHIVE = faArchive;
FILE_ATTRIBUTE_DIRECTORY = faDirectory;
// MessageBox: Flags
MB_OK = $00000000;
MB_ABORTRETRYIGNORE = $00000002;
MB_ICONERROR = $00000010;
// MessageBox: Result
IDOK = 1;
IDABORT = 3;
IDRETRY = 4;
IDIGNORE = 5;
type
UCHAR = byte;