Skip to content

Allow to set multiple properties #13

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
MA-Maddin wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Allow to set multiple properties #13

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
87 changes: 63 additions & 24 deletions sevenzip.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,9 @@

interface

uses SysUtils, Windows, ActiveX, Classes, Contnrs, IOUtils, Math;
uses
System.SysUtils, Winapi.Windows, Winapi.ActiveX, System.Classes, System.Contnrs,
System.Generics.Collections, System.IOUtils, System.Math;

type
PInt32 = ^Int32;
Expand Down Expand Up @@ -1100,7 +1102,7 @@ interface
procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
procedure ClearBatch; stdcall;
procedure SetPassword(const password: UnicodeString); stdcall;
procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall;
procedure SetProperty(name: UnicodeString; value: TPropVariant); stdcall;
procedure SetClassId(const classid: TGUID);
function GetClassId: TGUID;
property ClassId: TGUID read GetClassId write SetClassId;
Expand Down Expand Up @@ -1211,7 +1213,7 @@ TArchiveFactory = class(TInterfacedObject, IArchiveFactory)
CLSID_CFormatXz : TGUID = '{23170F69-40C1-278A-1000-0001100C0000}'; // [OUT] xz
CLSID_CFormatPpmd : TGUID = '{23170F69-40C1-278A-1000-0001100D0000}'; // [IN ] ppmd
CLSID_CFormatZStd : TGUID = '{23170F69-40C1-278A-1000-0001100E0000}'; // zstd

CLSID_CFormatLvm : TGUID = '{23170F69-40C1-278A-1000-000110BF0000}'; // lvm

CLSID_CFormatAVB : TGUID = '{23170F69-40C1-278A-1000-000110C00000}';
Expand Down Expand Up @@ -1308,21 +1310,35 @@ procedure RINOK(const hr: HRESULT);
raise Exception.Create(SysErrorMessage(Cardinal(hr)));
end;

procedure SetCardinalProperty(arch: I7zOutArchive; const name: UnicodeString; card: Cardinal);
procedure SetCardinalProperty(Arch: I7zOutArchive; const Name: UnicodeString; Card: Cardinal);
var
value: OleVariant;
Value: TPropVariant;
begin
TPropVariant(value).vt := VT_UI4;
TPropVariant(value).ulVal := card;
arch.SetPropertie(name, value);
PropVariantInit(Value);
Value.vt := VT_UI4;
Value.ulVal := Card;
Arch.SetProperty(Name, Value);
end;

procedure SetBooleanProperty(arch: I7zOutArchive; const name: UnicodeString; bool: boolean);
procedure SetStringProperty(Arch: I7zOutArchive; const Name: UnicodeString; const Str: UnicodeString);
var
Value: TPropVariant;
begin
case bool of
true: arch.SetPropertie(name, 'ON');
false: arch.SetPropertie(name, 'OFF');
PropVariantInit(Value);
Value.vt := VT_BSTR;
Value.bstrVal := PWideChar(Str);
Arch.SetProperty(Name, Value);
end;

procedure SetBooleanProperty(Arch: I7zOutArchive; const Name: UnicodeString; Bool: Boolean);
var
BoolStr: UnicodeString;
begin
case Bool of
True: BoolStr := 'ON';
False: BoolStr := 'OFF';
end;
SetStringProperty(Arch, Name, BoolStr);
end;

procedure SetCompressionLevel(Arch: I7zOutArchive; level: Cardinal);
Expand All @@ -1337,12 +1353,12 @@ procedure SetMultiThreading(Arch: I7zOutArchive; ThreadCount: Cardinal);

procedure SetCompressionMethod(Arch: I7zOutArchive; method: TZipCompressionMethod);
begin
Arch.SetPropertie('M', ZipCompressionMethod[method]);
SetStringProperty(Arch, 'M', ZipCompressionMethod[method]);
end;

procedure SetEncryptionMethod(Arch: I7zOutArchive; method: TZipEncryptionMethod);
begin
Arch.SetPropertie('EM', ZipEncryptionMethod[method]);
SetStringProperty(Arch, 'EM', ZipEncryptionMethod[method]);
end;

procedure SetDictionnarySize(Arch: I7zOutArchive; size: Cardinal);
Expand Down Expand Up @@ -1372,12 +1388,12 @@ procedure SetNumMatchFinderCycles(Arch: I7zOutArchive; mc: Cardinal);

procedure SevenZipSetCompressionMethod(Arch: I7zOutArchive; method: T7zCompressionMethod);
begin
Arch.SetPropertie('0', SevCompressionMethod[method]);
SetStringProperty(Arch, '0', SevCompressionMethod[method]);
end;

procedure SevenZipSetBindInfo(Arch: I7zOutArchive; const bind: UnicodeString);
begin
arch.SetPropertie('B', bind);
SetStringProperty(Arch, 'B', bind);
end;

procedure SevenZipSetSolidSettings(Arch: I7zOutArchive; solid: boolean);
Expand Down Expand Up @@ -1546,6 +1562,7 @@ T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryp
FProgressCallback: T7zProgressCallback;
FProgressSender: Pointer;
FPassword: UnicodeString;
FProperties: TDictionary<PWideChar, TPropVariant>;
function GetOutArchive: IOutArchive;
protected
// I7zOutArchive
Expand All @@ -1559,7 +1576,7 @@ T7zOutArchive = class(T7zArchive, I7zOutArchive, IArchiveUpdateCallback, ICryp
procedure SetProgressCallback(sender: Pointer; callback: T7zProgressCallback); stdcall;
procedure ClearBatch; stdcall;
procedure SetPassword(const password: UnicodeString); stdcall;
procedure SetPropertie(name: UnicodeString; value: OleVariant); stdcall;
procedure SetProperty(name: UnicodeString; value: TPropVariant); stdcall;
// IProgress
function SetTotal(total: UInt64): HRESULT; stdcall;
function SetCompleted(completeValue: PUInt64): HRESULT; stdcall;
Expand Down Expand Up @@ -2420,7 +2437,7 @@ procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse: boo
end;
end;
until FindNext(f) <> 0;
SysUtils.FindClose(f);
System.SysUtils.FindClose(f);
end;

for i := 0 to willlist.Count - 1 do
Expand All @@ -2447,7 +2464,7 @@ procedure T7zOutArchive.AddFiles(const Dir, Path, Wildcard: string; recurse: boo
FBatchList.Add(item);
end;
until FindNext(f) <> 0;
SysUtils.FindClose(f);
System.SysUtils.FindClose(f);
end;
end;
begin
Expand Down Expand Up @@ -2494,6 +2511,7 @@ constructor T7zOutArchive.Create(const lib: string);
begin
inherited;
FBatchList := TObjectList.Create;
FProperties := TDictionary<PWideChar, TPropVariant>.Create;
FProgressCallback := nil;
FProgressSender := nil;
end;
Expand Down Expand Up @@ -2529,6 +2547,7 @@ destructor T7zOutArchive.Destroy;
begin
FOutArchive := nil;
FBatchList.Free;
FProperties.Free;
inherited;
end;

Expand Down Expand Up @@ -2699,15 +2718,34 @@ procedure T7zOutArchive.SetProgressCallback(sender: Pointer;
FProgressSender := sender;
end;

procedure T7zOutArchive.SetPropertie(name: UnicodeString;
value: OleVariant);
procedure T7zOutArchive.SetProperty(name: UnicodeString; value: TPropVariant);
const
// only a random value; the number of adjustable properties must fit into it
PROPERTIES_HIGH = 31;
var
intf: ISetProperties;
p: PWideChar;
PropName: PWideChar;
Names: array[0..PROPERTIES_HIGH] of PWideChar;
Values: array[0..PROPERTIES_HIGH] of TPropVariant;
I: Integer;
begin
intf := OutArchive as ISetProperties;
p := PWideChar(name);
RINOK(intf.SetProperties(@p, @TPropVariant(value), 1));
PropName := PWideChar(name);

if FProperties.ContainsKey(PropName) then
FProperties[PropName] := value
else
FProperties.Add(PropName, value);

I := 0;
for PropName in FProperties.Keys do
begin
Names[I] := PropName;
Values[I] := FProperties[PropName];
Inc(I);
end;

RINOK(intf.SetProperties(@Names, @Values, I));
end;

function T7zOutArchive.SetTotal(total: UInt64): HRESULT;
Expand All @@ -2728,3 +2766,4 @@ function T7zOutArchive.SetTotal(total: UInt64): HRESULT;
end;

end.