Index: packages/fpc/Jcl.lpk
===================================================================
--- packages/fpc/Jcl.lpk (revision 3510)
+++ packages/fpc/Jcl.lpk (working copy)
@@ -7,11 +7,11 @@
-
+
-
-
+
+
@@ -19,6 +19,7 @@
+
@@ -33,12 +34,15 @@
+
+
+
-
+
@@ -347,10 +351,10 @@
-
-
-
-
+
+
+
+
Index: packages/fpc/JclContainers.lpk
===================================================================
--- packages/fpc/JclContainers.lpk (revision 3510)
+++ packages/fpc/JclContainers.lpk (working copy)
@@ -7,11 +7,11 @@
-
+
-
-
+
+
@@ -19,6 +19,7 @@
+
@@ -33,12 +34,15 @@
+
+
+
-
+
@@ -106,10 +110,10 @@
-
-
-
-
+
+
+
+
Index: source/common/JclAbstractContainers.pas
===================================================================
--- source/common/JclAbstractContainers.pas (revision 3510)
+++ source/common/JclAbstractContainers.pas (working copy)
@@ -697,9 +697,9 @@
procedure AppendToStrings(Strings: TJclWideStrings);
procedure AppendFromStrings(Strings: TJclWideStrings);
function GetAsStrings: TJclWideStrings;
- function GetAsDelimited(const Separator: WideString = WideLineBreak): WideString;
- procedure AppendDelimited(const AString: WideString; const Separator: WideString = WideLineBreak);
- procedure LoadDelimited(const AString: WideString; const Separator: WideString = WideLineBreak);
+ function GetAsDelimited(const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF}): WideString;
+ procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF});
+ procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFNDEF FPC}= WideLineBreak {$ENDIF});
end;
{$IFDEF SUPPORTS_UNICODE_STRING}
Index: source/common/JclAlgorithms.pas
===================================================================
--- source/common/JclAlgorithms.pas (revision 3510)
+++ source/common/JclAlgorithms.pas (working copy)
@@ -828,7 +828,7 @@
// case-sensitive and UTF8-encoded
function AnsiStrSimpleHashConvertU(const AString: AnsiString): Integer;
var
- I: Integer;
+ I: SizeInt;
C, IntegerHash: TIntegerHash;
begin
IntegerHash.H1 := 0;
@@ -852,7 +852,7 @@
// case-insensitive and UTF8-encoded
function AnsiStrSimpleHashConvertUI(const AString: AnsiString): Integer;
var
- I, J: Integer;
+ I, J: SizeInt;
C, IntegerHash: TIntegerHash;
CA: TUCS4Array;
begin
@@ -883,7 +883,7 @@
// default is case-sensitive
function WideStrSimpleHashConvert(const AString: WideString): Integer;
var
- I: Integer;
+ I: SizeInt;
C, IntegerHash: TIntegerHash;
begin
IntegerHash.H1 := 0;
@@ -907,7 +907,7 @@
// case-insensitive
function WideStrSimpleHashConvertI(const AString: WideString): Integer;
var
- I, J: Integer;
+ I, J: SizeInt;
C, IntegerHash: TIntegerHash;
CA: TUCS4Array;
begin
@@ -4111,4 +4111,4 @@
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
-end.
\ No newline at end of file
+end.
Index: source/common/JclCompression.pas
===================================================================
--- source/common/JclCompression.pas (revision 3510)
+++ source/common/JclCompression.pas (working copy)
@@ -726,7 +726,7 @@
TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite);
{ TJclCompressionArchive is not ref-counted }
- TJclCompressionArchive = class(TObject, IInterface)
+ TJclCompressionArchive = class(TInterfacedObject, IInterface)
private
FOnProgress: TJclCompressionProgressEvent;
FOnVolume: TJclCompressionVolumeEvent;
Index: source/common/JclRTTI.pas
===================================================================
--- source/common/JclRTTI.pas (revision 3510)
+++ source/common/JclRTTI.pas (working copy)
@@ -1878,7 +1878,11 @@
AInstance := GetObjectProp(FInstance, PropInfo);
if AInstance <> nil then
begin
+ {$IFNDEF FPC}
SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance);
+ {$ELSE}
+ SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType, Prefix, AInstance);
+ {$ENDIF}
Result := SubClassTypeInfo.ObjPropNames[Suffix];
end
else
@@ -2945,7 +2949,7 @@
end;
var
- PropCount: Integer;
+ PropCount: SizeInt;
begin
PropCount := 0;
SetLength(Result, 16);
Index: source/common/JclStreams.pas
===================================================================
--- source/common/JclStreams.pas (revision 3510)
+++ source/common/JclStreams.pas (working copy)
@@ -467,9 +467,9 @@
function LoadBuffer: Boolean;
function LoadPeekBuffer: Boolean;
function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; virtual; abstract;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual;
+ function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual;
function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; virtual; abstract;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; virtual;
+ function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; virtual;
procedure InvalidateBuffers;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); virtual;
@@ -513,9 +513,9 @@
FCodePage: Word;
protected
function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
property CodePage: Word read FCodePage write FCodePage;
@@ -524,9 +524,9 @@
TJclUTF8Stream = class(TJclStringStream)
protected
function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
end;
@@ -534,9 +534,9 @@
TJclUTF16Stream = class(TJclStringStream)
protected
function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
end;
@@ -549,9 +549,9 @@
FEncoding: TJclStringEncoding;
protected
function InternalGetNextChar(S: TStream; out Ch: UCS4): Boolean; override;
- function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalGetNextBuffer(S: TStream; var Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
function InternalSetNextChar(S: TStream; Ch: UCS4): Boolean; override;
- function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: Longint): Longint; override;
+ function InternalSetNextBuffer(S: TStream; const Buffer: TUCS4Array; Start, Count: SizeInt): Longint; override;
public
constructor Create(AStream: TStream; AOwnsStream: Boolean = False); override;
function SkipBOM: LongInt; override;
@@ -2362,7 +2362,7 @@
end;
function TJclStringStream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
var
Ch: UCS4;
begin
@@ -2383,7 +2383,7 @@
end;
function TJclStringStream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
// override to optimize
Result := 0;
@@ -2848,7 +2848,7 @@
end;
function TJclAnsiStream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
if FCodePage = CP_ACP then
Result := AnsiGetNextBufferFromStream(S, Buffer, Start, Count)
@@ -2865,7 +2865,7 @@
end;
function TJclAnsiStream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
if FCodePage = CP_ACP then
Result := AnsiSetNextBufferToStream(S, Buffer, Start, Count)
@@ -2894,7 +2894,7 @@
end;
function TJclUTF8Stream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
Result := UTF8GetNextBufferFromStream(S, Buffer, Start, Count);
end;
@@ -2905,7 +2905,7 @@
end;
function TJclUTF8Stream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
Result := UTF8SetNextBufferToStream(S, Buffer, Start, Count);
end;
@@ -2928,7 +2928,7 @@
end;
function TJclUTF16Stream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
Result := UTF16GetNextBufferFromStream(S, Buffer, Start, Count);
end;
@@ -2939,7 +2939,7 @@
end;
function TJclUTF16Stream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
Result := UTF16SetNextBufferToStream(S, Buffer, Start, Count);
end;
@@ -3021,7 +3021,7 @@
end;
function TJclAutoStream.InternalGetNextBuffer(S: TStream;
- var Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ var Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
case FCodePage of
CP_UTF8:
@@ -3050,7 +3050,7 @@
end;
function TJclAutoStream.InternalSetNextBuffer(S: TStream;
- const Buffer: TUCS4Array; Start, Count: Integer): Longint;
+ const Buffer: TUCS4Array; Start, Count: SizeInt): Longint;
begin
case FCodePage of
CP_UTF8:
Index: source/common/JclStringLists.pas
===================================================================
--- source/common/JclStringLists.pas (revision 3510)
+++ source/common/JclStringLists.pas (working copy)
@@ -74,7 +74,7 @@
function GetObjects(Index: Integer): TObject;
function GetTextStr: string;
function GetValue(const Name: string): string;
- function Find(const S: string; var Index: Integer): Boolean;
+// function Find(const S: string; var Index: Integer): Boolean;
function IndexOf(const S: string): Integer;
function GetCaseSensitive: Boolean;
function GetDuplicates: TDuplicates;
@@ -200,7 +200,7 @@
end;
type
- TJclUpdateControl = class(TObject, IInterface)
+ TJclUpdateControl = class(TInterfacedObject, IInterface)
private
FStrings: TStrings;
public
@@ -211,8 +211,21 @@
function _Release: Integer; stdcall;
end;
- TJclStringList = class(TStringList, IJclStringList)
+ TJclInterfacedStringList = class(TStringList, IInterface)
private
+ FOwnerInterface: IInterface;
+ protected
+ { IInterface }
+ function _AddRef: Integer; stdcall;
+ function _Release: Integer; stdcall;
+ public
+ function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; stdcall;
+ procedure AfterConstruction; override;
+ end;
+
+
+ TJclStringList = class(TJclInterfacedStringList, IJclStringList)
+ private
FObjectsMode: TJclStringListObjectsMode;
FSelfAsInterface: IJclStringList;
FLastRegExPattern: string;
@@ -432,6 +445,45 @@
Result := JclStringList.Add(A);
end;
+//=== { TJclInterfacedStringList } ==============================================
+procedure TJclInterfacedStringList.AfterConstruction;
+Var
+ MyOwner : TPersistent;
+begin
+ inherited;
+ MyOwner := GetOwner;
+ if assigned(MyOwner) then
+ MyOwner.GetInterface(IUnknown,FOwnerInterface);
+end;
+
+
+function TJclInterfacedStringList._AddRef: Integer;stdcall;
+begin
+ if assigned(FOwnerInterface) then
+ Result:=FOwnerInterface._AddRef
+ else
+ Result:=-1;
+end;
+
+
+function TJclInterfacedStringList._Release: Integer;stdcall;
+begin
+ if assigned(FOwnerInterface) then
+ Result:=FOwnerInterface._Release
+ else
+ Result:=-1;
+end;
+
+
+function TJclInterfacedStringList.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;stdcall;
+begin
+ if GetInterface(IID, Obj) then
+ Result:=0
+ else
+ Result:=HResult($80004002);
+end;
+
+
//=== { TJclStringList } =====================================================
function TJclStringList.Add(const A: array of const): IJclStringList;
Index: source/common/JclSysInfo.pas
===================================================================
--- source/common/JclSysInfo.pas (revision 3510)
+++ source/common/JclSysInfo.pas (working copy)
@@ -4285,17 +4285,17 @@
SETNZ Result
{$ENDIF CPU32}
{$IFDEF CPU64}
- // PUSHFQ
- PUSHFD
+ PUSHFQ
+ //PUSHFD
POP RAX
MOV RCX, RAX
XOR RAX, ID_FLAG
AND RCX, ID_FLAG
PUSH RAX
- // POPFQ
- POPFD
- // PUSHFQ
- PUSHFD
+ POPFQ
+ //POPFD
+ PUSHFQ
+ //PUSHFD
POP RAX
AND RAX, ID_FLAG
XOR RAX, RCX
Index: source/common/JclSysUtils.pas
===================================================================
--- source/common/JclSysUtils.pas (revision 3510)
+++ source/common/JclSysUtils.pas (working copy)
@@ -405,7 +405,7 @@
// interfaced persistent
type
- TJclInterfacedPersistent = class(TPersistent, IInterface)
+ TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface)
protected
FOwnerInterface: IInterface;
FRefCount: Integer;
@@ -617,7 +617,7 @@
// thread safe support
type
- TJclIntfCriticalSection = class(TObject, IInterface)
+ TJclIntfCriticalSection = class(TInterfacedObject, IInterface)
private
FCriticalSection: TCriticalSection;
public
Index: source/common/JclUnicode.pas
===================================================================
--- source/common/JclUnicode.pas (revision 3510)
+++ source/common/JclUnicode.pas (working copy)
@@ -2752,7 +2752,7 @@
// Looks for all occurences of the pattern passed to FindPrepare and creates an
// internal list of their positions.
var
- Start, Stop: SizeInt;
+ Start, Stop, CharCount: SizeInt;
Run: PWideChar;
RunLen: SizeInt;
begin
@@ -2765,8 +2765,9 @@
while Find(Run, RunLen, Start, Stop) do
begin
// store this result (consider text pointer movement)...
- AddResult(Start + Run - Text, Stop + Run - Text);
// ... and advance text position and length
+ CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar);
+ AddResult(Start + CharCount, Stop + CharCount);
Inc(Run, Stop);
Dec(RunLen, Stop);
end;
@@ -4723,7 +4724,7 @@
// Looks for all occurences of the pattern passed to FindPrepare and creates an
// internal list of their positions.
var
- Start, Stop: SizeInt;
+ Start, Stop, CharCount: SizeInt;
Run: PWideChar;
RunLen: SizeInt;
begin
@@ -4736,7 +4737,8 @@
while ExecuteURE(0, Run, RunLen, Start, Stop) do
begin
// store this result (consider text pointer movement)...
- AddResult(Start + Run - Text, Stop + Run - Text);
+ CharCount := (TJclAddr(Run) - TJclAddr(Text)) div SizeOf(WideChar);
+ AddResult(Start + CharCount, Stop + CharCount);
// ... and advance text position and length
Inc(Run, Stop);
Dec(RunLen, Stop);
Index: source/windows/JclHookExcept.pas
===================================================================
--- source/windows/JclHookExcept.pas (revision 3510)
+++ source/windows/JclHookExcept.pas (working copy)
@@ -43,7 +43,7 @@
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
- Windows, SysUtils, Classes;
+ Windows, SysUtils, Classes, JclBase;
type
// Exception hooking notifiers routines
@@ -96,7 +96,6 @@
implementation
uses
- JclBase,
JclPeImage,
JclSysInfo, JclSysUtils;
Index: source/windows/JclWin32.pas
===================================================================
--- source/windows/JclWin32.pas (revision 3510)
+++ source/windows/JclWin32.pas (working copy)
@@ -3144,8 +3144,8 @@
function ReBaseImage64(CurrentImageName: PAnsiChar; SymbolPath: PAnsiChar; fReBase: BOOL;
fRebaseSysfileOk: BOOL; fGoingDown: BOOL; CheckImageSize: ULONG;
- var OldImageSize: TJclAddr; var OldImageBase: TJclAddr64;
- var NewImageSize: TJclAddr; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall;
+ var OldImageSize: TJclAddr32; var OldImageBase: TJclAddr64;
+ var NewImageSize: TJclAddr32; var NewImageBase: TJclAddr64; TimeStamp: ULONG): BOOL; stdcall;
{$EXTERNALSYM ReBaseImage64}
// line 199