diff --git a/src/DSiWin32.pas b/src/DSiWin32.pas
index 41d8bf14..f01b9d3c 100644
--- a/src/DSiWin32.pas
+++ b/src/DSiWin32.pas
@@ -8,10 +8,15 @@
Christian Wimmer, Tommi Prami, Miha, Craig Peterson, Tommaso Ercole,
bero.
Creation date : 2002-10-09
- Last modification : 2021-03-02
- Version : 2.0b
+ Last modification : 2021-10-26
+ Version : 2.01a
*)(*
History:
+ 2.01a: 2021-10-26
+ - Fixed DSiUnregisterUserFileAssoc. (https://stackoverflow.com/a/67519966)
+ 2.01: 2021-07-28
+ - Added two overloaded DSiEnumFilesEx versions that return (unexpected) errors -
+ one in a callback and another in parameters.
2.0b: 2021-03-02
- All unit names are fully scoped (when supported).
2.0a: 2021-02-05
@@ -1151,6 +1156,9 @@ _MEMORYSTATUSEX = record
procedure(const folder: string; S: TSearchRec;
isAFolder: boolean; var stopEnum: boolean)
{$IFNDEF DSiHasAnonymousFunctions}of object{$ENDIF};
+ TDSiEnumFilesExErrorCallback = {$IFDEF DSiHasAnonymousFunctions}reference to{$ENDIF}
+ procedure(const path: string; err: integer)
+ {$IFNDEF DSiHasAnonymousFunctions}of object{$ENDIF};
// DSiExecuteAndCapture callback
TDSiOnNewLineCallback = {$IFDEF DSiHasAnonymousFunctions}reference to{$ENDIF}
@@ -1318,8 +1326,13 @@ TDSiFileInfo = class
enumCallback: TDSiEnumFilesCallback): integer;
function DSiEnumFilesEx(const fileMask: string; attr: integer;
enumSubfolders: boolean; enumCallback: TDSiEnumFilesExCallback;
- maxEnumDepth: integer = 0;
- ignoreDottedFolders: boolean = false): integer;
+ maxEnumDepth: integer = 0; ignoreDottedFolders: boolean = false): integer; overload;
+ function DSiEnumFilesEx(const fileMask: string; attr: integer; enumSubfolders: boolean;
+ enumCallback: TDSiEnumFilesExCallback; errorCallback: TDSiEnumFilesExErrorCallback;
+ maxEnumDepth: integer = 0; ignoreDottedFolders: boolean = false): integer; overload;
+ function DSiEnumFilesEx(const fileMask: string; attr: integer; enumSubfolders: boolean;
+ enumCallback: TDSiEnumFilesExCallback; var error: integer; var errorPath: string;
+ maxEnumDepth: integer = 0; ignoreDottedFolders: boolean = false): integer; overload;
procedure DSiEnumFilesToSL(const fileMask: string; attr: integer; fileList: TStrings;
storeFullPath: boolean = false; enumSubfolders: boolean = false;
maxEnumDepth: integer = 0;
@@ -1378,7 +1391,7 @@ TDSiFileInfo = class
wait: boolean = false): cardinal; overload;
function DSiExecute(const commandLine: string; var processInfo: TProcessInformation;
visibility: integer = SW_SHOWDEFAULT; const workDir: string = '';
- creationFlags: DWORD = CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS): cardinal; overload;
+ creationFlags: DWORD = CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS; stdIn: THandle = 0): cardinal; overload;
function DSiExecuteAndCapture(const app: string; output: TStrings; const workDir: string;
var exitCode: longword; waitTimeout_sec: integer = 15;
onNewLine: TDSiOnNewLineCallback = nil;
@@ -3214,7 +3227,7 @@ TOKEN_USER = record
}
procedure DSiUnregisterUserFileAssoc(const progID: string);
begin
- DSiKillRegistry('\Software\Classes\' + progID, HKEY_CURRENT_USER);
+ DSiKillRegistry('\Software\Classes\' + progID, HKEY_CURRENT_USER, KEY_ALL_ACCESS);
end; { DSiUnregisterUserFileAssoc }
{ Files }
@@ -3618,9 +3631,11 @@ TOKEN_USER = record
finally FindClose(S); end;
end; { DSiEnumFiles }
- procedure _DSiEnumFilesEx(const folder, fileMask: string; attr: integer; enumSubfolders:
- boolean; enumCallback: TDSiEnumFilesExCallback; var totalFiles: integer; var stopEnum:
- boolean; fileList: TStrings; fileObjectList: TObjectList; storeFullPath: boolean;
+ procedure _DSiEnumFilesEx(const folder, fileMask: string; attr: integer;
+ enumSubfolders: boolean; enumCallback: TDSiEnumFilesExCallback;
+ errorCallback: TDSiEnumFilesExErrorCallback;
+ var totalFiles: integer; var stopEnum: boolean; fileList: TStrings;
+ fileObjectList: TObjectList; storeFullPath: boolean;
currentDepth, maxDepth: integer; ignoreDottedFolders: boolean);
var
err: integer;
@@ -3628,7 +3643,11 @@ TOKEN_USER = record
begin
if enumSubfolders and ((maxDepth <= 0) or (currentDepth < maxDepth)) then begin
err := FindFirst(folder+'*.*', faDirectory or (attr and faHidden), S);
- if err = 0 then try
+ if err <> 0 then begin
+ if assigned(errorCallback) then
+ errorCallback(folder, err);
+ end
+ else try
repeat
if (S.Attr and faDirectory) <> 0 then
if (S.Name <> '.') and (S.Name <> '..') and
@@ -3651,17 +3670,23 @@ TOKEN_USER = record
fileObjectList.Add(TDSiFileInfo.Create(folder, S, currentDepth));
{$IFDEF DSiScopedUnitNames}end;{$ENDIF}
_DSiEnumFilesEx(folder+S.Name+'\', fileMask, attr, enumSubfolders,
- enumCallback, totalFiles, stopEnum, fileList, fileObjectList,
+ enumCallback, errorCallback, totalFiles, stopEnum, fileList, fileObjectList,
storeFullPath, currentDepth + 1, maxDepth, ignoreDottedFolders);
end;
err := FindNext(S);
+ if (err <> 0) and (err <> ERROR_NO_MORE_FILES) and assigned(errorCallback) then
+ errorCallback(folder + S.Name, err);
until (err <> 0) or stopEnum;
finally FindClose(S); end;
end;
if stopEnum then
Exit;
- err := FindFirst(folder+fileMask, attr, S);
- if err = 0 then try
+ err := FindFirst(folder + fileMask, attr, S);
+ if err <> 0 then begin
+ if (err <> ERROR_FILE_NOT_FOUND) and assigned(errorCallback) then
+ errorCallback(folder + fileMask, err);
+ end
+ else try
repeat
// don't filter anything
//if (S.Attr AND attr <> 0) or (S.Attr AND attr = attr) then begin
@@ -3680,6 +3705,8 @@ TOKEN_USER = record
Inc(totalFiles);
end;
err := FindNext(S);
+ if (err <> 0) and (err <> ERROR_NO_MORE_FILES) and assigned(errorCallback) then
+ errorCallback(folder + S.Name, err);
until (err <> 0) or stopEnum;
finally FindClose(S); end;
end; { _DSiEnumFilesEx }
@@ -3691,8 +3718,8 @@ TOKEN_USER = record
@since 2003-06-17
}
function DSiEnumFilesEx(const fileMask: string; attr: integer; enumSubfolders: boolean;
- enumCallback: TDSiEnumFilesExCallback; maxEnumDepth: integer;
- ignoreDottedFolders: boolean): integer;
+ enumCallback: TDSiEnumFilesExCallback; errorCallback: TDSiEnumFilesExErrorCallback;
+ maxEnumDepth: integer; ignoreDottedFolders: boolean): integer; overload;
var
folder : string;
mask : string;
@@ -3705,10 +3732,37 @@ TOKEN_USER = record
folder := IncludeTrailingBackslash(folder);
Result := 0;
stopEnum := false;
- _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, enumCallback, Result, stopEnum,
+ _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, enumCallback, errorCallback, Result, stopEnum,
nil, nil, false, 1, maxEnumDepth, ignoreDottedFolders);
end; { DSiEnumFilesEx }
+ function DSiEnumFilesEx(const fileMask: string; attr: integer;
+ enumSubfolders: boolean; enumCallback: TDSiEnumFilesExCallback;
+ maxEnumDepth: integer; ignoreDottedFolders: boolean): integer; overload;
+ begin
+ Result := DSiEnumFilesEx(fileMask, attr, enumSubfolders, enumCallback, nil, maxEnumDepth, ignoreDottedFolders);
+ end; { DSiEnumFilesEx }
+
+ function DSiEnumFilesEx(const fileMask: string; attr: integer; enumSubfolders: boolean;
+ enumCallback: TDSiEnumFilesExCallback; var error: integer; var errorPath: string;
+ maxEnumDepth: integer; ignoreDottedFolders: boolean): integer; overload;
+ var
+ _error: integer;
+ _errorPath : string;
+ begin
+ _error := 0;
+ _errorPath := '';
+ Result := DSiEnumFilesEx(fileMask, attr, enumSubfolders, enumCallback,
+ procedure (const path: string; err: integer)
+ begin
+ _error := err;
+ _errorPath := path;
+ end,
+ maxEnumDepth, ignoreDottedFolders);
+ error := _error;
+ errorPath := _errorPath;
+ end; { DSiEnumFilesEx }
+
{:Enumerates files (optionally in subfolders) and stores results into caller-provided
TStrings object.
@since 2006-05-14
@@ -3729,7 +3783,7 @@ TOKEN_USER = record
if folder <> '' then
folder := IncludeTrailingBackslash(folder);
stopEnum := false;
- _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, nil, totalFiles, stopEnum,
+ _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, nil, nil, totalFiles, stopEnum,
fileList, nil, storeFullPath, 1, maxEnumDepth, ignoreDottedFolders);
end; { DSiEnumFilesToSL }
@@ -3754,7 +3808,7 @@ TOKEN_USER = record
if folder <> '' then
folder := IncludeTrailingBackslash(folder);
stopEnum := false;
- _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, nil, totalFiles, stopEnum,
+ _DSiEnumFilesEx(folder, mask, attr, enumSubfolders, nil, nil, totalFiles, stopEnum,
nil, fileList, true{ignored}, 1, maxEnumDepth, ignoreDottedFolders);
end; { DSiEnumFilesToOL }
@@ -4750,7 +4804,7 @@ ACCESS_ALLOWED_ACE = record
end; { DSiExecute }
function DSiExecute(const commandLine: string; var processInfo: TProcessInformation;
- visibility: integer; const workDir: string; creationFlags: DWORD): cardinal;
+ visibility: integer; const workDir: string; creationFlags: DWORD; stdIn: THandle): cardinal;
var
startupInfo: TStartupInfo;
tmpCmdLine : string;
@@ -4763,7 +4817,10 @@ ACCESS_ALLOWED_ACE = record
FillChar(startupInfo, SizeOf(startupInfo), #0);
startupInfo.cb := SizeOf(startupInfo);
startupInfo.dwFlags := STARTF_USESHOWWINDOW;
+ if stdIn > 0 then
+ startupInfo.dwFlags := startupInfo.dwFlags or STARTF_USESTDHANDLES;
startupInfo.wShowWindow := visibility;
+ startupInfo.hStdInput := stdIn;
tmpCmdLine := commandLine;
{$IFDEF Unicode}UniqueString(tmpCmdLine);{$ENDIF Unicode}
if not CreateProcess(nil, PChar(tmpCmdLine), nil, nil, false,
diff --git a/src/GpStreams.pas b/src/GpStreams.pas
index bfcb7627..511dfb92 100644
--- a/src/GpStreams.pas
+++ b/src/GpStreams.pas
@@ -30,10 +30,19 @@
Author : Primoz Gabrijelcic
Creation date : 2006-09-21
- Last modification : 2021-02-26
- Version : 2.0
+ Last modification : 2021-03-16
+ Version : 2.01a
*)(*
History:
+ 2.02: 2021-03-30
+ - Changed TGpStreamEnhancer.GoToStart and .GoToEnd to a function returning Self.
+ 2.01a: 2021-03-16
+ - Implemented missing TGpPagedStream.SetSize.
+ 2.01: 2021-03-05
+ - Implemented TGpPagedStream which provides access to another stream in page-aligned,
+ multiple-of-page-size chunks (except at the very end).
+ - Implemented TGpBaseEncryptedStream, a base stream for writing concrete
+ encrypted stream implementation. (See GpStreams.DCP for an example.)
2.0: 2021-02-26
- Reparented all stream-wrapping streams on the new TGpStreamWrapper class.
1.57: 2020-11-30
@@ -215,7 +224,7 @@
*)
unit GpStreams;
-
+
interface
{$IFDEF CONDITIONALEXPRESSIONS}
@@ -350,8 +359,8 @@ TGpScatteredStream = class(TGpStreamWrapper)
autoDestroyWrappedStream: boolean = false); overload;
destructor Destroy; override;
function AddSpan(firstPos, lastPos: int64): integer;
- function AddSpanOS(offset, size: int64): integer; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
- function CountSpans: integer; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ function AddSpanOS(offset, size: int64): integer; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ function CountSpans: integer; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
function CumulativeSize: int64;
function LocateCumulativeOffset(offset: int64): integer;
function Read(var buffer; count: integer): integer; override;
@@ -366,8 +375,8 @@ TGpScatteredStream = class(TGpStreamWrapper)
TGpInterceptorReadProc = function (position: int64; var buffer; count: integer): integer of object;
TGpInterceptorWriteProc = function (position: int64; const buffer; count: integer): integer of object;
- TGpInterceptorSeekProc = function (const offset: int64; origin: TSeekOrigin): int64 of object;
- TGpInterceptorSetSizeProc = procedure (const newSize: int64) of object;
+ TGpInterceptorSeekProc = function (offset: int64; origin: TSeekOrigin): int64 of object;
+ TGpInterceptorSetSizeProc = procedure (newSize: int64) of object;
///Interceptor stream-alike which reroutes read/write/seek calls to custom wrappers.
TGpInterceptorStream = class(TStream)
@@ -389,7 +398,7 @@ TGpInterceptorStream = class(TStream)
property Position: int64 read FCurrentPos write SetPosition;
end; { TGpInterceptorStream }
- ///Provides a buffered access to another stream.
+ ///Provides a read-buffered access to another stream.
///2007-10-04
TGpBufferedStream = class(TGpStreamWrapper)
{$IFDEF USE_STRICT} strict {$ENDIF} private
@@ -413,25 +422,64 @@ TGpBufferedStream = class(TGpStreamWrapper)
function Write(const buffer; count: integer): integer; override;
end; { TGpBufferedStream }
- // https://en.wikipedia.org/wiki/Block_cipher_mode_of_operation#Counter_(CTR)
- // GpStreams.DCP
+ ///Provides a paged access to another stream. Data is always accessed in
+ /// page-aligned chunks. Except at the very end of the stream all data access sizes
+ /// are multiple of the page size.
+ TGpPagedStream = class(TGpStreamWrapper)
+ private
+ FBuffer : PAnsiChar;
+ FBufferDirty: boolean;
+ FBufferLen : integer;
+ FBufferPtr : PAnsiChar;
+ FBufferPos : int64;
+ FPageSize : integer;
+ protected
+ function GetPosition: int64; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ function GetSize: int64; override;
+ function InBuffer(offset: int64): boolean; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ function InternalSeek(offset: int64): int64;
+ procedure SetPosition(value: int64); {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ procedure SetSize(const newSize: int64); override;
+ public
+ constructor Create(baseStream: TStream; pageSize: integer;
+ autoDestroyWrappedStream: boolean = false); overload;
+ destructor Destroy; override;
+ procedure Flush;
+ function Read(var buffer; count: integer): integer; override;
+ function Seek(const offset: int64; origin: TSeekOrigin): int64; overload; override;
+ function Write(const buffer; count: integer): integer; override;
+ property Position: int64 read GetPosition write SetPosition;
+ end; { TGpPagedStream }
+
+ ///Encrypts/decrypts wrapped stream on the fly. Abstract class, doesn't
+ /// provide any encryption support. Specific implementation should be put in
+ /// external units (see GpStreams.DCP for an example).
+ /// Uses CTR encryption mode:
+ /// https://en.wikipedia.org/wiki/Block_cipher_mode_of_operation#Counter_(CTR)
+ ///
TGpBaseEncryptedStream = class(TGpStreamWrapper)
private
- const
- CBufferSize = 1024;
- var
- FBufferer : TGpBufferedStream;
FInterceptor: TGpInterceptorStream;
- protected
+ FPaginator : TGpPagedStream;
+ protected { abstract }
+ procedure DecryptCTR(position: int64; var buffer; count: integer); virtual; abstract;
procedure DoneCypher; virtual; abstract;
+ procedure EncryptCTR(position: int64; var buffer; count: integer); virtual; abstract;
+ procedure InitCypher(const key; keySize: integer; var ctrBlockSize: integer; nonce: uint64); virtual; abstract;
+ protected
function GetSize: int64; override;
- procedure InitCypher(const key; keySize: integer; nonce: uint64); virtual; abstract;
- function InternalSeek(offset: int64): int64;
+ function InterceptRead(position: int64; var buffer; count: integer): integer;
+ function InterceptSeek(offset: int64; origin: TSeekOrigin): int64;
+ procedure InterceptSetSize(newSize: int64);
+ function InterceptWrite(position: int64; const buffer; count: integer): integer;
+ procedure SetSize(const newSize: int64); override;
public
constructor Create(const key; keySize: integer; nonce: uint64;
baseStream: TStream; autoDestroyWrappedStream: boolean = false);
destructor Destroy; override;
+ function Read(var buffer; count: integer): integer; override;
function Seek(const offset: int64; origin: TSeekOrigin): int64; overload; override;
+ function Write(const buffer; count: integer): integer; override;
end; { TGpBaseEncryptedStream }
///Provides a streamed access to collection of streams.
@@ -598,8 +646,8 @@ TGpStreamEnhancer = class helper for TStream
function GetAsHexString: string;
function GetAsAnsiString: AnsiString;
function GetAsString: string;
- procedure GoToStart; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
- procedure GoToEnd; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ function GoToStart: TStream; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
+ function GoToEnd: TStream; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
function IsEmpty: boolean; {$IFDEF GpStreams_Inline}inline;{$ENDIF}
procedure LoadFromFile(const fileName: string);
procedure SaveToFile(const fileName: string);
@@ -733,6 +781,9 @@ TGpFileStream = class(THandleStream)
implementation
+uses
+ Math;
+
type
TGpDoNothingStreamWrapper = class(TInterfacedObject, IGpStreamWrapper)
private
@@ -2205,9 +2256,10 @@ function TGpStreamEnhancer.GetAsString: string;
Read(Result[1], Length(Result)*SizeOf(char));
end; { TGpStreamEnhancer.GetAsString }
-procedure TGpStreamEnhancer.GoToEnd;
+function TGpStreamEnhancer.GoToEnd: TStream;
begin
Position := Size;
+ Result := Self;
end; { TGpStreamEnhancer.GoToEnd }
function TGpStreamEnhancer.IsEmpty: boolean;
@@ -2229,9 +2281,10 @@ function TGpStreamEnhancer.GetTag(var tag: integer; var stream: IGpStreamWrapper
end;
end; { TGpStreamEnhancer.GetTag }
-procedure TGpStreamEnhancer.GoToStart;
+function TGpStreamEnhancer.GoToStart: TStream;
begin
Position := 0;
+ Result := Self;
end; { TGpStreamEnhancer.GoToStart }
procedure TGpStreamEnhancer.KeepLast(numBytes: integer);
@@ -2914,47 +2967,317 @@ procedure TRawByteStringStream.SetSize(newSize: longint);
FPosition := newSize;
end; { TRawByteStringStream.SetSize }
+{ TGpPagedStream }
+
+constructor TGpPagedStream.Create(baseStream: TStream; pageSize: integer;
+ autoDestroyWrappedStream: boolean);
+begin
+ inherited Create(baseStream, autoDestroyWrappedStream);
+ FPageSize := pageSize;
+ GetMem(FBuffer, FPageSize);
+ FBufferLen := -1;
+ FBufferPtr := FBuffer;
+ FBufferPos := WrappedStream.Position;
+end; { TGpPagedStream.Create }
+
+destructor TGpPagedStream.Destroy;
+begin
+ Flush;
+ if assigned(FBuffer) then
+ FreeMem(FBuffer);
+ inherited;
+end; { TGpPagedStream.Destroy }
+
+procedure TGpPagedStream.Flush;
+begin
+ if (FBufferLen <= 0) or (not FBufferDirty) then
+ Exit;
+
+ WrappedStream.Position := FBufferPos;
+ WrappedStream.Write(FBuffer^, FBufferLen);
+ FBufferDirty := false;
+end; { TGpPagedStream.Flush }
+
+function TGpPagedStream.GetPosition: int64;
+begin
+ Result := FBufferPos + (FBufferPtr - FBuffer);
+end; { TGpPagedStream.GetPosition }
+
+function TGpPagedStream.GetSize: int64;
+begin
+ Result := WrappedStream.Size;
+end; { TGpPagedStream.GetSize }
+
+function TGpPagedStream.InBuffer(offset: int64): boolean;
+begin
+ Result := (FBufferLen > 0) and (offset >= FBufferPos) and (offset < (FBufferPos + FBufferLen));
+end; { TGpPagedStream.InBuffer }
+
+function TGpPagedStream.InternalSeek(offset: int64): int64;
+begin
+ if InBuffer(offset) then
+ FBufferPtr := FBuffer + (offset - FBufferPos)
+ else begin
+ Flush;
+ FBufferPos := RoundDownTo(offset, FPageSize);
+ FBufferPtr := FBuffer + (offset - FBufferPos);
+ FBufferLen := -1;
+ end;
+
+ Result := Position;
+end; { TGpPagedStream.InternalSeek }
+
+function TGpPagedStream.Read(var buffer; count: integer): integer;
+var
+ available: integer;
+ bufp : PAnsiChar;
+ inBuf : boolean;
+ requested: integer;
+begin
+ Result := 0;
+ if count <= 0 then
+ Exit;
+
+ bufp := @buffer;
+ inBuf := InBuffer(Position);
+
+ if not inBuf then begin
+ Flush;
+ if (FBufferPtr - FBuffer) = FPageSize then begin
+ Inc(FBufferPos, FPageSize);
+ FBufferPtr := FBuffer;
+ FBufferLen := 0;
+ end;
+ WrappedStream.Position := FBufferPos;
+ FBufferLen := WrappedStream.Read(FBuffer^, FPageSize);
+ inBuf := InBuffer(Position);
+ if not InBuf then
+ Exit;
+ end;
+
+ if inBuf then begin
+ available := FBufferLen - (FBufferPtr - FBuffer);
+ Assert(available > 0);
+ if count < available then
+ available := count;
+ Move(FBufferPtr^, bufp^, available);
+ Inc(FBufferPtr, available);
+ Inc(bufp, available);
+ Dec(count, available);
+ Inc(Result, available);
+ if count = 0 then
+ Exit;
+ end;
+
+ Flush;
+ FBufferPos := Position;
+ FBufferLen := 0;
+ FBufferPtr := FBuffer;
+
+ Flush;
+ WrappedStream.Position := Position;
+
+ requested := (count div FPageSize) * FPageSize;
+ if requested > 0 then begin
+ available := WrappedStream.Read(bufp^, requested);
+ Position := WrappedStream.Position;
+ Inc(bufp, available);
+ Dec(count, available);
+ Inc(Result, available);
+ if (count = 0) or (available <> requested) then
+ Exit;
+ end;
+
+ FBufferLen := WrappedStream.Read(FBuffer^, FPageSize);
+ available := Min(FBufferLen, count);
+ Move(FBuffer^, bufp^, available);
+ FBufferPtr := FBuffer + available;
+ Inc(Result, available);
+end; { TGpPagedStream.Read }
+
+function TGpPagedStream.Seek(const offset: int64; origin: TSeekOrigin): int64;
+begin
+ case origin of
+ soBeginning:
+ Result := InternalSeek(offset);
+ soEnd:
+ Result := InternalSeek(WrappedStream.Size + offset);
+ else
+ Result := InternalSeek(Position + offset);
+ end;
+end; { TGpPagedStream.Seek }
+
+procedure TGpPagedStream.SetPosition(value: int64);
+begin
+ InternalSeek(value);
+end; { TGpPagedStream.SetPosition }
+
+procedure TGpPagedStream.SetSize(const newSize: int64);
+begin
+ WrappedStream.Size := newSize;
+end; { TGpPagedStream.SetSize }
+
+function TGpPagedStream.Write(const buffer; count: integer): integer;
+var
+ available: integer;
+ bufp : PAnsiChar;
+ inBuf : boolean;
+ oldData : integer;
+ posSet : boolean;
+ requested: integer;
+ written : integer;
+begin
+ Result := 0;
+ if count <= 0 then
+ Exit;
+
+ bufp := @buffer;
+ posSet := false;
+
+ if (Position mod FPageSize) <> 0 then begin
+ inBuf := InBuffer(Position) or (FBufferPtr = (FBuffer + FBufferLen));
+
+ if not inBuf then begin
+ WrappedStream.Position := FBufferPos;
+ FBufferLen := WrappedStream.Read(FBuffer^, FPageSize);
+ FBufferDirty := false;
+ inBuf := InBuffer(Position);
+ if not InBuf then
+ Exit;
+ end;
+
+ if inBuf then begin
+ available := FPageSize - (FBufferPtr - FBuffer);
+ Assert(available > 0);
+ if count < available then
+ available := count;
+ oldData := FBufferPtr - FBuffer;
+ Move(bufp^, FBufferPtr^, available);
+ if (oldData + available) < FPageSize then begin
+ Inc(FBufferPtr, available);
+ Inc(Result, available);
+ FBufferLen := Max(FBufferLen, oldData + available);
+ FBufferDirty := true;
+ Exit;
+ end
+ else begin
+ FBufferLen := Max(FBufferLen, oldData + available);
+ if not posSet then
+ WrappedStream.Position := FBufferPos;
+ posSet := true;
+ written := WrappedStream.Write(FBuffer^, FBufferLen);
+ FBufferDirty := false;
+// FBufferPos := RoundDownTo(FBufferPos + written, FPageSize);
+ written := written - oldData;
+ if written < 0 then
+ written := 0;
+ Inc(FBufferPtr, written);
+ Dec(count, written);
+ Inc(Result, written);
+ if (count = 0) or ((written + oldData) <> FBufferLen) then
+ Exit;
+ Inc(bufp, written);
+ Position := WrappedStream.Position;
+ end;
+ end;
+ end;
+
+ Flush;
+ FBufferLen := 0;
+ if (FBufferPtr - FBuffer) = FPageSize then
+ Inc(FBufferPos, FPageSize);
+ FBufferPtr := FBuffer;
+
+ if not posSet then
+ WrappedStream.Position := Position;
+ requested := (count div FPageSize) * FPageSize;
+ if requested > 0 then begin
+ written := WrappedStream.Write(bufp^, requested);
+ Position := WrappedStream.Position;
+ Inc(bufp, written);
+ Dec(count, written);
+ Inc(Result, written);
+ if (count = 0) or (written <> requested) then
+ Exit;
+ end;
+
+ FBufferLen := WrappedStream.Read(FBuffer^, FPageSize);
+ Move(bufp^, FBuffer^, count);
+ FBufferPtr := FBuffer + count;
+ FBufferLen := Max(FBufferLen, count);
+ Inc(Result, count);
+ FBufferDirty := true;
+end; { TGpPagedStream.Write }
+
{ TGpBaseEncryptedStream }
constructor TGpBaseEncryptedStream.Create(const key; keySize: integer; nonce: uint64;
baseStream: TStream; autoDestroyWrappedStream: boolean);
+var
+ blockSize: integer;
begin
inherited Create(baseStream, autoDestroyWrappedStream);
- FBufferer := TGpBufferedStream.Create(baseStream, CBufferSize, false);
+ InitCypher(key, keySize, blockSize, nonce);
FInterceptor := TGpInterceptorStream.Create(InterceptRead, InterceptWrite, InterceptSeek, InterceptSetSize);
- InitCypher(key, keySize, nonce);
+ FPaginator := TGpPagedStream.Create(FInterceptor, blockSize, false);
end; { TGpBaseEncryptedStream.Create }
destructor TGpBaseEncryptedStream.Destroy;
begin
+ FPaginator.Flush;
DoneCypher;
- FreeAndNil(FBufferer);
+ FreeAndNil(FPaginator);
FreeAndNil(FInterceptor);
inherited;
end; { TGpBaseEncryptedStream.Destroy }
function TGpBaseEncryptedStream.GetSize: int64;
begin
- Result := FBaseStream.Size;
- // TODO 1 -oPrimoz Gabrijelcic : plus size of unwritten buffer
+ Result := FPaginator.Size;
end; { TGpBaseEncryptedStream.GetSize }
-function TGpBaseEncryptedStream.InternalSeek(offset: int64): int64;
+function TGpBaseEncryptedStream.InterceptRead(position: int64; var buffer;
+ count: integer): integer;
+begin
+ Result := WrappedStream.Read(buffer, count);
+ DecryptCTR(position, buffer, Result);
+end; { TGpBaseEncryptedStream.InterceptRead }
+
+function TGpBaseEncryptedStream.InterceptSeek(offset: int64; origin: TSeekOrigin): int64;
+begin
+ Result := WrappedStream.Seek(offset, origin);
+end; { TGpBaseEncryptedStream.InterceptSeek }
+
+procedure TGpBaseEncryptedStream.InterceptSetSize(newSize: int64);
+begin
+ WrappedStream.Size := newSize;
+end; { TGpBaseEncryptedStream.InterceptSetSize }
+
+function TGpBaseEncryptedStream.InterceptWrite(position: int64; const buffer;
+ count: integer): integer;
+begin
+ EncryptCTR(position, PByte(@buffer)^, count);
+ Result := WrappedStream.Write(buffer, count);
+end; { TGpBaseEncryptedStream.InterceptWrite }
+
+function TGpBaseEncryptedStream.Read(var buffer; count: integer): integer;
begin
- // TODO 1 -oPrimoz Gabrijelcic : implement: TGpBaseEncryptedStream.InternalSeek
-end;
+ Result := FPaginator.Read(buffer, count);
+end; { TGpBaseEncryptedStream.Read }
function TGpBaseEncryptedStream.Seek(const offset: int64; origin: TSeekOrigin): int64;
begin
- case origin of
- soBeginning:
- Result := InternalSeek(offset);
- soEnd:
- Result := InternalSeek(WrappedStream.Size + offset);
-// else
-// Result := InternalSeek(CurrentPosition + offset);
-// TODO 1 -oPrimoz Gabrijelcic : implement: TGpBaseEncryptedStream.Seek
- end;
+ Result := FPaginator.Seek(offset, origin);
end; { TGpBaseEncryptedStream.Seek }
+procedure TGpBaseEncryptedStream.SetSize(const newSize: int64);
+begin
+ FPaginator.Size := newSize;
+end; { TGpBaseEncryptedStream.SetSize }
+
+function TGpBaseEncryptedStream.Write(const buffer; count: integer): integer;
+begin
+ Result := FPaginator.Write(buffer, count);
+end; { TGpBaseEncryptedStream.Write }
+
end.
diff --git a/src/GpStuff.pas b/src/GpStuff.pas
index 89bbf577..5c91ba7e 100644
--- a/src/GpStuff.pas
+++ b/src/GpStuff.pas
@@ -1,15 +1,22 @@
(*:Various stuff with no other place to go.
@author Primoz Gabrijelcic
@desc
- (c) 2020 Primoz Gabrijelcic
+ (c) 2021 Primoz Gabrijelcic
Free for personal and commercial use. No rights reserved.
Author : Primoz Gabrijelcic
Creation date : 2006-09-25
- Last modification : 2020-12-11
- Version : 2.16
+ Last modification : 2021-07-15
+ Version : 2.18
*)(*
History:
+ 2.18: 2021-07-15
+ - Defined constants for ASCII characters from #$00 to #$1B.
+ 2.17: 2021-03-29
+ - Added IGpBuffer accessors WordAddr[], WordVal[], Int32Addr[], Int32Val[],
+ Int64Arr[], and Int64Val[].
+ - Renamed all TGpBuffer.New class function to TGpBuffer.Make to follow the
+ naming convention used in Spring4D's Shared class.
2.16: 2020-12-11
- Renamed TGpBuffer.CreateI => TGpBuffer.New.
2.15: 2020-12-04
@@ -293,6 +300,34 @@ interface
const
MaxInt64 = $7FFFFFFFFFFFFFFF;
+ CASCII_NUL = #$00;
+ CASCII_SOH = #$01;
+ CASCII_STX = #$02;
+ CASCII_ETX = #$03;
+ CASCII_EOT = #$04;
+ CASCII_ENQ = #$05;
+ CASCII_ACK = #$06;
+ CASCII_BEL = #$07;
+ CASCII_BS = #$08;
+ CASCII_TAB = #$09;
+ CASCII_LF = #$0A;
+ CASCII_VT = #$0B;
+ CASCII_FF = #$0C;
+ CASCII_CR = #$0D;
+ CASCII_SO = #$0E;
+ CASCII_SI = #$0F;
+ CASCII_DLE = #$10;
+ CASCII_DC1 = #$11;
+ CASCII_DC2 = #$12;
+ CASCII_DC3 = #$13;
+ CASCII_DC4 = #$14;
+ CASCII_NAK = #$15;
+ CASCII_SYN = #$16;
+ CASCII_ETB = #$17;
+ CASCII_CAN = #$18;
+ CASCII_EM = #$19;
+ CASCII_SUB = #$1A;
+ CASCII_ESC = #$1B;
CASCII_FS = #$1C;
CASCII_GS = #$1D;
CASCII_RS = #$1E;
@@ -446,15 +481,24 @@ TGpMemoryBuffer = class
function GetByteAddr(idx: integer): pointer;
function GetByteVal(idx: integer): byte;
function GetCurrent: pointer;
+ function GetInt32Addr(idx: integer): pointer;
+ function GetInt32Val(idx: integer): integer;
+ function GetInt64Addr(idx: integer): pointer;
+ function GetInt64Val(idx: integer): int64;
function GetSize: integer;
function GetValue: pointer;
+ function GetWordAddr(idx: integer): pointer;
+ function GetWordVal(idx: integer): word;
{$IFDEF MSWINDOWS}
procedure SetAsAnsiString(const value: AnsiString);
{$ENDIF}
procedure SetAsString(const value: string);
procedure SetByteVal(idx: integer; const value: byte);
procedure SetCurrent(const value: pointer);
+ procedure SetInt32Val(idx: integer; const value: integer);
+ procedure SetInt64Val(idx: integer; const value: int64);
procedure SetSize(const value: integer);
+ procedure SetWordVal(idx: integer; const value: word);
//
procedure Add(b: byte); overload;
{$IFDEF MSWINDOWS}
@@ -477,6 +521,12 @@ TGpMemoryBuffer = class
property AsString: string read GetAsString write SetAsString;
property ByteAddr[idx: integer]: pointer read GetByteAddr;
property ByteVal[idx: integer]: byte read GetByteVal write SetByteVal; default;
+ property WordAddr[idx: integer]: pointer read GetWordAddr;
+ property WordVal[idx: integer]: word read GetWordVal write SetWordVal;
+ property Int32Addr[idx: integer]: pointer read GetInt32Addr;
+ property Int32Val[idx: integer]: integer read GetInt32Val write SetInt32Val;
+ property Int64Addr[idx: integer]: pointer read GetInt64Addr;
+ property Int64Val[idx: integer]: int64 read GetInt64Val write SetInt64Val;
property Current: pointer read GetCurrent write SetCurrent;
property Size: integer read GetSize write SetSize;
property Value: pointer read GetValue;
@@ -495,32 +545,40 @@ TGpBuffer = class(TInterfacedObject, IGpBuffer)
function GetByteAddr(idx: integer): pointer; inline;
function GetByteVal(idx: integer): byte; inline;
function GetCurrent: pointer; inline;
+ function GetInt32Addr(idx: integer): pointer; inline;
+ function GetInt32Val(idx: integer): integer; inline;
+ function GetInt64Addr(idx: integer): pointer; inline;
+ function GetInt64Val(idx: integer): int64; inline;
function GetSize: integer; inline;
function GetValue: pointer; inline;
+ function GetWordAddr(idx: integer): pointer; inline;
+ function GetWordVal(idx: integer): word; inline;
{$IFDEF MSWINDOWS}
procedure SetAsAnsiString(const value: AnsiString); inline;
{$ENDIF}
procedure SetAsString(const value: string); inline;
procedure SetByteVal(idx: integer; const value: byte); inline;
procedure SetCurrent(const value: pointer); inline;
+ procedure SetInt32Val(idx: integer; const value: integer); inline;
+ procedure SetInt64Val(idx: integer; const value: int64); inline;
procedure SetSize(const value: integer); inline;
+ procedure SetWordVal(idx: integer; const value: word); inline;
public
constructor Create; overload;
constructor Create(data: pointer; size: integer); overload;
constructor Create(stream: TStream); overload;
constructor Create(const buffer: IGpBuffer); overload;
constructor Create(const s: string); overload;
- class function New: IGpBuffer; overload; inline;
- class function New(data: pointer; size: integer): IGpBuffer; overload; inline;
- class function New(stream: TStream): IGpBuffer; overload; inline;
- class function New(const buffer: IGpBuffer): IGpBuffer; overload; inline;
- class function New(const s: string): IGpBuffer; overload; inline;
+ class function Make: IGpBuffer; overload;
+ class function Make(data: pointer; size: integer): IGpBuffer; overload; inline;
+ class function Make(stream: TStream): IGpBuffer; overload; inline;
+ class function Make(const buffer: IGpBuffer): IGpBuffer; overload; inline;
+ class function Make(const s: string): IGpBuffer; overload; inline;
{$IFDEF MSWINDOWS}{$IFDEF Unicode}
constructor Create(const s: AnsiString); overload;
- class function New(const s: AnsiString): IGpBuffer; overload; inline;
+ class function Make(const s: AnsiString): IGpBuffer; overload; inline;
{$ENDIF}{$ENDIF}
destructor Destroy; override;
- class function Make: IGpBuffer;
procedure Add(b: byte); overload; inline;
{$IFDEF MSWINDOWS}
procedure Add(ch: AnsiChar); overload; inline;
@@ -542,6 +600,12 @@ TGpBuffer = class(TInterfacedObject, IGpBuffer)
property AsString: string read GetAsString write SetAsString;
property ByteAddr[idx: integer]: pointer read GetByteAddr;
property ByteVal[idx: integer]: byte read GetByteVal write SetByteVal; default;
+ property WordAddr[idx: integer]: pointer read GetWordAddr;
+ property WordVal[idx: integer]: word read GetWordVal write SetWordVal;
+ property Int32Addr[idx: integer]: pointer read GetInt32Addr;
+ property Int32Val[idx: integer]: integer read GetInt32Val write SetInt32Val;
+ property Int64Addr[idx: integer]: pointer read GetInt64Addr;
+ property Int64Val[idx: integer]: int64 read GetInt64Val write SetInt64Val;
property Current: pointer read GetCurrent write SetCurrent;
property Size: integer read GetSize write SetSize;
property Value: pointer read GetValue;
@@ -1275,7 +1339,7 @@ function CompareValue(left, right: boolean): integer;
function OffsetPtr(ptr: pointer; offset: {$IFDEF GpStuff_NativeInt}NativeInt{$ELSE}integer{$ENDIF}): pointer;
begin
- Result := pointer({$IFDEF Unicode}NativeUInt{$ELSE}cardinal{$ENDIF}(int64(ptr) + offset));
+ Result := pointer((int64(ptr) + offset));
end; { OffsetPtr }
function OpenArrayToVarArray(aValues: array of const): Variant;
@@ -2551,30 +2615,25 @@ constructor TGpBuffer.Create(const s: string);
AsString := s;
end; { TGpBuffer.Create }
-class function TGpBuffer.New: IGpBuffer;
-begin
- Result := TGpBuffer.Create;
-end; { TGpBuffer.CreateI }
-
-class function TGpBuffer.New(data: pointer; size: integer): IGpBuffer;
+class function TGpBuffer.Make(data: pointer; size: integer): IGpBuffer;
begin
Result := TGpBuffer.Create(data, size);
-end; { TGpBuffer.CreateI }
+end; { TGpBuffer.Make }
-class function TGpBuffer.New(stream: TStream): IGpBuffer;
+class function TGpBuffer.Make(stream: TStream): IGpBuffer;
begin
Result := TGpBuffer.Create(stream);
-end; { TGpBuffer.CreateI }
+end; { TGpBuffer.Make }
-class function TGpBuffer.New(const buffer: IGpBuffer): IGpBuffer;
+class function TGpBuffer.Make(const buffer: IGpBuffer): IGpBuffer;
begin
Result := TGpBuffer.Create(buffer);
-end; { TGpBuffer.CreateI }
+end; { TGpBuffer.Make }
-class function TGpBuffer.New(const s: string): IGpBuffer;
+class function TGpBuffer.Make(const s: string): IGpBuffer;
begin
Result := TGpBuffer.Create(s);
-end; { TGpBuffer.CreateI }
+end; { TGpBuffer.Make }
{$IFDEF MSWINDOWS}{$IFDEF Unicode}
constructor TGpBuffer.Create(const s: AnsiString);
@@ -2583,10 +2642,10 @@ constructor TGpBuffer.Create(const s: AnsiString);
AsAnsiString := s;
end; { TGpBuffer.Create }
-class function TGpBuffer.New(const s: AnsiString): IGpBuffer;
+class function TGpBuffer.Make (const s: AnsiString): IGpBuffer;
begin
Result := TGpBuffer.Create(s);
-end; { TGpBuffer.CreateI }
+end; { TGpBuffer.Make }
{$ENDIF}{$ENDIF}
function TGpBuffer.GetCurrent: pointer;
@@ -2710,6 +2769,28 @@ function TGpBuffer.GetByteVal(idx: integer): byte;
Result := PByte(ByteAddr[idx])^;
end; { TGpBuffer.GetByteVal }
+function TGpBuffer.GetInt32Addr(idx: integer): pointer;
+begin
+ Assert((idx >= 0) and (idx < (Size div SizeOf(integer))));
+ Result := pointer(NativeUInt(Value) + NativeUInt(idx) * SizeOf(integer));
+end; { TGpBuffer.GetInt32Addr }
+
+function TGpBuffer.GetInt32Val(idx: integer): integer;
+begin
+ Result := PInteger(Int32Addr[idx])^;
+end; { TGpBuffer.GetInt32Val }
+
+function TGpBuffer.GetInt64Addr(idx: integer): pointer;
+begin
+ Assert((idx >= 0) and (idx < (Size div SizeOf(int64))));
+ Result := pointer(NativeUInt(Value) + NativeUInt(idx) * SizeOf(int64));
+end; { TGpBuffer.GetInt64Addr }
+
+function TGpBuffer.GetInt64Val(idx: integer): int64;
+begin
+ Result := PInt64(Int64Addr[idx])^;
+end; { TGpBuffer.GetInt64Val }
+
function TGpBuffer.GetSize: integer;
begin
Result := FData.Size;
@@ -2720,6 +2801,17 @@ function TGpBuffer.GetValue: pointer;
Result := FData.Memory;
end; { TGpBuffer.GetValue }
+function TGpBuffer.GetWordAddr(idx: integer): pointer;
+begin
+ Assert((idx >= 0) and (idx < (Size div SizeOf(word))));
+ Result := pointer(NativeUInt(Value) + NativeUInt(idx) * SizeOf(word));
+end; { TGpBuffer.GetWordAddr }
+
+function TGpBuffer.GetWordVal(idx: integer): word;
+begin
+ Result := PWord(WordAddr[idx])^;
+end; { TGpBuffer.GetWordVal }
+
function TGpBuffer.IsEmpty: boolean;
begin
Result := (Size = 0);
@@ -2753,12 +2845,27 @@ procedure TGpBuffer.SetCurrent(const value: pointer);
begin
FData.Position := {$IFDEF Unicode}NativeUInt{$ELSE}cardinal{$ENDIF}(value) -
{$IFDEF Unicode}NativeUInt{$ELSE}cardinal{$ENDIF}(FData.Memory);
-end; { TGpBuffer.SetCurrent }
+end; procedure TGpBuffer.SetInt32Val(idx: integer; const value: integer);
+begin
+
+end;
+
+procedure TGpBuffer.SetInt64Val(idx: integer; const value: int64);
+begin
+
+end;
+
+{ TGpBuffer.SetCurrent }
procedure TGpBuffer.SetSize(const value: integer);
begin
FData.Size := value;
-end; { TGpBuffer.SetSize }
+end; procedure TGpBuffer.SetWordVal(idx: integer; const value: word);
+begin
+
+end;
+
+{ TGpBuffer.SetSize }
{ TGpInterfacedPersistent }