瀏覽代碼

Merge branch 'thirdparty_dev' into dev

# Conflicts:
#	source/packages/jcl/JclDebug.pas
#	source/packages/jcl/JclPeImage.pas
#	source/packages/jcl/JclSysInfo.pas

Source commit: 66462e48aac8c1241591ef213df01eade275296e
Martin Prikryl 1 年之前
父節點
當前提交
9ede252022

+ 8 - 3
source/packages/jcl/JclBase.pas

@@ -61,9 +61,9 @@ uses
 // Version
 const
   JclVersionMajor   = 2;    // 0=pre-release|beta/1, 2, ...=final
-  JclVersionMinor   = 7;    // Fifth minor release since JCL 1.90
+  JclVersionMinor   = 8;    // Fifth minor release since JCL 1.90
   JclVersionRelease = 0;    // 0: pre-release|beta/ 1: release
-  JclVersionBuild   = 5676; // build number, days since march 1, 2000
+  JclVersionBuild   = 5677; // build number, days since march 1, 2000
   JclVersion = (JclVersionMajor shl 24) or (JclVersionMinor shl 16) or
     (JclVersionRelease shl 15) or (JclVersionBuild shl 0);
 
@@ -113,7 +113,7 @@ type
   UInt64 = Int64;
   {$ENDIF ~COMPILER7_UP}
   PWideChar = System.PWideChar;
-  PPWideChar = ^JclBase.PWideChar;
+  PPWideChar = ^PWideChar;
   PPAnsiChar = ^PAnsiChar;
   PInt64 = type System.PInt64;
   {$ENDIF ~FPC}
@@ -161,6 +161,11 @@ type
   TJclULargeInteger = ULARGE_INTEGER;
   PJclULargeInteger = PULARGE_INTEGER;
 
+  {$IFNDEF COMPILER16_UP}
+  LONG = Longint;
+  {$EXTERNALSYM LONG}
+  {$ENDIF ~COMPILER16_UP}
+
 // Dynamic Array support
 type
   TDynByteArray          = array of Byte;

文件差異過大導致無法顯示
+ 497 - 112
source/packages/jcl/JclDebug.pas


+ 107 - 70
source/packages/jcl/JclFileUtils.pas

@@ -127,6 +127,8 @@ type
   TCompactPath = ({cpBegin, }cpCenter, cpEnd);
 
 function CharIsDriveLetter(const C: char): Boolean;
+function CharIsInvalidFileNameCharacter(const C: Char): Boolean;
+function CharIsInvalidPathCharacter(const C: Char): Boolean;
 
 function PathAddSeparator(const Path: string): string;
 function PathAddExtension(const Path, Extension: string): string;
@@ -895,7 +897,7 @@ type
   TJclMappedTextReaderIndex = (tiNoIndex, tiFull);
 
   PPAnsiCharArray = ^TPAnsiCharArray;
-  TPAnsiCharArray = array [0..0] of PAnsiChar;
+  TPAnsiCharArray = array [0..MaxInt div SizeOf(PAnsiChar) - 1] of PAnsiChar;
 
   TJclAnsiMappedTextReader = class(TPersistent)
   private
@@ -946,7 +948,7 @@ type
   end;
 
   PPWideCharArray = ^TPWideCharArray;
-  TPWideCharArray = array [0..0] of PWideChar;
+  TPWideCharArray = array [0..MaxInt div SizeOf(PWideChar) - 1] of PWideChar;
 
   TJclWideMappedTextReader = class(TPersistent)
   private
@@ -1063,25 +1065,26 @@ function PathListItemIndex(const List, Item: string): Integer;
 // returns the name of the command line parameter at position index, which is
 // separated by the given separator, if the first character of the name part
 // is one of the AllowedPrefixCharacters, this character will be deleted.
-function ParamName  (Index : Integer; const Separator : string = '=';
-             const AllowedPrefixCharacters : string = '-/'; TrimName : Boolean = true) : string;
+function ParamName(Index: Integer; const Separator: string = '=';
+  const AllowedPrefixCharacters: string = '-/'; TrimName: Boolean = True): string;
 // returns the value of the command line parameter at position index, which is
 // separated by the given separator
-function ParamValue (Index : Integer; const Separator : string = '='; TrimValue : Boolean = true) : string; overload;
+function ParamValue (Index: Integer; const Separator: string = '='; TrimValue: Boolean = True): string; overload;
 // seaches a command line parameter where the namepart is the searchname
 // and returns the value which is which by the given separator.
 // CaseSensitive defines the search type. if the first character of the name part
 // is one of the AllowedPrefixCharacters, this character will be deleted.
-function ParamValue (const SearchName : string; const Separator : string = '=';
-             CaseSensitive : Boolean = False;
-             const AllowedPrefixCharacters : string = '-/'; TrimValue : Boolean = true) : string; overload;
+function ParamValue (const SearchName: string; const Separator: string = '=';
+             CaseSensitive: Boolean = False;
+             const AllowedPrefixCharacters: string = '-/'; TrimValue: Boolean = True): string; overload;
 // seaches a command line parameter where the namepart is the searchname
 // and returns the position index. if no separator is defined, the full paramstr is compared.
 // CaseSensitive defines the search type. if the first character of the name part
 // is one of the AllowedPrefixCharacters, this character will be deleted.
-function ParamPos (const SearchName : string; const Separator : string = '=';
-             CaseSensitive : Boolean = False;
-             const AllowedPrefixCharacters : string = '-/'): Integer;
+function ParamPos (const SearchName: string; const Separator: string = '=';
+             CaseSensitive: Boolean = False;
+             const AllowedPrefixCharacters: string = '-/'): Integer;
+
 
 {$IFDEF UNITVERSIONING}
 const
@@ -2805,7 +2808,7 @@ function PathIsDiskDevice(const Path: string): Boolean;
 var
   FullPath: string;
   F: PIOFile;
-  Buffer: array [0..255] of Char;
+  Buffer: array [0..255] of AnsiChar;
   MountEntry: TMountEntry;
   FsTypes: TStringList;
 
@@ -2870,10 +2873,26 @@ begin
   end;
 end;
 
-function CharIsInvalidPathCharacter(const C: Char): Boolean; {$IFDEF SUPPORTS_INLINE} inline; {$ENDIF}
+function CharIsInvalidFileNameCharacter(const C: Char): Boolean;
+begin
+  case C of
+    '<', '>', '?', '/', '\', ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''':
+      Result := True;
+  else
+    Result := False;
+  end;
+end;
+
+function CharIsInvalidPathCharacter(const C: Char): Boolean;
 begin
   case C of
-    '<', '>', '?', '/', ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''':
+    '<', '>', '?',
+  {$IFDEF UNIX}
+    '/',
+  {$ELSE}
+    '\',
+  {$ENDIF}
+    ',', '*', '+', '=', '[', ']', '|', ':', ';', '"', '''':
       Result := True;
   else
     Result := False;
@@ -4872,10 +4891,10 @@ function WindowToModuleFileName(const Window: HWND): string;
 type
   {$IFDEF SUPPORTS_UNICODE}
   TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PWideChar; nSize: DWORD): DWORD; stdcall;
-  TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; lpdwSize: PDWORD): integer; stdcall;
+  TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; lpdwSize: PDWORD): BOOL; stdcall;
   {$ELSE ~SUPPORTS_UNICODE}
   TGetModuleFileNameEx = function(hProcess: THandle; hModule: HMODULE; FileName: PAnsiChar; nSize: DWORD): DWORD; stdcall;
-  TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PAnsiChar; lpdwSize: PDWORD): integer; stdcall;
+  TQueryFullProcessImageName = function(HProcess: THandle; dwFlags: DWORD; lpExeName: PAnsiChar; lpdwSize: PDWORD): BOOL; stdcall;
   {$ENDIF ~SUPPORTS_UNICODE}
 var
   FileName: array[0..300] of Char;
@@ -4884,6 +4903,7 @@ var
   HProcess: THandle;
   GetModuleFileNameExAddress: TGetModuleFileNameEx;
   QueryFullProcessImageNameAddress: TQueryFullProcessImageName;
+  Len: DWORD;
 begin
   Result := '';
   if Window <> 0 then
@@ -4899,7 +4919,7 @@ begin
         if JclCheckWinVersion(6, 0) then // WinVista or newer
         begin
           DllHinst := LoadLibrary('Kernel32.dll');
-          if DllHinst < HINSTANCE_ERROR then
+          if DllHinst <> 0 then
           begin
             try
               {$IFDEF SUPPORTS_UNICODE}
@@ -4909,13 +4929,14 @@ begin
               {$ENDIF ~SUPPORTS_UNICODE}
               if Assigned(QueryFullProcessImageNameAddress) then
               begin
-                QueryFullProcessImageNameAddress(hProcess, 0, FileName, PDWORD(sizeof(FileName)));
-                Result := FileName;
+                Len := Length(FileName);
+                if QueryFullProcessImageNameAddress(hProcess, 0, FileName, PDWORD(@Len)) then
+                  Result := FileName;
+                //else
+                //  RaiseLastOSError   would be nice, but it didn't raise an exception before the return value was checked
               end
               else
-              begin
                 raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Kernel32.dll', 'QueryFullProcessImageName']);
-              end
             finally
               FreeLibrary(DllHinst);
             end;
@@ -4926,7 +4947,7 @@ begin
         else
         begin
           DllHinst := LoadLibrary('Psapi.dll');
-          if DllHinst < HINSTANCE_ERROR then
+          if DllHinst <> 0 then
           begin
             try
               {$IFDEF SUPPORTS_UNICODE}
@@ -4936,13 +4957,14 @@ begin
               {$ENDIF ~SUPPORTS_UNICODE}
               if Assigned(GetModuleFileNameExAddress) then
               begin
-                GetModuleFileNameExAddress(hProcess, 0, FileName, sizeof(FileName));
-                Result := FileName;
+                Len := GetModuleFileNameExAddress(hProcess, 0, FileName, Length(FileName));
+                if Len > 0 then
+                  Result := FileName;
+                //else
+                //  RaiseLastOSError;   would be nice, but it didn't raise an exception before the return value was checked
               end
               else
-              begin
                 raise EJclError.CreateResFmt(@RsEFunctionNotFound, ['Psapi.dll', 'GetModuleFileNameEx']);
-              end
             finally
               FreeLibrary(DllHinst);
             end;
@@ -5189,6 +5211,12 @@ var
         Inc(I)
       else
         Delete(Key, I, 1);
+
+    // Office16\1031\GrooveIntlResource.dll contains a '4094B0' key. Both parts (lang and codepage)
+    // are missing their leading zero. It should have been '040904B0'.
+    // The Windows file property dialog falls back to "English (United States) 1252", so do we.
+    if Length(Key) < 8 then
+      Key := '040904E4';
   end;
 
   procedure ProcessStringInfo(Size: Integer);
@@ -6969,22 +6997,23 @@ end;
 // returns the name of the command line parameter at position index, which is
 // separated by the given separator, if the first character of the name part
 // is one of the AllowedPrefixCharacters, this character will be deleted.
-function ParamName  (Index : Integer; const Separator : string = '=';
-             const AllowedPrefixCharacters : string = '-/'; TrimName : Boolean = true) : string;
-var s: string;
-    p: Integer;
+function ParamName(Index: Integer; const Separator: string;
+  const AllowedPrefixCharacters: string; TrimName: Boolean): string;
+var
+  S: string;
+  P: Integer;
 begin
-  if (index > 0) and (index <= ParamCount) then
+  if (Index > 0) and (Index <= ParamCount) then
   begin
-    s := ParamStr(index);
-    if Pos(Copy(s, 1, 1), AllowedPrefixCharacters) > 0 then
-      s := Copy (s, 2, Length(s)-1);
-    p := Pos(Separator, s);
-    if p > 0 then
-      s := Copy (s, 1, p-1);
+    S := ParamStr(Index);
+    if Pos(Copy(S, 1, 1), AllowedPrefixCharacters) > 0 then
+      S := Copy(S, 2, Length(S) - 1);
+    P := Pos(Separator, S);
+    if P > 0 then
+      S := Copy(S, 1, P - 1);
     if TrimName then
-      s := Trim(s);
-    Result := s;
+      S := Trim(S);
+    Result := S;
   end
   else
     Result := '';
@@ -6992,19 +7021,20 @@ end;
 
 // returns the value of the command line parameter at position index, which is
 // separated by the given separator
-function ParamValue (Index : Integer; const Separator : string = '='; TrimValue : Boolean = true) : string;
-var s: string;
-    p: Integer;
+function ParamValue(Index: Integer; const Separator: string; TrimValue: Boolean): string;
+var
+  S: string;
+  P: Integer;
 begin
-  if (index > 0) and (index <= ParamCount) then
+  if (Index > 0) and (Index <= ParamCount) then
   begin
-    s := ParamStr(index);
-    p := Pos(Separator, s);
-    if p > 0 then
-      s := Copy (s, p+1, Length(s)-p);
+    S := ParamStr(Index);
+    P := Pos(Separator, S);
+    if P > 0 then
+      S := Copy(S, P + 1, Length(S) - P);
     if TrimValue then
-      s := Trim(s);
-    Result := s;
+      S := Trim(S);
+    Result := S;
   end
   else
     Result := '';
@@ -7014,21 +7044,25 @@ end;
 // and returns the value which is which by the given separator.
 // CaseSensitive defines the search type. if the first character of the name part
 // is one of the AllowedPrefixCharacters, this character will be deleted.
-function ParamValue (const SearchName : string; const Separator : string = '=';
-             CaseSensitive : Boolean = False;
-             const AllowedPrefixCharacters : string = '-/'; TrimValue : Boolean = true) : string;
-var pName : string;
-    i : Integer;
+function ParamValue(const SearchName: string; const Separator: string;
+  CaseSensitive: Boolean; const AllowedPrefixCharacters: string;
+  TrimValue: Boolean): string;
+var
+  Name: string;
+  SearchS: String;
+  I: Integer;
 begin
   Result := '';
-  for i  := 1 to ParamCount do
+  SearchS := Trim(SearchName);
+
+  for I := 1 to ParamCount do
   begin
-    pName := ParamName(i, Separator, AllowedPrefixCharacters, True);
-    if (CaseSensitive and (pName = Trim(SearchName))) or
-       (UpperCase(pName) = Trim(UpperCase(SearchName))) then
+    Name := ParamName(I, Separator, AllowedPrefixCharacters, True);
+    if (CaseSensitive and (Name = SearchS)) or
+       ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then
     begin
-      Result := ParamValue (i, Separator, TrimValue);
-      exit;
+      Result := ParamValue(I, Separator, TrimValue);
+      Exit;
     end;
   end;
 end;
@@ -7037,20 +7071,23 @@ end;
 // and returns the position index. if no separator is defined, the full paramstr is compared.
 // CaseSensitive defines the search type. if the first character of the name part
 // is one of the AllowedPrefixCharacters, this character will be deleted.
-function ParamPos (const SearchName : string; const Separator : string = '=';
-             CaseSensitive : Boolean = False;
-             const AllowedPrefixCharacters : string = '-/'): Integer;
-var pName : string;
-    i : Integer;
+function ParamPos(const SearchName: string; const Separator: string;
+  CaseSensitive: Boolean; const AllowedPrefixCharacters: string): Integer;
+var
+  Name: string;
+  SearchS: string;
+  I: Integer;
 begin
   Result := -1;
-  for i  := 1 to ParamCount do
+  SearchS := Trim(SearchName);
+
+  for I := 1 to ParamCount do
   begin
-    pName := ParamName(i, Separator, AllowedPrefixCharacters, True);
-    if (CaseSensitive and (pName = SearchName)) or
-       (UpperCase(pName) = UpperCase(SearchName)) then
+    Name := ParamName(I, Separator, AllowedPrefixCharacters, True);
+    if (CaseSensitive and (Name = SearchS)) or
+       ((not CaseSensitive) and (CompareText(Name, SearchS) = 0)) then
     begin
-      Result := i;
+      Result := I;
       Exit;
     end;
   end;

+ 14 - 5
source/packages/jcl/JclHookExcept.pas

@@ -358,6 +358,7 @@ end;
 procedure HookedRaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments: DWORD;
   Arguments: PExceptionArguments); stdcall;
 const
+  MS_VC_EXCEPTION = $406D1388;
   cDelphiException = $0EEDFADE;
   cNonContinuable = 1;                  // Delphi exceptions
   cNonContinuableException = $C0000025; // C++Builder exceptions (sounds like a bug)
@@ -372,6 +373,7 @@ begin
     {$IFDEF CPU32}
     and (TJclAddr(Arguments) = TJclAddr(@Arguments) + SizeOf(Pointer))
     {$ENDIF CPU32}
+    and (ExceptionCode <> MS_VC_EXCEPTION) // ignore TThread.NameThreadForDebugging
     then
   begin
     DoExceptNotify(Arguments.ExceptObj, Arguments.ExceptAddr, False, GetFramePointer);
@@ -381,14 +383,21 @@ end;
 
 {$IFDEF BORLAND}
 function HookedExceptObjProc(P: PExceptionRecord): Exception;
+const
+  MS_VC_EXCEPTION = $406D1388;
 var
   NewResultExcCache: Exception; // TLS optimization
 begin
-  Result := DoExceptFilter(P);
-  DoExceptNotify(Result, P^.ExceptionAddress, True, GetFramePointer);
-  NewResultExcCache := NewResultExc;
-  if NewResultExcCache <> nil then
-    Result := NewResultExcCache;
+  if P.ExceptionCode <> MS_VC_EXCEPTION then
+  begin
+    Result := DoExceptFilter(P);
+    DoExceptNotify(Result, P^.ExceptionAddress, True, GetFramePointer);
+    NewResultExcCache := NewResultExc;
+    if NewResultExcCache <> nil then
+      Result := NewResultExcCache;
+  end
+  else
+    Result := SysUtils_ExceptObjProc(P);
 end;
 {$ENDIF BORLAND}
 

+ 172 - 65
source/packages/jcl/JclPeImage.pas

@@ -146,6 +146,7 @@ type
     FLastSortDescending: Boolean;
     FName: string;
     FSorted: Boolean;
+    FUseRVA: Boolean;
     FTotalResolveCheck: TJclPeResolveCheck;
     FThunk: Pointer;
     FThunkData: Pointer;
@@ -164,7 +165,7 @@ type
     procedure SetThunk(Value: Pointer);
   public
     constructor Create(AImage: TJclPeImage; AImportDescriptor: Pointer;
-      AImportKind: TJclPeImportKind; const AName: string; AThunk: Pointer);
+      AImportKind: TJclPeImportKind; const AName: string; AThunk: Pointer; AUseRVA: Boolean = True);
     procedure SortList(SortType: TJclPeImportSort; Descending: Boolean = False);
     property Count: Integer read GetCount;
     property FileName: TFileName read GetFileName;
@@ -464,6 +465,7 @@ type
   TJclPeDebugList = class(TJclPeImageBaseList)
   private
     function GetItems(Index: Integer): TImageDebugDirectory;
+    function IsTD32DebugInfo(DebugDir: PImageDebugDirectory): Boolean;
   protected
     procedure CreateList;
   public
@@ -655,7 +657,7 @@ type
     function RawToVa(Raw: DWORD): Pointer; overload;
     function RvaToSection(Rva: DWORD): PImageSectionHeader; overload;
     function RvaToVa(Rva: DWORD): Pointer; overload;
-    function RvaToVaEx(Rva: DWORD): Pointer; overload;
+    function ImageAddressToRva(Address: DWORD): DWORD;
     function StatusOK: Boolean;
     procedure TryGetNamesForOrdinalImports;
     function VerifyCheckSum: Boolean;
@@ -1127,7 +1129,7 @@ uses
   Character,
   {$ENDIF HAS_UNIT_CHARACTER}
   {$ENDIF ~HAS_UNITSCOPE}
-  {$IFNDEF WINSCP}JclLogic,{$ELSE}Math, System.AnsiStrings, {$ENDIF ~WINSCP} JclResources, JclSysUtils, {$IFNDEF WINSCP}JclAnsiStrings,{$ENDIF ~WINSCP} JclStrings{$IFNDEF WINSCP}, JclStringConversions{$ENDIF ~WINSCP};
+  {$IFNDEF WINSCP}JclLogic,{$ELSE}Math, System.AnsiStrings, {$ENDIF ~WINSCP} JclResources, JclSysUtils, {$IFNDEF WINSCP}JclAnsiStrings,{$ENDIF ~WINSCP} JclStrings{$IFNDEF WINSCP}, JclStringConversions{$ENDIF ~WINSCP}, JclTD32;
 
 const
   MANIFESTExtension = '.manifest';
@@ -1498,7 +1500,7 @@ end;
 
 constructor TJclPeImportLibItem.Create(AImage: TJclPeImage;
   AImportDescriptor: Pointer; AImportKind: TJclPeImportKind; const AName: string;
-  AThunk: Pointer);
+  AThunk: Pointer; AUseRVA: Boolean = True);
 begin
   inherited Create(AImage);
   FTotalResolveCheck := icNotChecked;
@@ -1507,6 +1509,7 @@ begin
   FName := AName;
   FThunk := AThunk;
   FThunkData := AThunk;
+  FUseRVA := AUseRVA;
 end;
 
 procedure TJclPeImportLibItem.CheckImports(ExportImage: TJclPeImage);
@@ -1559,6 +1562,7 @@ procedure TJclPeImportLibItem.CreateList;
     Ordinal, Hint: Word;
     Name: PAnsiChar;
     ImportName: string;
+    AddressOfData: DWORD;
   begin
     Thunk32 := PImageThunkData32(FThunk);
     while Thunk32^.Function_ <> 0 do
@@ -1572,22 +1576,35 @@ procedure TJclPeImportLibItem.CreateList;
           ikImport, ikBoundImport:
             begin
               OrdinalName := PImageImportByName(Image.RvaToVa(Thunk32^.AddressOfData));
-              Hint := OrdinalName.Hint;
-              Name := OrdinalName.Name;
+              if OrdinalName <> nil then
+              begin
+                Hint := OrdinalName.Hint;
+                Name := OrdinalName.Name;
+              end;
             end;
           ikDelayImport:
             begin
-              OrdinalName := PImageImportByName(Image.RvaToVaEx(Thunk32^.AddressOfData));
-              Hint := OrdinalName.Hint;
-              Name := OrdinalName.Name;
+              AddressOfData := Thunk32^.AddressOfData;
+              if not FUseRVA then
+                AddressOfData := Image.ImageAddressToRva(AddressOfData);
+              OrdinalName := PImageImportByName(Image.RvaToVa(AddressOfData));
+              if OrdinalName <> nil then
+              begin
+                Hint := OrdinalName.Hint;
+                Name := OrdinalName.Name;
+              end;
             end;
         end;
       end
       else
         Ordinal := IMAGE_ORDINAL32(Thunk32^.Ordinal);
-      if not TryUTF8ToString(Name, ImportName) then
-        ImportName := string(Name);
-      Add(TJclPeImportFuncItem.Create(Self, Ordinal, Hint, ImportName));
+
+      if (Ordinal <> 0) or (Hint <> 0) or (Name <> nil) then
+      begin
+        if not TryUTF8ToString(Name, ImportName) then
+          ImportName := string(Name);
+        Add(TJclPeImportFuncItem.Create(Self, Ordinal, Hint, ImportName));
+      end;
       Inc(Thunk32);
     end;
   end;
@@ -1612,22 +1629,32 @@ procedure TJclPeImportLibItem.CreateList;
           ikImport, ikBoundImport:
             begin
               OrdinalName := PImageImportByName(Image.RvaToVa(Thunk64^.AddressOfData));
-              Hint := OrdinalName.Hint;
-              Name := OrdinalName.Name;
+              if OrdinalName <> nil then
+              begin
+                Hint := OrdinalName.Hint;
+                Name := OrdinalName.Name;
+              end;
             end;
           ikDelayImport:
             begin
-              OrdinalName := PImageImportByName(Image.RvaToVaEx(Thunk64^.AddressOfData));
-              Hint := OrdinalName.Hint;
-              Name := OrdinalName.Name;
+              OrdinalName := PImageImportByName(Image.RvaToVa(Thunk64^.AddressOfData));
+              if OrdinalName <> nil then
+              begin
+                Hint := OrdinalName.Hint;
+                Name := OrdinalName.Name;
+              end;
             end;
         end;
       end
       else
         Ordinal := IMAGE_ORDINAL64(Thunk64^.Ordinal);
-      if not TryUTF8ToString(Name, ImportName) then
-        ImportName := string(Name);
-      Add(TJclPeImportFuncItem.Create(Self, Ordinal, Hint, ImportName));
+
+      if (Ordinal <> 0) or (Hint <> 0) or (Name <> nil) then
+      begin
+        if not TryUTF8ToString(Name, ImportName) then
+          ImportName := string(Name);
+        Add(TJclPeImportFuncItem.Create(Self, Ordinal, Hint, ImportName));
+      end;
       Inc(Thunk64);
     end;
   end;
@@ -1771,18 +1798,33 @@ end;
 
 procedure TJclPeImportList.CreateList;
   procedure CreateDelayImportList32(DelayImportDesc: PImgDelayDescrV1);
+  const
+    ATTRS_RVA = 1;
   var
     LibItem: TJclPeImportLibItem;
     UTF8Name: TUTF8String;
     LibName: string;
+    P, Thunk: Pointer;
+    UseRVA: Boolean;
   begin
+    // 2010, XE use addresses whereas XE2 and newer use the RVA mode
     while DelayImportDesc^.szName <> nil do
     begin
-      UTF8Name := PAnsiChar(Image.RvaToVaEx(DWORD(DelayImportDesc^.szName)));
+      UseRVA := DelayImportDesc^.grAttrs and ATTRS_RVA <> 0;
+
+      Thunk := DelayImportDesc^.pINT;
+      P := DelayImportDesc^.szName;
+      if not UseRVA then
+      begin
+        Thunk := Pointer(Image.ImageAddressToRva(DWORD(DelayImportDesc^.pINT)));
+        P := Pointer(Image.ImageAddressToRva(DWORD(DelayImportDesc^.szName)));
+      end;
+
+      UTF8Name := PAnsiChar(Image.RvaToVa(DWORD(P)));
       if not TryUTF8ToString(UTF8Name, LibName) then
         LibName := string(UTF8Name);
       LibItem := TJclPeImportLibItem.Create(Image, DelayImportDesc, ikDelayImport,
-        LibName, Image.RvaToVaEx(DWORD(DelayImportDesc^.pINT)));
+        LibName, Image.RvaToVa(DWORD(Thunk)), UseRVA);
       Add(LibItem);
       FUniqueNamesList.AddObject(AnsiLowerCase(LibItem.Name), LibItem);
       Inc(DelayImportDesc);
@@ -1795,6 +1837,7 @@ procedure TJclPeImportList.CreateList;
     UTF8Name: TUTF8String;
     LibName: string;
   begin
+    // 64 bit always uses RVA mode
     while DelayImportDesc^.rvaDLLName <> 0 do
     begin
       UTF8Name := PAnsiChar(Image.RvaToVa(DelayImportDesc^.rvaDLLName));
@@ -1851,11 +1894,16 @@ begin
     DelayImportDesc := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT);
     if DelayImportDesc <> nil then
     begin
-      case Target of
-        taWin32:
-          CreateDelayImportList32(DelayImportDesc);
-        taWin64:
-          CreateDelayImportList64(DelayImportDesc);
+      try
+        case Target of
+          taWin32:
+            CreateDelayImportList32(DelayImportDesc);
+          taWin64:
+            CreateDelayImportList64(DelayImportDesc);
+        end;
+      except
+        on E: EAccessViolation do // Mantis #6177. Some users seem to have module loaded that is broken
+          ; // ignore
       end;
     end;
     BoundImports := DirectoryEntryToData(IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT);
@@ -2405,19 +2453,22 @@ begin
         List{$IFNDEF RTL230_UP}^{$ENDIF !RTL230_UP}[I] := ExportItem;
       end;
 
-      for I := 0 to NameCount - 1 do
+      if NameCount > 0 then
       begin
+        for I := 0 to NameCount - 1 do
+        begin
           // named function
-        UTF8Name := PAnsiChar(RvaToVa(Names^));
-        if not TryUTF8ToString(UTF8Name, ExportName) then
-          ExportName := string(UTF8Name);
+          UTF8Name := PAnsiChar(RvaToVa(Names^));
+          if not TryUTF8ToString(UTF8Name, ExportName) then
+            ExportName := string(UTF8Name);
 
-        ExportItem := TJclPeExportFuncItem(List{$IFNDEF RTL230_UP}^{$ENDIF !RTL230_UP}[NameOrdinals^]);
-        ExportItem.FName := ExportName;
-        ExportItem.FHint := I;
+          ExportItem := TJclPeExportFuncItem(List{$IFNDEF RTL230_UP}^{$ENDIF !RTL230_UP}[NameOrdinals^]);
+          ExportItem.FName := ExportName;
+          ExportItem.FHint := I;
 
-        Inc(NameOrdinals);
-        Inc(Names);
+          Inc(NameOrdinals);
+          Inc(Names);
+        end;
       end;
     end;
   end;
@@ -3012,6 +3063,14 @@ begin
   CreateList;
 end;
 
+function TJclPeDebugList.IsTD32DebugInfo(DebugDir: PImageDebugDirectory): Boolean;
+var
+  Base: Pointer;
+begin
+  Base := Image.RvaToVa(DebugDir^.AddressOfRawData);
+  Result := TJclTD32InfoParser.IsTD32DebugInfoValid(Base, DebugDir^.SizeOfData);
+end;
+
 procedure TJclPeDebugList.CreateList;
 var
   DebugImageDir: TImageDataDirectory;
@@ -3027,19 +3086,17 @@ begin
     if DebugImageDir.VirtualAddress = 0 then
       Exit;
     if GetSectionHeader(DebugSectionName, Header) and
-      (Header^.VirtualAddress = DebugImageDir.VirtualAddress) then
+      (Header^.VirtualAddress = DebugImageDir.VirtualAddress) and
+      (IsTD32DebugInfo(RvaToVa(DebugImageDir.VirtualAddress))) then
     begin
+      // TD32 debug image directory is broken...size should be in bytes, not count.
       FormatCount := DebugImageDir.Size;
-      DebugDir := RvaToVa(Header^.VirtualAddress);
     end
     else
     begin
-      if not GetSectionHeader(ReadOnlySectionName, Header) then
-        Exit;
       FormatCount := DebugImageDir.Size div SizeOf(TImageDebugDirectory);
-      DebugDir := Pointer(MappedAddress + DebugImageDir.VirtualAddress -
-        Header^.VirtualAddress + Header^.PointerToRawData);
     end;
+    DebugDir := RvaToVa(DebugImageDir.VirtualAddress);
     for I := 1 to FormatCount do
     begin
       Add(TObject(DebugDir));
@@ -4264,34 +4321,25 @@ begin
     Result := ImageRvaToVa(FLoadedImage.FileHeader, FLoadedImage.MappedAddress, Rva, nil);
 end;
 
-function TJclPeImage.RvaToVaEx(Rva: DWORD): Pointer;
-  function RvaToVaEx32(Rva: DWORD): Pointer;
-  var
-    OptionalHeader: TImageOptionalHeader32;
-  begin
-    OptionalHeader := OptionalHeader32;
-    if (Rva >= OptionalHeader.ImageBase) and (Rva < (OptionalHeader.ImageBase + FLoadedImage.SizeOfImage)) then
-      Dec(Rva, OptionalHeader.ImageBase);
-    Result := RvaToVa(Rva);
-  end;
-  function RvaToVaEx64(Rva: DWORD): Pointer;
-  var
-    OptionalHeader: TImageOptionalHeader64;
-  begin
-    OptionalHeader := OptionalHeader64;
-    if (Rva >= OptionalHeader.ImageBase) and (Rva < (OptionalHeader.ImageBase + FLoadedImage.SizeOfImage)) then
-      Dec(Rva, OptionalHeader.ImageBase);
-    Result := RvaToVa(Rva);
-  end;
+function TJclPeImage.ImageAddressToRva(Address: DWORD): DWORD;
+var
+  ImageBase32: DWORD;
+  ImageBase64: Int64;
 begin
   case Target of
     taWin32:
-      Result := RvaToVaEx32(Rva);
+      begin
+        ImageBase32 := PImageNtHeaders32(FLoadedImage.FileHeader)^.OptionalHeader.ImageBase;
+        Result := Address - ImageBase32;
+      end;
     taWin64:
-      Result := RvaToVaEx64(Rva);
+      begin
+        ImageBase64 := PImageNtHeaders64(FLoadedImage.FileHeader)^.OptionalHeader.ImageBase;
+        Result := DWORD(Address - ImageBase64);
+      end;
     //taUnknown:
   else
-    Result := nil;
+    Result := 0;
   end;
 end;
 
@@ -6302,7 +6350,12 @@ type
   PPackageThunk = ^TPackageThunk;
   TPackageThunk = packed record
     JmpInstruction: Word;
+  {$IFDEF CPU32}
     JmpAddress: PPointer;
+  {$ENDIF CPU32}
+  {$IFDEF CPU64}
+    JmpOffset: Int32;
+  {$ENDIF CPU64}
   end;
 begin
   if not IsCompiledWithPackages then
@@ -6310,7 +6363,13 @@ begin
   else
   if not IsBadReadPtr(Address, SizeOf(TPackageThunk)) and
     (PPackageThunk(Address)^.JmpInstruction = JmpInstructionCode) then
+  {$IFDEF CPU32}
     Result := PPackageThunk(Address)^.JmpAddress^
+  {$ENDIF CPU32}
+  {$IFDEF CPU64}
+    Result := PPointer(PByte(Address) + SizeOf(TPackageThunk) +
+      PPackageThunk(Address)^.JmpOffset)^
+  {$ENDIF CPU64}
   else
     Result := nil;
 end;
@@ -6692,6 +6751,48 @@ end;
 
 // Borland BPL packages name unmangling
 
+{$IFDEF CPU64}
+function PeBorUnmangleName(const Name: string; out Unmangled: string;
+  out Description: TJclBorUmDescription; out BasePos: Integer): TJclBorUmResult;
+var
+  CurPos: Integer;
+  EndPos: Integer;
+  Len: Integer;
+  PrevBasePos: Integer;
+begin
+  if (Length(Name) > 3) and (Name[1] = '_') and (Name[2] = 'Z') and (Name[3] = 'N') then
+  begin
+    Result := urOk;
+    CurPos := 4;
+    BasePos := 0;
+    PrevBasePos := 0;
+    while CurPos < Length(Name) do
+    begin
+      EndPos := CurPos;
+      while CharInSet(Name[EndPos], ['0'..'9']) do
+        Inc(EndPos);
+      if not TryStrToInt(Copy(Name, CurPos, EndPos - CurPos), Len) then
+        Break;
+      BasePos := PrevBasePos;
+      PrevBasePos := Length(Unmangled);
+      if Unmangled <> '' then
+        Unmangled := Unmangled + '.';
+      Unmangled := Unmangled + Copy(Name, EndPos, Len);
+      CurPos := EndPos + Len;
+    end;
+    if BasePos = 0 then
+      BasePos := PrevBasePos + 2
+    else
+      BasePos := BasePos + 2;
+    Description.Kind := skFunction;
+    Description.Modifiers := [];
+  end
+  else
+    Result := urNotMangled;
+end;
+{$ENDIF CPU64}
+
+{$IFDEF CPU32}
 function PeBorUnmangleName(const Name: string; out Unmangled: string;
   out Description: TJclBorUmDescription; out BasePos: Integer): TJclBorUmResult;
 var
@@ -6851,6 +6952,7 @@ begin
   if not TryUTF8ToString(UTF8Unmangled, Unmangled) then
     Unmangled := string(UTF8Unmangled);
 end;
+{$ENDIF CPU32}
 
 function PeBorUnmangleName(const Name: string; out Unmangled: string;
   out Description: TJclBorUmDescription): TJclBorUmResult;
@@ -6880,7 +6982,7 @@ begin
     Result := '';
 end;
 
-function PeIsNameMangled(const Name: string): TJclPeUmResult;
+function PeIsNameMangled(const Name: string): TJclPeUmResult; {$IFDEF SUPPORTS_INLINE}inline;{$ENDIF}
 begin
   Result := umNotMangled;
   if Length(Name) > 0 then
@@ -6889,6 +6991,11 @@ begin
         Result := umBorland;
       '?':
         Result := umMicrosoft;
+      {$IFDEF CPU64}
+      '_':
+        if (Length(Name) > 3) and (Name[2] = 'Z') and (Name[3] = 'N') then
+          Result := umBorland;
+      {$ENDIF CPU64}
     end;
 end;
 

+ 24 - 4
source/packages/jcl/JclResources.pas

@@ -1129,6 +1129,22 @@ resourcestring
   RsCompressionSquashFSExtensions    = '*.squashfs';
   RsCompressionCramFSName            = 'CramFS archive';
   RsCompressionCramFSExtensions      = '*.cramfs';
+  RsCompressionExtName               = 'Ext filesystem archive';
+  RsCompressionExtExtensions         = '*.ext;*.ext2;*.ext3;*.ext4;*.img';
+  RsCompressionVMDKName              = 'Virtual Machine Disk archive';
+  RsCompressionVMDKExtensions        = '*.vmdk';
+  RsCompressionVDIName               = 'Virtual Disk Image archive';
+  RsCompressionVDIExtensions         = '*.vdi';
+  RsCompressionQcowName              = 'QEMU Copy On Write archive';
+  RsCompressionQcowExtensions        = '*.qcow;*.qcow2;*.qcow2c';
+  RsCompressionGPTName               = 'GUID Partition Table archive';
+  RsCompressionGPTExtensions         = '*.gpt;*.mbr';
+  RsCompressionRar5Name              = 'RAR v5 archive';
+  RsCompressionRar5Extensions        = '*.rar;*.r00';
+  RsCompressionIHexName              = 'IHex archive';
+  RsCompressionIHexExtensions        = '*.ihex';
+  RsCompressionHxsName               = 'Help 2.0 archive';
+  RsCompressionHxsExtensions         = '*.hxs;*.hxi;*.hxr;*.hxq;*.hxw;*.lit';
   RsCompressionDuplicate             = 'The file %s already exists in the archive';
   RsCompressionReplaceError          = 'At least one compression volume could not be replaced after an archive out-of-place update';
 
@@ -1197,10 +1213,10 @@ resourcestring
   RsCannotCreateDir = 'Unable to create directory';
   RsDelTreePathIsEmpty = 'DelTree: Path is empty';
   RsFileSearchAttrInconsistency = 'Some file search attributes are required AND rejected!';
-  RsEWindowsVersionNotSupported = 'This windows version is not supported';
+  RsEWindowsVersionNotSupported = 'This Windows version is not supported';
   RsEWindowNotValid = 'The window with handle %d is not valid';
   RsEProcessNotValid = 'The process with ID %d is not valid';
-  RsEModuleNotValid = 'The Module with handle %d is not valid';
+  RsEModuleNotValid = 'The module with handle %d is not valid';
 
   // TJclFileVersionInfo
   RsFileUtilsNoVersionInfo = 'File contains no version information';
@@ -1942,6 +1958,10 @@ resourcestring
   RsOSVersionWinServer2012R2    = 'Windows Server 2012 R2';
   RsOSVersionWin10              = 'Windows 10';
   RsOSVersionWinServer2016      = 'Windows Server 2016';
+  RsOSVersionWinServer2019      = 'Windows Server 2019';
+  RsOSVersionWinServer2022      = 'Windows Server 2022';
+  RsOSVersionWinServer          = 'Windows Server';
+  RsOSVersionWin11              = 'Windows 11';
 
   RsEditionWinXPHome            = 'Home Edition';
   RsEditionWinXPPro             = 'Professional';
@@ -1988,8 +2008,8 @@ resourcestring
   RsProductTypeEnterprise       = 'Enterprise';
   RsProductTypeWebEdition       = 'Web Edition';
 
-  RsEOpenGLInfo = 'GetOpenGLVersion: %s failed';
-  RsENetWkstaGetInfo = 'NetWkstaGetInfo failed';
+  RsEOpenGLInfo                 = 'GetOpenGLVersion: %s failed';
+  RsENetWkstaGetInfo            = 'NetWkstaGetInfo failed';
 
   {$IFDEF MSWINDOWS}
   RsSPInfo = 'SP%u';

+ 5 - 0
source/packages/jcl/JclStreams.pas

@@ -2376,6 +2376,11 @@ begin
   FStream := AStream;
   FOwnStream := AOwnsStream;
   FBufferSize := StreamDefaultBufferSize;
+
+  // Must call this method so that buffer initial values are properly set.
+  // This is most useful when AStream is not located at position zero
+  // before being used by us.
+  InvalidateBuffers;
 end;
 
 destructor TJclStringStream.Destroy;

+ 2 - 2
source/packages/jcl/JclStrings.pas

@@ -667,8 +667,8 @@ uses
 
 type
   TStrRec = packed record
-    RefCount: Longint;
-    Length: Longint;
+    RefCount: Integer;
+    Length: Integer;
   end;
   PStrRec = ^TStrRec;
 

+ 7 - 1
source/packages/jcl/JclSynch.pas

@@ -87,8 +87,10 @@ function LockedInc(var Target: Int64): Int64; overload;
 function LockedSub(var Target: Int64; Value: Int64): Int64; overload;
 
 {$IFDEF BORLAND}
+{$IFNDEF COMPILER29_UP}
 function LockedDec(var Target: NativeInt): NativeInt; overload;
 function LockedInc(var Target: NativeInt): NativeInt; overload;
+{$ENDIF ~COMPILER29_UP}
 {$ENDIF BORLAND}
 {$ENDIF CPU64}
 
@@ -743,6 +745,8 @@ end;
 
 {$IFDEF BORLAND}
 
+{$IFNDEF COMPILER29_UP}
+
 function LockedDec(var Target: NativeInt): NativeInt;
 asm
         // --> RCX Target
@@ -761,6 +765,8 @@ asm
         INC     RAX
 end;
 
+{$ENDIF ~COMPILER29_UP}
+
 {$ENDIF BORLAND}
 
 {$ENDIF CPU64}
@@ -1087,7 +1093,7 @@ constructor TJclMutex.Create(SecAttr: PSecurityAttributes; InitialOwner: Boolean
 begin
   inherited Create;
   FName := Name;
-  FHandle := JclWin32.CreateMutex(SecAttr, Ord(InitialOwner), PChar(Name));
+  FHandle := JclWin32.CreateMutex(SecAttr, InitialOwner, PChar(Name));
   if FHandle = 0 then
     raise EJclMutexError.CreateRes(@RsSynchCreateMutex);
   FExisted := GetLastError = ERROR_ALREADY_EXISTS;

文件差異過大導致無法顯示
+ 612 - 73
source/packages/jcl/JclSysInfo.pas


+ 274 - 87
source/packages/jcl/JclSysUtils.pas

@@ -396,6 +396,10 @@ type
 function GetMethodTable(AClass: TClass): PMethodTable;
 function GetMethodEntry(MethodTable: PMethodTable; Index: Integer): PMethodEntry;
 
+// Function to compare if two methods/event handlers are equal
+function MethodEquals(aMethod1, aMethod2: TMethod): boolean;
+function NotifyEventEquals(aMethod1, aMethod2: TNotifyEvent): boolean;
+
 // Class Parent
 procedure SetClassParent(AClass: TClass; NewClassParent: TClass);
 function GetClassParent(AClass: TClass): TClass;
@@ -503,22 +507,91 @@ const
   ABORT_EXIT_CODE = {$IFDEF MSWINDOWS} ERROR_CANCELLED {$ELSE} 1223 {$ENDIF};
 
 function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean = False;
-  AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal;
+  AutoConvertOem: Boolean = False): Cardinal; overload;
 function Execute(const CommandLine: string; AbortEvent: TJclEvent;
-  OutputLineCallback: TTextHandler; RawOutput: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  OutputLineCallback: TTextHandler; RawOutput: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal;
+  AutoConvertOem: Boolean = False): Cardinal; overload;
 function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean = False;
-  AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal;
+  AutoConvertOem: Boolean = False): Cardinal; overload;
 function Execute(const CommandLine: string; AbortEvent: TJclEvent;
-  var Output: string; RawOutput: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  var Output: string; RawOutput: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal;
+  AutoConvertOem: Boolean = False): Cardinal; overload;
 
 function Execute(const CommandLine: string; OutputLineCallback, ErrorLineCallback: TTextHandler;
-  RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil;
+  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
 function Execute(const CommandLine: string; AbortEvent: TJclEvent;
-  OutputLineCallback, ErrorLineCallback: TTextHandler; RawOutput: Boolean = False; RawError: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  OutputLineCallback, ErrorLineCallback: TTextHandler; RawOutput: Boolean = False; RawError: Boolean = False;
+  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
 function Execute(const CommandLine: string; var Output, Error: string;
-  RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  RawOutput: Boolean = False; RawError: Boolean = False; AbortPtr: PBoolean = nil;
+  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
 function Execute(const CommandLine: string; AbortEvent: TJclEvent;
-  var Output, Error: string; RawOutput: Boolean = False; RawError: Boolean = False; ProcessPriority: TJclProcessPriority = ppNormal): Cardinal; overload;
+  var Output, Error: string; RawOutput: Boolean = False; RawError: Boolean = False;
+  ProcessPriority: TJclProcessPriority = ppNormal; AutoConvertOem: Boolean = False): Cardinal; overload;
+
+type
+  {$IFDEF MSWINDOWS}
+  TJclExecuteCmdProcessOptionBeforeResumeEvent = procedure(const ProcessInfo: TProcessInformation) of object;
+  TStartupVisibility = (svHide, svShow, svNotSet);
+  {$ENDIF MSWINDOWS}
+
+  TJclExecuteCmdProcessOptions = {record} class(TObject)
+  private
+    FCommandLine: string;
+    FAbortPtr: PBoolean;
+    FAbortEvent: TJclEvent;
+
+    FOutputLineCallback: TTextHandler;
+    FRawOutput: Boolean;
+    FMergeError: Boolean;
+    FErrorLineCallback: TTextHandler;
+    FRawError: Boolean;
+    FProcessPriority: TJclProcessPriority;
+
+    FAutoConvertOem: Boolean;
+    {$IFDEF MSWINDOWS}
+    FCreateProcessFlags: DWORD;
+    FStartupVisibility: TStartupVisibility;
+    FBeforeResume: TJclExecuteCmdProcessOptionBeforeResumeEvent;
+    {$ENDIF MSWINDOWS}
+
+    FExitCode: Cardinal;
+    FOutput: string;
+    FError: string;
+  public
+    // in:
+    property CommandLine: string read FCommandLine write FCommandLine;
+    property AbortPtr: PBoolean read FAbortPtr write FAbortPtr;
+    property AbortEvent: TJclEvent read FAbortEvent write FAbortEvent;
+
+    property OutputLineCallback: TTextHandler read FOutputLineCallback write FOutputLineCallback;
+    property RawOutput: Boolean read FRawOutput write FRawOutput default False;
+    property MergeError: Boolean read FMergeError write FMergeError default False;
+    property ErrorLineCallback: TTextHandler read FErrorLineCallback write FErrorLineCallback;
+    property RawError: Boolean read FRawError write FRawError default False;
+    property ProcessPriority: TJclProcessPriority read FProcessPriority write FProcessPriority default ppNormal;
+
+    // AutoConvertOem assumes the process outputs OEM encoded strings and converts them to the
+    // default string encoding.
+    property AutoConvertOem: Boolean read FAutoConvertOem write FAutoConvertOem default True;
+    {$IFDEF MSWINDOWS}
+    property CreateProcessFlags: DWORD read FCreateProcessFlags write FCreateProcessFlags;
+    property StartupVisibility: TStartupVisibility read FStartupVisibility write FStartupVisibility;
+    property BeforeResume: TJclExecuteCmdProcessOptionBeforeResumeEvent read FBeforeResume write FBeforeResume;
+    {$ENDIF MSWINDOWS}
+
+    // out:
+    property ExitCode: Cardinal read FExitCode;
+    property Output: string read FOutput;
+    property Error: string read FError;
+  public
+    constructor Create(const ACommandLine: string);
+  end;
+
+function ExecuteCmdProcess(Options: TJclExecuteCmdProcessOptions): Boolean;
 
 type
 {$HPPEMIT 'namespace Jclsysutils'}
@@ -1453,12 +1526,6 @@ procedure SortDynArray(const ArrayPtr: Pointer; ElementSize: Cardinal; SortFunc:
 var
   TempBuf: TDynByteArray;
 
-  function ArrayItemPointer(Item: SizeInt): Pointer;
-  begin
-    Assert(Item >= 0);
-    Result := Pointer(TJclAddr(ArrayPtr) + TJclAddr(Item * SizeInt(ElementSize)));
-  end;
-
   procedure QuickSort(L, R: SizeInt);
   var
     I, J, T: SizeInt;
@@ -1469,10 +1536,10 @@ var
     repeat
       I := L;
       J := R;
-      P := ArrayItemPointer((L + R) shr 1);
+      P := Pointer(TJclAddr(ArrayPtr) + TJclAddr(((L + R) shr 1) * SizeInt(ElementSize)));
       repeat
-        IPtr := ArrayItemPointer(I);
-        JPtr := ArrayItemPointer(J);
+        IPtr := Pointer(TJclAddr(ArrayPtr) + TJclAddr(I * SizeInt(ElementSize)));
+        JPtr := Pointer(TJclAddr(ArrayPtr) + TJclAddr(J * SizeInt(ElementSize)));
         while SortFunc(IPtr, P) < 0 do
         begin
           Inc(I);
@@ -2126,6 +2193,16 @@ begin
     Inc(TJclAddr(Result), Result^.EntrySize);
 end;
 
+function MethodEquals(aMethod1, aMethod2: TMethod): boolean;
+begin
+  Result := (aMethod1.Code = aMethod2.Code) and
+            (aMethod1.Data = aMethod2.Data);
+end;
+function NotifyEventEquals(aMethod1, aMethod2: TNotifyEvent): boolean;
+begin
+  Result := MethodEquals(TMethod(aMethod1),TMethod(aMethod2));
+end;
+
 //=== Class Parent methods ===================================================
 
 procedure SetClassParent(AClass: TClass; NewClassParent: TClass);
@@ -2702,6 +2779,7 @@ type
     Line: string;
     TextHandler: TTextHandler;
     RawOutput: Boolean;
+    AutoConvertOem: Boolean;
     Event: TJclEvent;
   end;
   PPipeInfo = ^TPipeInfo;
@@ -2759,23 +2837,52 @@ end;
 procedure InternalExecuteProcessBuffer(var PipeInfo: TPipeInfo; PipeBytesRead: Cardinal);
 var
   CR, LF: Integer;
+  {$IFDEF MSWINDOWS}
+  LineLen, Len: Integer;
+  {$ENDIF MSWINDOWS}
+  S: AnsiString;
 begin
-  PipeInfo.Buffer[PipeBytesRead] := #0;
-  PipeInfo.Line := PipeInfo.Line + string(PipeInfo.Buffer);
+  {$IFDEF MSWINDOWS}
+  if PipeInfo.AutoConvertOem then
+  begin
+    {$IFDEF UNICODE}
+    Len := MultiByteToWideChar(CP_OEMCP, 0, PipeInfo.Buffer, PipeBytesRead, nil, 0);
+    LineLen := Length(PipeInfo.Line);
+    // Convert directly into the PipeInfo.Line string
+    SetLength(PipeInfo.Line, LineLen + Len);
+    MultiByteToWideChar(CP_OEMCP, 0, PipeInfo.Buffer, PipeBytesRead, PChar(PipeInfo.Line) + LineLen, Len);
+    {$ELSE}
+    Len := PipeBytesRead;
+    LineLen := Length(PipeInfo.Line);
+    // Convert directly into the PipeInfo.Line string
+    SetLength(PipeInfo.Line, LineLen + Len);
+    OemToAnsiBuff(PipeInfo.Buffer, PAnsiChar(PipeInfo.Line) + LineLen, PipeBytesRead);
+    {$ENDIF UNICODE}
+  end
+  else
+  {$ENDIF MSWINDOWS}
+  begin
+    SetString(S, PipeInfo.Buffer, PipeBytesRead); // interpret as ANSI
+    {$IFDEF UNICODE}
+    PipeInfo.Line := PipeInfo.Line + string(S); // ANSI => UNICODE
+    {$ELSE}
+    PipeInfo.Line := PipeInfo.Line + S;
+    {$ENDIF UNICODE}
+  end;
   if Assigned(PipeInfo.TextHandler) then
-  repeat
-    CR := Pos(NativeCarriageReturn, PipeInfo.Line);
-    if CR = Length(PipeInfo.Line) then
-      CR := 0;        // line feed at CR + 1 might be missing
-    LF := Pos(NativeLineFeed, PipeInfo.Line);
-    if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
-      LF := CR;       // accept CR as line end
-    if LF > 0 then
-    begin
-      InternalExecuteProcessLine(PipeInfo, LF);
-      Delete(PipeInfo.Line, 1, LF);
-    end;
-  until LF = 0;
+    repeat
+      CR := Pos(NativeCarriageReturn, PipeInfo.Line);
+      if CR = Length(PipeInfo.Line) then
+        CR := 0;        // line feed at CR + 1 might be missing
+      LF := Pos(NativeLineFeed, PipeInfo.Line);
+      if (CR > 0) and ((LF > CR + 1) or (LF = 0)) then
+        LF := CR;       // accept CR as line end
+      if LF > 0 then
+      begin
+        InternalExecuteProcessLine(PipeInfo, LF);
+        Delete(PipeInfo.Line, 1, LF);
+      end;
+    until LF = 0;
 end;
 
 procedure InternalExecuteReadPipe(var PipeInfo: TPipeInfo; var Overlapped: TOverlapped);
@@ -2905,14 +3012,23 @@ const
     (IDLE_PRIORITY_CLASS, NORMAL_PRIORITY_CLASS, HIGH_PRIORITY_CLASS, REALTIME_PRIORITY_CLASS,
      BELOW_NORMAL_PRIORITY_CLASS, ABOVE_NORMAL_PRIORITY_CLASS);
 
-function InternalExecute(CommandLine: string; AbortPtr: PBoolean; AbortEvent: TJclEvent;
-  var Output: string; OutputLineCallback: TTextHandler; RawOutput: Boolean;
-  MergeError: Boolean; var Error: string; ErrorLineCallback: TTextHandler; RawError: Boolean;
-  ProcessPriority: TJclProcessPriority): Cardinal;
+{ TJclExecuteCmdProcessOptions }
+
+constructor TJclExecuteCmdProcessOptions.Create(const ACommandLine: string);
+begin
+  inherited Create;
+  FCommandLine := ACommandLine;
+  FAutoConvertOem := True;
+  FProcessPriority := ppNormal;
+end;
+
+function ExecuteCmdProcess(Options: TJclExecuteCmdProcessOptions): Boolean;
 var
   OutPipeInfo, ErrorPipeInfo: TPipeInfo;
   Index: Cardinal;
 {$IFDEF MSWINDOWS}
+const
+  StartupVisibilityFlags: array[TStartupVisibility] of DWORD = (SW_HIDE, SW_SHOW, SW_SHOWDEFAULT);
 var
   StartupInfo: TStartupInfo;
   ProcessInfo: TProcessInformation;
@@ -2922,30 +3038,38 @@ var
   WaitEvents: array of TJclDispatcherObject;
   InternalAbort: Boolean;
   LastError: DWORD;
+  CommandLine: string;
+  AbortPtr: PBoolean;
+  Flags: DWORD;
 begin
+  Result := False;
+
   // hack to pass a null reference to the parameter lpNumberOfBytesRead of ReadFile
-  Result := $FFFFFFFF;
+  Options.FExitCode := $FFFFFFFF;
+
   SecurityAttr.nLength := SizeOf(SecurityAttr);
   SecurityAttr.lpSecurityDescriptor := nil;
   SecurityAttr.bInheritHandle := True;
 
   ResetMemory(OutPipeInfo, SizeOf(OutPipeInfo));
-  OutPipeInfo.TextHandler := OutputLineCallback;
-  OutPipeInfo.RawOutput := RawOutput;
+  OutPipeInfo.TextHandler := Options.OutputLineCallback;
+  OutPipeInfo.RawOutput := Options.RawOutput;
+  OutPipeInfo.AutoConvertOem := Options.AutoConvertOem;
   if not CreateAsyncPipe(OutPipeInfo.PipeRead, OutPipeInfo.PipeWrite, @SecurityAttr, 0) then
   begin
-    Result := GetLastError;
+    Options.FExitCode := GetLastError;
     Exit;
   end;
   OutPipeInfo.Event := TJclEvent.Create(@SecurityAttr, False {automatic reset}, False {not flagged}, '' {anonymous});
   ResetMemory(ErrorPipeInfo, SizeOf(ErrorPipeInfo));
-  if not MergeError then
+  if not Options.MergeError then
   begin
-    ErrorPipeInfo.TextHandler := ErrorLineCallback;
-    ErrorPipeInfo.RawOutput := RawError;
+    ErrorPipeInfo.TextHandler := Options.ErrorLineCallback;
+    ErrorPipeInfo.RawOutput := Options.RawError;
+    ErrorPipeInfo.AutoConvertOem := Options.AutoConvertOem;
     if not CreateAsyncPipe(ErrorPipeInfo.PipeRead, ErrorPipeInfo.PipeWrite, @SecurityAttr, 0) then
     begin
-      Result := GetLastError;
+      Options.FExitCode := GetLastError;
       CloseHandle(OutPipeInfo.PipeWrite);
       CloseHandle(OutPipeInfo.PipeRead);
       OutPipeInfo.Event.Free;
@@ -2956,31 +3080,52 @@ begin
 
   ResetMemory(StartupInfo, SizeOf(TStartupInfo));
   StartupInfo.cb := SizeOf(TStartupInfo);
-  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
-  StartupInfo.wShowWindow := SW_HIDE;
+  StartupInfo.dwFlags := STARTF_USESTDHANDLES;
+  if Options.StartupVisibility <> svNotSet then
+  begin
+    StartupInfo.dwFlags := StartupInfo.dwFlags or STARTF_USESHOWWINDOW;
+    StartupInfo.wShowWindow := StartupVisibilityFlags[Options.StartupVisibility];
+  end;
   StartupInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
   StartupInfo.hStdOutput := OutPipeInfo.PipeWrite;
-  if MergeError then
+  if Options.MergeError then
     StartupInfo.hStdError := OutPipeInfo.PipeWrite
   else
     StartupInfo.hStdError := ErrorPipeInfo.PipeWrite;
+  CommandLine := Options.CommandLine;
   UniqueString(CommandLine); // CommandLine must be in a writable memory block
   ResetMemory(ProcessInfo, SizeOf(ProcessInfo));
   ProcessEvent := nil;
   try
-    if CreateProcess(nil, PChar(CommandLine), nil, nil, True, ProcessPriorities[ProcessPriority],
+    Flags := Options.CreateProcessFlags and not (NORMAL_PRIORITY_CLASS or IDLE_PRIORITY_CLASS or
+                                                 HIGH_PRIORITY_CLASS or REALTIME_PRIORITY_CLASS);
+    Flags := Flags or ProcessPriorities[Options.ProcessPriority];
+    if Assigned(Options.BeforeResume) then
+      Flags := Flags or CREATE_SUSPENDED;
+
+    if CreateProcess(nil, PChar(CommandLine), nil, nil, True, Flags,
       nil, nil, StartupInfo, ProcessInfo) then
     begin
+      Result := True;
       try
+        try
+          if Assigned(Options.BeforeResume) then
+            Options.BeforeResume(ProcessInfo);
+        finally
+          if Flags and CREATE_SUSPENDED <> 0 then // CREATE_SUSPENDED may also have come from CreateProcessFlags
+            ResumeThread(ProcessInfo.hThread);
+        end;
+
         // init out and error events
         CloseHandle(OutPipeInfo.PipeWrite);
         OutPipeInfo.PipeWrite := 0;
-        if not MergeError then
+        if not Options.MergeError then
         begin
           CloseHandle(ErrorPipeInfo.PipeWrite);
           ErrorPipeInfo.PipeWrite := 0;
         end;
         InternalAbort := False;
+        AbortPtr := Options.AbortPtr;
         if AbortPtr <> nil then
           AbortPtr^ := {$IFDEF FPC}Byte({$ENDIF}False{$IFDEF FPC}){$ENDIF}
         else
@@ -2993,24 +3138,24 @@ begin
         // add the output event
         WaitEvents[1] := OutPipeInfo.Event;
         // add the error event
-        if not MergeError then
+        if not Options.MergeError then
         begin
           SetLength(WaitEvents, 3);
           WaitEvents[2] := ErrorPipeInfo.Event;
         end;
         // add the abort event if any
-        if AbortEvent <> nil then
+        if Options.AbortEvent <> nil then
         begin
-          AbortEvent.ResetEvent;
+          Options.AbortEvent.ResetEvent;
           Index := Length(WaitEvents);
           SetLength(WaitEvents, Index + 1);
-          WaitEvents[Index] := AbortEvent;
+          WaitEvents[Index] := Options.AbortEvent;
         end;
         // init the asynchronous reads
         ResetMemory(OutOverlapped, SizeOf(OutOverlapped));
         OutOverlapped.hEvent := OutPipeInfo.Event.Handle;
         InternalExecuteReadPipe(OutPipeInfo, OutOverlapped);
-        if not MergeError then
+        if not Options.MergeError then
         begin
           ResetMemory(ErrorOverlapped, SizeOf(ErrorOverlapped));
           ErrorOverlapped.hEvent := ErrorPipeInfo.Event.Handle;
@@ -3030,14 +3175,14 @@ begin
             InternalExecuteHandlePipeEvent(OutPipeInfo, OutOverlapped);
           end
           else
-          if (Index = (WAIT_OBJECT_0 + 2)) and not MergeError then
+          if (Index = (WAIT_OBJECT_0 + 2)) and not Options.MergeError then
           begin
             // event on error
             InternalExecuteHandlePipeEvent(ErrorPipeInfo, ErrorOverlapped);
           end
           else
-          if ((Index = (WAIT_OBJECT_0 + 2)) and MergeError) or
-             ((Index = (WAIT_OBJECT_0 + 3)) and not MergeError) then
+          if ((Index = (WAIT_OBJECT_0 + 2)) and Options.MergeError) or
+             ((Index = (WAIT_OBJECT_0 + 3)) and not Options.MergeError) then
             // event on abort
             AbortPtr^ := {$IFDEF FPC}Byte({$ENDIF}True{$IFDEF FPC}){$ENDIF}
           else
@@ -3049,19 +3194,19 @@ begin
         end;
         if {$IFDEF FPC}Boolean({$ENDIF}AbortPtr^{$IFDEF FPC}){$ENDIF} then
           TerminateProcess(ProcessEvent.Handle, Cardinal(ABORT_EXIT_CODE));
-        if (ProcessEvent.WaitForever = {$IFDEF RTL280_UP}TJclWaitResult.{$ENDIF RTL280_UP}wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Result) then
-          Result := $FFFFFFFF;
+        if (ProcessEvent.WaitForever = {$IFDEF RTL280_UP}TJclWaitResult.{$ENDIF RTL280_UP}wrSignaled) and not GetExitCodeProcess(ProcessEvent.Handle, Options.FExitCode) then
+          Options.FExitCode := $FFFFFFFF;
         CloseHandle(ProcessInfo.hThread);
         ProcessInfo.hThread := 0;
         if OutPipeInfo.PipeRead <> 0 then
           // read data remaining in output pipe
           InternalExecuteFlushPipe(OutPipeinfo, OutOverlapped);
-        if not MergeError and (ErrorPipeInfo.PipeRead <> 0) then
+        if not Options.MergeError and (ErrorPipeInfo.PipeRead <> 0) then
           // read data remaining in error pipe
           InternalExecuteFlushPipe(ErrorPipeInfo, ErrorOverlapped);
       except
         // always terminate process in case of an exception.
-        // This is especially useful when an exception occured in one of
+        // This is especially useful when an exception occurred in one of
         // the texthandler but only do it if the process actually started,
         // this prevents eating up the last error value by calling those
         // three functions with an invalid handle
@@ -3072,7 +3217,7 @@ begin
         begin
           TerminateProcess(ProcessInfo.hProcess, Cardinal(ABORT_EXIT_CODE));
           WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
-          GetExitCodeProcess(ProcessInfo.hProcess, Result);
+          GetExitCodeProcess(ProcessInfo.hProcess, Options.FExitCode);
         end;
 
         raise;
@@ -3109,7 +3254,7 @@ var
   Pipe: PIOFile;
   Cmd: string;
 begin
-  Cmd := Format('%s 2>&1', [CommandLine]);
+  Cmd := Format('%s 2>&1', [Options.CommandLine]);
   Pipe := nil;
   try
     Pipe := Libc.popen(PChar(Cmd), 'r');
@@ -3134,20 +3279,52 @@ begin
       // (shouldn't happen, but you never know)
       InternalExecuteProcessLine(OutPipeInfo, Length(OutPipeInfo.Line))
     else
-      if RawOutput then
-        Output := Output + OutPipeInfo.Line
+      if Options.RawOutput then
+        Options.FOutput := OutPipeInfo.Line
       else
-        Output := Output + InternalExecuteMuteCRTerminatedLines(OutPipeInfo.Line);
+        Options.FOutput := InternalExecuteMuteCRTerminatedLines(OutPipeInfo.Line);
   if ErrorPipeInfo.Line <> '' then
     if Assigned(ErrorPipeInfo.TextHandler) then
       // error wasn't terminated by a line feed...
       // (shouldn't happen, but you never know)
       InternalExecuteProcessLine(ErrorPipeInfo, Length(ErrorPipeInfo.Line))
     else
-      if RawError then
-        Error := Error + ErrorPipeInfo.Line
+      if Options.RawError then
+        Options.FError := ErrorPipeInfo.Line
       else
-        Error := Error + InternalExecuteMuteCRTerminatedLines(ErrorPipeInfo.Line);
+        Options.FError := InternalExecuteMuteCRTerminatedLines(ErrorPipeInfo.Line);
+end;
+
+function InternalExecute(CommandLine: string; AbortPtr: PBoolean; AbortEvent: TJclEvent;
+  var Output: string; OutputLineCallback: TTextHandler; RawOutput: Boolean;
+  MergeError: Boolean; var Error: string; ErrorLineCallback: TTextHandler; RawError: Boolean;
+  ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
+var
+  Options: TJclExecuteCmdProcessOptions;
+begin
+  Options := TJclExecuteCmdProcessOptions.Create(CommandLine);
+  try
+    Options.AutoConvertOem := AutoConvertOem;
+
+    Options.AbortPtr := AbortPtr;
+    Options.AbortEvent := AbortEvent;
+    Options.OutputLineCallback := OutputLineCallback;
+    Options.RawOutput := RawOutput;
+    Options.MergeError := MergeError;
+    Options.ErrorLineCallback := ErrorLineCallback;
+    Options.RawError := RawError;
+    Options.ProcessPriority := ProcessPriority;
+
+    ExecuteCmdProcess(Options);
+
+    Result := Options.ExitCode;
+
+    // Append => backward compatiblity
+    Output := Output + Options.Output;
+    Error := Error + Options.Error;
+  finally
+    Options.Free;
+  end;
 end;
 
 { TODO -cHelp :
@@ -3155,20 +3332,23 @@ RawOutput: Do not process isolated carriage returns (#13).
 That is, for RawOutput = False, lines not terminated by a line feed (#10) are deleted from Output. }
 
 function Execute(const CommandLine: string; var Output: string; RawOutput: Boolean;
-  AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority): Cardinal;
+  AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 var
   Error: string;
 begin
   Error := '';
-  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, True, Error, nil, False, ProcessPriority);
+  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, True, Error,
+    nil, False, ProcessPriority, AutoConvertOem);
 end;
 
-function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output: string; RawOutput: Boolean; ProcessPriority: TJclProcessPriority): Cardinal;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output: string; RawOutput: Boolean;
+  ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 var
   Error: string;
 begin
   Error := '';
-  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, True, Error, nil, False, ProcessPriority);
+  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, True, Error,
+    nil, False, ProcessPriority, AutoConvertOem);
 end;
 
 { TODO -cHelp :
@@ -3176,22 +3356,25 @@ Author: Robert Rossmair
 OutputLineCallback called once per line of output. }
 
 function Execute(const CommandLine: string; OutputLineCallback: TTextHandler; RawOutput: Boolean;
-  AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority): Cardinal;
+  AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 var
   Output, Error: string;
 begin
   Output := '';
   Error := '';
-  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, True, Error, nil, False, ProcessPriority);
+  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, True, Error,
+    nil, False, ProcessPriority, AutoConvertOem);
 end;
 
-function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback: TTextHandler; RawOutput: Boolean; ProcessPriority: TJclProcessPriority): Cardinal;
+function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback: TTextHandler; RawOutput: Boolean;
+  ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 var
   Output, Error: string;
 begin
   Output := '';
   Error := '';
-  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, True, Error, nil, False, ProcessPriority);
+  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, True, Error,
+    nil, False, ProcessPriority, AutoConvertOem);
 end;
 
 { TODO -cHelp :
@@ -3199,15 +3382,17 @@ RawOutput: Do not process isolated carriage returns (#13).
 That is, for RawOutput = False, lines not terminated by a line feed (#10) are deleted from Output. }
 
 function Execute(const CommandLine: string; var Output, Error: string; RawOutput, RawError: Boolean;
-  AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority): Cardinal;
+  AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 begin
-  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, False, Error, nil, RawError, ProcessPriority);
+  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, nil, RawOutput, False, Error,
+    nil, RawError, ProcessPriority, AutoConvertOem);
 end;
 
 function Execute(const CommandLine: string; AbortEvent: TJclEvent; var Output, Error: string;
-  RawOutput, RawError: Boolean; ProcessPriority: TJclProcessPriority): Cardinal;
+  RawOutput, RawError: Boolean; ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 begin
-  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, False, Error, nil, RawError, ProcessPriority);
+  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, nil, RawOutput, False, Error,
+    nil, RawError, ProcessPriority, AutoConvertOem);
 end;
 
 { TODO -cHelp :
@@ -3215,23 +3400,25 @@ Author: Robert Rossmair
 OutputLineCallback called once per line of output. }
 
 function Execute(const CommandLine: string; OutputLineCallback, ErrorLineCallback: TTextHandler;
-  RawOutput, RawError: Boolean; AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority): Cardinal;
+  RawOutput, RawError: Boolean; AbortPtr: PBoolean; ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 var
   Output, Error: string;
 begin
   Output := '';
   Error := '';
-  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, False, Error, ErrorLineCallback, RawError, ProcessPriority);
+  Result := InternalExecute(CommandLine, AbortPtr, nil, Output, OutputLineCallback, RawOutput, False, Error,
+    ErrorLineCallback, RawError, ProcessPriority, AutoConvertOem);
 end;
 
 function Execute(const CommandLine: string; AbortEvent: TJclEvent; OutputLineCallback, ErrorLineCallback: TTextHandler;
-  RawOutput, RawError: Boolean; ProcessPriority: TJclProcessPriority): Cardinal;
+  RawOutput, RawError: Boolean; ProcessPriority: TJclProcessPriority; AutoConvertOem: Boolean): Cardinal;
 var
   Output, Error: string;
 begin
   Output := '';
   Error := '';
-  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, False, Error, ErrorLineCallback, RawError, ProcessPriority);
+  Result := InternalExecute(CommandLine, nil, AbortEvent, Output, OutputLineCallback, RawOutput, False, Error,
+    ErrorLineCallback, RawError, ProcessPriority, AutoConvertOem);
 end;
 
 //=== { TJclCommandLineTool } ================================================
@@ -3255,7 +3442,7 @@ var
 begin
   S := PathRemoveSeparator(Path);
   {$IFDEF MSWINDOWS}
-  S := LowerCase(S); // file names are case insensitive
+  S := AnsiLowerCase(S); // file names are case insensitive
   {$ENDIF MSWINDOWS}
   S := Format('-%s%s', [Option, S]);
   // avoid duplicate entries (note that search is case sensitive)
@@ -3885,7 +4072,7 @@ begin
         SL.Free;
       end;
       // Keep the logfile Open when it was opened before and the KeepOpen is active
-      if Not (WasOpen and KeepOpen) then
+      if not (WasOpen and KeepOpen) then
         CloseLog;
     end;
   end;

+ 38 - 13
source/packages/jcl/JclWin32.pas

@@ -202,14 +202,27 @@ type
     ReparseDataLength: Word;
     Reserved: Word;
     case Integer of
-      0: ( // SymbolicLinkReparseBuffer and MountPointReparseBuffer
-        SubstituteNameOffset: Word;
-        SubstituteNameLength: Word;
-        PrintNameOffset: Word;
-        PrintNameLength: Word;
-        PathBuffer: array [0..0] of WCHAR);
-      1: ( // GenericReparseBuffer
-        DataBuffer: array [0..0] of Byte);
+      0: (
+        SymbolicLinkReparseBuffer: record
+          SubstituteNameOffset: Word;
+          SubstituteNameLength: Word;
+          PrintNameOffset: Word;
+          PrintNameLength: Word;
+          Flags: ULONG;
+          PathBuffer: array [0..0] of WCHAR;
+        end);
+      1: (
+        MountPointReparseBuffer: record
+          SubstituteNameOffset: Word;
+          SubstituteNameLength: Word;
+          PrintNameOffset: Word;
+          PrintNameLength: Word;
+          PathBuffer: array [0..0] of WCHAR;
+        end);
+      2: (
+        GenericReparseBuffer: record
+          DataBuffer: array [0..0] of Byte;
+        end);
   end;
   {$EXTERNALSYM REPARSE_DATA_BUFFER}
   REPARSE_DATA_BUFFER = _REPARSE_DATA_BUFFER;
@@ -1138,16 +1151,28 @@ const
   {$EXTERNALSYM IO_REPARSE_TAG_MOUNT_POINT}
   IO_REPARSE_TAG_HSM         = DWORD($C0000004);
   {$EXTERNALSYM IO_REPARSE_TAG_HSM}
+  IO_REPARSE_TAG_DRIVER_EXTENDER = DWORD($80000005);
+  {$EXTERNALSYM IO_REPARSE_TAG_DRIVER_EXTENDER}
+  IO_REPARSE_TAG_HSM2        = DWORD($80000006);
+  {$EXTERNALSYM IO_REPARSE_TAG_HSM2}
   IO_REPARSE_TAG_SIS         = DWORD($80000007);
   {$EXTERNALSYM IO_REPARSE_TAG_SIS}
   IO_REPARSE_TAG_DFS         = DWORD($8000000A);
   {$EXTERNALSYM IO_REPARSE_TAG_DFS}
   IO_REPARSE_TAG_FILTER_MANAGER = DWORD($8000000B);
   {$EXTERNALSYM IO_REPARSE_TAG_FILTER_MANAGER}
+  IO_REPARSE_TAG_SYMLINK     = DWORD($A000000C);
+  {$EXTERNALSYM IO_REPARSE_TAG_SYMLINK}
+  IO_REPARSE_TAG_DFSR        = DWORD($80000012);
+  {$EXTERNALSYM IO_REPARSE_TAG_DFSR}
+  IO_REPARSE_TAG_NFS         = DWORD($80000014);
+  {$EXTERNALSYM IO_REPARSE_TAG_NFS}
+
   IO_COMPLETION_MODIFY_STATE = $0002;
   {$EXTERNALSYM IO_COMPLETION_MODIFY_STATE}
   IO_COMPLETION_ALL_ACCESS   = DWORD(STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3);
   {$EXTERNALSYM IO_COMPLETION_ALL_ACCESS}
+
   DUPLICATE_CLOSE_SOURCE     = $00000001;
   {$EXTERNALSYM DUPLICATE_CLOSE_SOURCE}
   DUPLICATE_SAME_ACCESS      = $00000002;
@@ -1641,7 +1666,7 @@ const
   {$EXTERNALSYM IMAGE_SCN_LNK_NRELOC_OVFL}
   IMAGE_SCN_MEM_DISCARDABLE = $02000000; // Section can be discarded.
   {$EXTERNALSYM IMAGE_SCN_MEM_DISCARDABLE}
-  IMAGE_SCN_MEM_NOT_CACHED  = $04000000; // Section is not cachable.
+  IMAGE_SCN_MEM_NOT_CACHED  = $04000000; // Section is not cacheable.
   {$EXTERNALSYM IMAGE_SCN_MEM_NOT_CACHED}
   IMAGE_SCN_MEM_NOT_PAGED   = $08000000; // Section is not pageable.
   {$EXTERNALSYM IMAGE_SCN_MEM_NOT_PAGED}
@@ -3041,7 +3066,7 @@ I have not had this problem on Windows 98.
 Ray Lischner, author of Delphi in a Nutshell (coming later this year)
 http://www.bardware.com and http://www.tempest-sw.com
 }
-function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall;
+function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall;
 {$EXTERNALSYM CreateMutex}
 
 // alternative conversion for WinNT 4.0 SP6 and later (OSVersionInfoEx instead of OSVersionInfo)
@@ -5804,8 +5829,8 @@ const
   CSIDL_COMMON_MUSIC         = $0035; { All Users\My Music }
   CSIDL_COMMON_PICTURES      = $0036; { All Users\My Pictures }
   CSIDL_COMMON_VIDEO         = $0037; { All Users\My Video }
-  CSIDL_RESOURCES            = $0038; { Resource Direcotry }
-  CSIDL_RESOURCES_LOCALIZED  = $0039; { Localized Resource Direcotry }
+  CSIDL_RESOURCES            = $0038; { Resource Directory }
+  CSIDL_RESOURCES_LOCALIZED  = $0039; { Localized Resource Directory }
   CSIDL_COMMON_OEM_LINKS     = $003A; { Links to All Users OEM specific apps }
   CSIDL_CDBURN_AREA          = $003B; { USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning }
   CSIDL_COMPUTERSNEARME      = $003D; { Computers Near Me (computered from Workgroup membership) }
@@ -8614,7 +8639,7 @@ begin
   Result := _AdjustTokenPrivileges(TokenHandle, DisableAllPrivileges, NewState, BufferLength, PreviousState, ReturnLength);
 end;
 
-function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: DWORD; lpName: PChar): THandle; stdcall;
+function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PChar): THandle; stdcall;
   external kernel32 name 'CreateMutex' + AWSuffix;
 
 function GetVersionEx(var lpVersionInformation: TOSVersionInfoEx): BOOL; stdcall;

+ 1 - 1
source/packages/jcl/crossplatform.inc

@@ -11,7 +11,7 @@
 {  The Original Code is: crossplatform.inc, released on 2004-05-16.                                }
 {                                                                                                  }
 {  You may retrieve the latest version of this file at the JCL home page,                          }
-{  located at http://jcl.sourceforge.net/                                                          }
+{  located at https://github.com/project-jedi/jcl                                                  }
 {                                                                                                  }
 {**************************************************************************************************}
 {                                                                                                  }

+ 108 - 0
source/packages/jcl/jcl.inc

@@ -339,6 +339,114 @@ ALERT_jedi_inc_incompatible
       {$ENDIF MSWINDOWS}
     {$ENDIF BDS17}
     {----------------------------}
+    {$IFDEF BDS18}
+      {$IFDEF MSWINDOWS}
+      {$IFDEF CPUX86}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld24win32.inc}
+      {$ENDIF CPUX86}
+      {$IFDEF CPUX64}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld24win64.inc}
+      {$ENDIF CPUX64}
+      {$DEFINE JCL_CONFIGURED}
+      {$ENDIF MSWINDOWS}
+    {$ENDIF BDS18}
+    {----------------------------}
+    {$IFDEF BDS19}
+      {$IFDEF MSWINDOWS}
+      {$IFDEF CPUX86}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld25win32.inc}
+      {$ENDIF CPUX86}
+      {$IFDEF CPUX64}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld25win64.inc}
+      {$ENDIF CPUX64}
+      {$DEFINE JCL_CONFIGURED}
+      {$ENDIF MSWINDOWS}
+    {$ENDIF BDS19}
+    {----------------------------}
+    {$IFDEF BDS20}
+      {$IFDEF MSWINDOWS}
+      {$IFDEF CPUX86}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld26win32.inc}
+      {$ENDIF CPUX86}
+      {$IFDEF CPUX64}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld26win64.inc}
+      {$ENDIF CPUX64}
+      {$DEFINE JCL_CONFIGURED}
+      {$ENDIF MSWINDOWS}
+    {$ENDIF BDS20}
+    {----------------------------}
+    {$IFDEF BDS21}
+      {$IFDEF MSWINDOWS}
+      {$IFDEF CPUX86}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld27win32.inc}
+      {$ENDIF CPUX86}
+      {$IFDEF CPUX64}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld27win64.inc}
+      {$ENDIF CPUX64}
+      {$DEFINE JCL_CONFIGURED}
+      {$ENDIF MSWINDOWS}
+    {$ENDIF BDS21}
+    {----------------------------}
+    {$IFDEF BDS22}
+      {$IFDEF MSWINDOWS}
+      {$IFDEF CPUX86}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld28win32.inc}
+      {$ENDIF CPUX86}
+      {$IFDEF CPUX64}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld28win64.inc}
+      {$ENDIF CPUX64}
+      {$DEFINE JCL_CONFIGURED}
+      {$ENDIF MSWINDOWS}
+    {$ENDIF BDS22}
+    {----------------------------}
+    {$IFDEF BDS23}
+      {$IFDEF MSWINDOWS}
+      {$IFDEF CPUX86}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld29win32.inc}
+      {$ENDIF CPUX86}
+      {$IFDEF CPUX64}
+      // This file should be located in directory jcl/source/include
+      // It is automatically created by the JCL installer
+      // For manual installations, copy and adjust jcl/source/include/jcl.template.inc
+      {$I jcld29win64.inc}
+      {$ENDIF CPUX64}
+      {$DEFINE JCL_CONFIGURED}
+      {$ENDIF MSWINDOWS}
+    {$ENDIF BDS23}
+    {----------------------------}
     {$IFDEF FPC}
       // This file should be located in directory jcl/source/include
       // It is automatically created by the JCL installer

文件差異過大導致無法顯示
+ 614 - 101
source/packages/jcl/jedi.inc


+ 1 - 1
source/packages/jcl/windowsonly.inc

@@ -14,7 +14,7 @@
 {  The Original Code is: windowsonly.inc, released on 2002-07-04.                                  }
 {                                                                                                  }
 {  You may retrieve the latest version of this file at the JCL home page,                          }
-{  located at http://jcl.sourceforge.net/                                                          }
+{  located at https://github.com/project-jedi/jcl                                                  }
 {                                                                                                  }
 {**************************************************************************************************}
 {                                                                                                  }

部分文件因文件數量過多而無法顯示