Index: packages/fpc/Jcl.lpk =================================================================== --- packages/fpc/Jcl.lpk (revision 3706) +++ packages/fpc/Jcl.lpk (working copy) @@ -1,17 +1,16 @@ - + - - + - - + + @@ -19,26 +18,26 @@ + - + - - - - - + + + + - + @@ -351,10 +350,10 @@ - - - - + + + + Index: packages/fpc/JclContainers.lpk =================================================================== --- packages/fpc/JclContainers.lpk (revision 3706) +++ packages/fpc/JclContainers.lpk (working copy) @@ -7,11 +7,11 @@ - + - - + + @@ -19,6 +19,7 @@ + @@ -33,6 +34,10 @@ + + + + @@ -106,10 +111,10 @@ - - - - + + + + Index: source/common/JclAbstractContainers.pas =================================================================== --- source/common/JclAbstractContainers.pas (revision 3706) +++ source/common/JclAbstractContainers.pas (working copy) @@ -701,9 +701,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 {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}): WideString; + procedure AppendDelimited(const AString: WideString; const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}); + procedure LoadDelimited(const AString: WideString; const Separator: WideString {$IFDEF BORLAND}= WideLineBreak{$ENDIF BORLAND}); end; {$IFDEF SUPPORTS_UNICODE_STRING} @@ -1372,12 +1372,12 @@ else begin case FEncoding of - seISO: + JclContainerIntf.seISO: if FCaseSensitive then Result := AnsiStrSimpleHashConvert(AString) else Result := AnsiStrSimpleHashConvertI(AString); - seUTF8: + JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleHashConvertU(AString) else @@ -1395,7 +1395,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleCompare(A, B) else @@ -1416,7 +1416,7 @@ else begin case FEncoding of - seISO, seUTF8: + JclContainerIntf.seISO, JclContainerIntf.seUTF8: if FCaseSensitive then Result := AnsiStrSimpleEqualityCompare(A, B) else Index: source/common/JclAnsiStrings.pas =================================================================== --- source/common/JclAnsiStrings.pas (revision 3706) +++ source/common/JclAnsiStrings.pas (working copy) @@ -518,8 +518,8 @@ function ArrayOf(List: TJclAnsiStrings): TDynStringArray; overload; -function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt; -function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt; +function AnsiCompareNaturalStr(const S1, S2: AnsiString): SizeInt;overload; +function AnsiCompareNaturalText(const S1, S2: AnsiString): SizeInt;overload; // internal structures published to make function inlining working const Index: source/common/JclCompression.pas =================================================================== --- source/common/JclCompression.pas (revision 3706) +++ source/common/JclCompression.pas (working copy) @@ -764,7 +764,7 @@ TJclStreamAccess = (saCreate, saReadOnly, saReadOnlyDenyNone, saWriteOnly, saReadWrite); { TJclCompressionArchive is not ref-counted } - TJclCompressionArchive = class(TObject, IInterface) + TJclCompressionArchive = class(TInterfacedObject, IInterface) private FOnProgress: TJclCompressionProgressEvent; FOnRatio: TJclCompressionRatioEvent; Index: source/common/JclDateTime.pas =================================================================== --- source/common/JclDateTime.pas (revision 3706) +++ source/common/JclDateTime.pas (working copy) @@ -87,7 +87,7 @@ { Encode / Decode functions } -function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime; +function EncodeDate(const Year: Integer; Month, Day: Word): TDateTime;overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year: Integer; out Month, Day: Word); overload; procedure DecodeDate(Date: TDateTime; out Year, Month, Day: Integer); overload; Index: source/common/JclRTTI.pas =================================================================== --- source/common/JclRTTI.pas (revision 3706) +++ source/common/JclRTTI.pas (working copy) @@ -1890,7 +1890,7 @@ AInstance := GetObjectProp(FInstance, PropInfo); if AInstance <> nil then begin - SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType^, Prefix, AInstance); + SubClassTypeInfo := TJclObjClassTypeInfo.Create(PropInfo.PropType{$IFNDEF FPC}^{$ENDIF}, Prefix, AInstance); Result := SubClassTypeInfo.ObjPropNames[Suffix]; end else Index: source/common/JclStringLists.pas =================================================================== --- source/common/JclStringLists.pas (revision 3706) +++ source/common/JclStringLists.pas (working copy) @@ -82,7 +82,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; out Index: Integer): Boolean; function IndexOf(const S: string): Integer; function GetCaseSensitive: Boolean; function GetDuplicates: TDuplicates; @@ -208,7 +208,7 @@ end; type - TJclUpdateControl = class(TObject, IInterface) + TJclUpdateControl = class(TInterfacedObject, IInterface) private FStrings: TStrings; public @@ -219,7 +219,20 @@ 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; @@ -444,6 +457,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/JclStrings.pas =================================================================== --- source/common/JclStrings.pas (revision 3706) +++ source/common/JclStrings.pas (working copy) @@ -603,8 +603,8 @@ {$ENDIF SUPPORTS_UNICODE_STRING} // natural comparison functions -function CompareNaturalStr(const S1, S2: string): SizeInt; -function CompareNaturalText(const S1, S2: string): SizeInt; +function CompareNaturalStr(const S1, S2: string): SizeInt;overload; +function CompareNaturalText(const S1, S2: string): SizeInt;overload; {$IFNDEF UNICODE_RTL_DATABASE} // internal structures published to make function inlining working Index: source/common/JclSynch.pas =================================================================== --- source/common/JclSynch.pas (revision 3706) +++ source/common/JclSynch.pas (working copy) @@ -86,8 +86,10 @@ function LockedInc(var Target: Int64): Int64; overload; function LockedSub(var Target: Int64; Value: Int64): Int64; overload; +{$IFDEF BORLAND} function LockedDec(var Target: NativeInt): NativeInt; overload; function LockedInc(var Target: NativeInt): NativeInt; overload; +{$ENDIF BORLAND} {$ENDIF CPU64} // TJclDispatcherObject @@ -729,6 +731,8 @@ ADD RAX, RDX end; +{$IFDEF BORLAND} + function LockedDec(var Target: NativeInt): NativeInt; asm // --> RCX Target @@ -746,6 +750,9 @@ LOCK XADD [RCX], RAX INC RAX end; + +{$ENDIF BORLAND} + {$ENDIF CPU64} //=== { TJclDispatcherObject } =============================================== Index: source/common/JclSysInfo.pas =================================================================== --- source/common/JclSysInfo.pas (revision 3706) +++ source/common/JclSysInfo.pas (working copy) @@ -4323,6 +4323,9 @@ SETNZ Result {$ENDIF CPU32} {$IFDEF CPU64} + {$IFDEF FPC} + {$DEFINE DELPHI64_TEMPORARY} + {$ENDIF FPC} {$IFDEF DELPHI64_TEMPORARY} PUSHFQ {$ELSE ~DELPHI64_TEMPORARY} @@ -4347,6 +4350,9 @@ AND RAX, ID_FLAG XOR RAX, RCX SETNZ Result + {$IFDEF FPC} + {$UNDEF DELPHI64_TEMPORARY} + {$ENDIF FPC} {$ENDIF CPU64} end; {$IFNDEF DELPHI64_TEMPORARY} Index: source/common/JclSysUtils.pas =================================================================== --- source/common/JclSysUtils.pas (revision 3706) +++ source/common/JclSysUtils.pas (working copy) @@ -412,7 +412,7 @@ // interfaced persistent type - TJclInterfacedPersistent = class(TPersistent, IInterface) + TJclInterfacedPersistent = class(TInterfacedPersistent, IInterface) protected FOwnerInterface: IInterface; FRefCount: Integer; @@ -637,7 +637,7 @@ // thread safe support type - TJclIntfCriticalSection = class(TObject, IInterface) + TJclIntfCriticalSection = class(TInterfacedObject, IInterface) private FCriticalSection: TCriticalSection; public @@ -2856,7 +2856,7 @@ end; InternalAbort := False; if AbortPtr <> nil then - AbortPtr^ := False + AbortPtr^ := {$IFDEF FPC}Byte({$ENDIF}False{$IFDEF FPC}){$ENDIF} else AbortPtr := @InternalAbort; // init the array of events to wait for @@ -2898,7 +2898,7 @@ InternalExecuteReadPipe(ErrorPipeInfo, ErrorOverlapped); end; // event based loop - while not AbortPtr^ do + while not {$IFDEF FPC}Boolean({$ENDIF}AbortPtr^{$IFDEF FPC}){$ENDIF} do begin Index := WaitAlertableForMultipleObjects(WaitEvents, False, INFINITE); if Index = WAIT_OBJECT_0 then @@ -2928,7 +2928,7 @@ if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then // event on abort - AbortPtr^ := True + AbortPtr^ := {$IFDEF FPC}Byte({$ENDIF}True{$IFDEF FPC}){$ENDIF} else {$IFDEF DELPHI11_UP} RaiseLastOSError(Index); @@ -2936,7 +2936,7 @@ RaiseLastOSError; {$ENDIF DELPHI11_UP} end; - if AbortPtr^ then + if {$IFDEF FPC}Boolean({$ENDIF}AbortPtr^{$IFDEF FPC}){$ENDIF} then TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE)); if (ProcessEvent.WaitForever = wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then Result := $FFFFFFFF; Index: source/common/JclUnicode.pas =================================================================== --- source/common/JclUnicode.pas (revision 3706) +++ source/common/JclUnicode.pas (working copy) @@ -1843,6 +1843,7 @@ SetLength(Categories[First], 256); if Categories[First, Second] = nil then SetLength(Categories[First, Second], 256); + {$IFNDEF FPC} {$IF SizeOf(TCharacterCategories) mod 4 <> 0} // The array is allocated on the exact size, but the compiler generates // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. @@ -1853,6 +1854,18 @@ {$ELSE} Include(Categories[First, Second, Third], Category); {$IFEND} + {$ELSE FPC} + IF SizeOf(TCharacterCategories) mod 4 <> 0 Then begin + // The array is allocated on the exact size, but the compiler generates + // a 32 bit "BTS" instruction that accesses memory beyond the allocated block. + if Third < 255 then + Include(Categories[First, Second, Third], Category) + else + Categories[First, Second, Third] := Categories[First, Second, Third] + [Category]; + end + else + Include(Categories[First, Second, Third], Category); + {$IFEND FPC} end; end; end; @@ -3116,7 +3129,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 @@ -3129,7 +3142,9 @@ while Find(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); @@ -5087,7 +5102,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 @@ -5100,7 +5115,9 @@ 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/common/JclWideStrings.pas =================================================================== --- source/common/JclWideStrings.pas (revision 3706) +++ source/common/JclWideStrings.pas (working copy) @@ -845,11 +845,11 @@ // --> RCX Str XOR RAX, RAX // clear high order byte to be able to use 64bit operand below @@1: - MOV AX, WORD PTR [ECX] + MOV AX, WORD PTR [RCX] OR RAX, RAX JZ @@2 XCHG AL, AH - MOV WORD PTR [ECX], AX + MOV WORD PTR [RCX], AX ADD ECX, 2 JMP @@1 @@2: Index: source/include/jclfpc.inc =================================================================== --- source/include/jclfpc.inc (revision 0) +++ source/include/jclfpc.inc (working copy) @@ -0,0 +1,131 @@ +{**************************************************************************************************} +{ } +{ Project JEDI Code Library (JCL) } +{ } +{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); } +{ you may not use this file except in compliance with the License. You may obtain a copy of the } +{ License at http://www.mozilla.org/MPL/ } +{ } +{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF } +{ ANY KIND, either express or implied. See the License for the specific language governing rights } +{ and limitations under the License. } +{ } +{ The Original Code is jcl.inc } +{ } +{ The Initial Developer of the Original Code is Marcel van Brakel. } +{ Portions created by Marcel van Brakel are Copyright (C) Marcel van Brakel. } +{ } +{ Contributors: } +{ Marcel van Brakel } +{ Matthias Thoma (mthoma) } +{ Petr Vones } +{ Robert Marquardt (marquardt) } +{ Robert Rossmair (rrossmair) } +{ Florent Ouchet (outchy) } +{ } +{**************************************************************************************************} +{ } +{ This include file defines various JCL specific defines. } +{ The more generic JCL defines are defined in jcl.inc and the generic defines in the jedi.inc file } +{ which is shared with the JEDI VCL. } +{ } +{**************************************************************************************************} +{ } +{ This file is filled by the JCL installer, all the changes made in its content will be lost the } +{ next time the JCL is installed. } +{ } +{**************************************************************************************************} + +// $Id: jcl.template.inc 3362 2010-10-05 13:24:05Z outchy $ + +// Math precision selection, mutually exclusive +// FPC does not support EXTENDED when targetting x86_64, MATH_DOUBLE_PRECISION is the default in this situation +{.$DEFINE MATH_EXTENDED_PRECISION} // default +{.$DEFINE MATH_DOUBLE_PRECISION} +{.$DEFINE MATH_SINGLE_PRECISION} + + +// Math functions takes care of infinites and NaN +{.$DEFINE MATH_EXT_EXTREMEVALUES} + + +// JclHookExcept support for hooking exceptions from DLLs +{.$DEFINE HOOK_DLL_EXCEPTIONS} + + +//Threadsafe directive +{.$DEFINE THREADSAFE} + + +// To exclude obsolete code from compilation, remove the point from the line below +{.$DEFINE DROP_OBSOLETE_CODE} + + +//Support for JclUnitVersioning.pas, not supported by Delphi 2005 (automatically disabled afterward) +{.$DEFINE UNITVERSIONING} + + +// debug sources +// defining these symbols will the debug source to be automatically registered +{.$DEFINE DEBUG_NO_BINARY} +{.$DEFINE DEBUG_NO_TD32} // automatically defined for FPC +{.$DEFINE DEBUG_NO_MAP} +{.$DEFINE DEBUG_NO_EXPORTS} +{.$DEFINE DEBUG_NO_SYMBOLS} + + +// PCRE options, mutually exclusive +// IMPORTANT: The static link works only for Delphi 2005 and newer +// (an internal error is raised on other compilers) +// Only one of the following defines can be defined at a time +// static link: PCRE_STATICLINK +// static dll import: PCRE_LINKDLL +// dynamic dll import: PCRE_LINKONREQUEST + +{.$DEFINE PCRE_STATICLINK} +{.$DEFINE PCRE_LINKDLL} +{.$DEFINE PCRE_LINKONREQUEST} // default + + +// BZIP2 options, mutually exclusive + +{.$DEFINE BZIP2_STATICLINK} // default +{.$DEFINE BZIP2_LINKDLL} +{$DEFINE BZIP2_LINKONREQUEST} + + +// ZLIB options, mutually exclusive + +{.$DEFINE ZLIB_STATICLINK} // default +{.$DEFINE ZLIB_LINKDLL} +{$DEFINE ZLIB_LINKONREQUEST} + + +// Unicode options +// use RTL Character Database rather than JCL one, less accurate but reduce executable size +{.$DEFINE UNICODE_RTL_DATABASE} + +// insert a replacement character if sequence is corrupted rather than raising an exception +{.$DEFINE UNICODE_SILENT_FAILURE} + +// defines resource compression (uncompressed, compressed with ZLib, compressed with BZip2), mutually exclusive +{.$DEFINE UNICODE_RAW_DATA} // default +{.$DEFINE UNICODE_ZLIB_DATA} +{.$DEFINE UNICODE_BZIP2_DATA} + + +// container options +// define mapping of TJclStr* containers to TJclAnsiStr* or TJclWideStr* (mutually exclusive) +{.$DEFINE CONTAINER_ANSISTR} // default for D2007 and older +{.$DEFINE CONTAINER_WIDESTR} +{.$DEFINE CONTAINER_UNICODESTR} // default for D2009 and newer, not supported for Delphi 2007 and older +{.$DEFINE CONTAINER_NOSTR} + + +// 7Zip options, mutually exclusive +// IMPORTANT: The static link is not supported yet + +{.$DEFINE 7ZIP_STATICLINK} // not supported yet +{.$DEFINE 7ZIP_LINKDLL} +{.$DEFINE 7ZIP_LINKONREQUEST} // default + Index: source/windows/JclAppInst.pas =================================================================== --- source/windows/JclAppInst.pas (revision 3706) +++ source/windows/JclAppInst.pas (working copy) @@ -742,7 +742,7 @@ ACLSize := SizeOf(TACL) + SizeOf(ACCESS_ALLOWED_ACE) + SizeOf(DWORD) + GetLengthSid(AccessSID); ACL := AllocMem(ACLSize); Win32Check(InitializeAcl(ACL^, ACLSize, ACL_REVISION)); - Win32Check(AddAccessAllowedAce(ACL^, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); + Win32Check(AddAccessAllowedAce(ACL{$IFNDEF FPC}^{$ENDIF}, ACL_REVISION, FILE_MAP_ALL_ACCESS, AccessSID)); Assert(IsValidAcl(ACL{$IFNDEF RTL230_UP}^{$ENDIF})); // QC #102231 // create the security descriptor Index: source/windows/JclCppException.pas =================================================================== --- source/windows/JclCppException.pas (revision 3706) +++ source/windows/JclCppException.pas (working copy) @@ -160,7 +160,7 @@ implementation uses - JclResources, JclHookExcept; + JclResources, JclHookExcept, Windows; type @@ -438,7 +438,9 @@ var OldAcquireExceptionProc: Pointer; + {$IFDEF CPU32} OldRaiseExceptionProc: TRaiseExceptionProc; + {$ENDIF CPU32} procedure ExceptionAcquiredProc(Obj: Pointer); begin @@ -465,8 +467,10 @@ end; LastCppExcDesc := nil; + {$IFDEF CPU32} if Assigned(OldRaiseExceptionProc) then OldRaiseExceptionProc(ExceptionCode, ExceptionFlags, NumberOfArguments, Args); + {$ENDIF CPU32} end; function EJclCppStdException.GetStdException: PJclCppStdException; @@ -676,8 +680,8 @@ { The exception object is a std::exception subclass and implements the virtual member function what(). } ExcObjectVTbl := Pointer(PCardinal(ExcObject)^); - WhatMethod := TCppTypeInfoWhatMethod(PCardinal( - Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^); + WhatMethod := TCppTypeInfoWhatMethod(Pointer(PCardinal( + Cardinal(ExcObjectVTbl) + SizeOf(Pointer))^)); Result := EJclCppStdException.Create(ExcObject, String(WhatMethod(ExcObject)), PAnsiChar(ExcTypeName), Pointer(ExcDesc)); end @@ -698,7 +702,11 @@ 'Cannot install C++ exception filter: call JclHookExcept.JclHookExceptions() first!'); if HookInstalled then Exit; + {$IFDEF BORLAND} HookInstalled := JclHookExcept.JclAddExceptFilter(@CppExceptObjProc, npFirstChain); + {$ELSE BORLAND} + HookInstalled := False; + {$ENDIF BORLAND} if HookInstalled then begin {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder @@ -706,12 +714,14 @@ System.ExceptionAcquired := @ExceptionAcquiredProc; {$ENDIF COMPILER12_UP} + {$IFDEF BORLAND} OldRaiseExceptionProc := System.RaiseExceptionProc; {$IFDEF CPU32} System.RaiseExceptionProc := @RaiseExceptionProc; {$ELSE} System.RaiseExceptionProc := RaiseExceptionProc; {$ENDIF CPU32} + {$ENDIF BORLAND} end; end; @@ -722,12 +732,14 @@ {$IFDEF COMPILER12_UP} // TODO: this may be supported for earlier versions of Delphi/C++Builder System.ExceptionAcquired := OldAcquireExceptionProc; {$ENDIF COMPILER12_UP} + {$IFDEF BORLAND} {$IFDEF CPU32} System.RaiseExceptionProc := @OldRaiseExceptionProc; {$ELSE} System.RaiseExceptionProc := OldRaiseExceptionProc; {$ENDIF CPU32} JclHookExcept.JclRemoveExceptFilter(@CppExceptObjProc); + {$ENDIF BORLAND} HookInstalled := False; end; Index: source/windows/JclHookExcept.pas =================================================================== --- source/windows/JclHookExcept.pas (revision 3706) +++ source/windows/JclHookExcept.pas (working copy) @@ -46,7 +46,7 @@ {$IFDEF HAS_UNITSCOPE} Winapi.Windows, System.SysUtils, System.Classes; {$ELSE ~HAS_UNITSCOPE} - Windows, SysUtils, Classes; + Windows, SysUtils, Classes, JclBase; {$ENDIF ~HAS_UNITSCOPE} type @@ -109,7 +109,6 @@ implementation uses - JclBase, JclPeImage, JclSysInfo, JclSysUtils; @@ -575,10 +574,12 @@ end; function GetCppRtlBase: Pointer; +{$IFDEF BORLAND} const {$IFDEF COMPILER6} { Delphi/C++Builder 6 } CppRtlVersion = 60; {$ELSE ~COMPILER6} + {$IF (RtlVersion > 18.0) and (RtlVersion < 19.0)} { Delphi/C++Builder 2007 were aiming for binary compatibility with BDS2006, which complicates things a bit } @@ -595,6 +596,11 @@ in this case TJclPeMapImgHooks.ReplaceImport() is a no-op. The base module is also being hooked separately, so we're covered. } end; +{$ELSE BORLAND} +begin + Result := NIL; +end; +{$ENDIF BORLAND} function HasCppRtl: Boolean; begin Index: source/windows/JclWin32.pas =================================================================== --- source/windows/JclWin32.pas (revision 3706) +++ source/windows/JclWin32.pas (working copy) @@ -71,8 +71,9 @@ {$ELSE ~HAS_UNITSCOPE} Windows, SysUtils, {$IFNDEF FPC} - AccCtrl, ActiveX, + AccCtrl, {$ENDIF ~FPC} + ActiveX, {$ENDIF ~HAS_UNITSCOPE} JclBase;