Added: Vista support for X2UtOS

Added: X2UtProcess unit
Changed: on-demand loading for App.Version (optimization for creating multiple instances in multi-threaded situations)
Fixed: revert BeginSection calls in X2UtPersist on failure
Fixed: use BoolToStr instead of ReadInteger for boolean registry values

X2UtApp.pas

@@ -136,6 +136,7 @@ type
     property Strings:         TX2AppVersionStrings  read FStrings;
   end;
 
+
   TX2App  = class(TObject)
   private
     FVersion:         TX2AppVersion;
@@ -143,6 +144,8 @@ type
     FPath:            String;
     FMainPath:        String;
     FUserPath:        String;
+
+    function GetVersion(): TX2AppVersion;
   protected
     function GetModule(const AModule: THandle): String; virtual;
     procedure GetPath(); virtual;
@@ -181,7 +184,7 @@ type
     property UserPath:  String          read FUserPath;
 
     //:$ Contains the application's version information
-    property Version:   TX2AppVersion   read FVersion;
+    property Version:   TX2AppVersion   read GetVersion;
   end;
 
   //:$ Returns a singleton App object
@@ -379,7 +382,6 @@ begin
   inherited;
 
   GetPath();
-  FVersion  := TX2AppVersion.Create(FFileName);
 end;
 
 destructor TX2App.Destroy();
@@ -435,6 +437,15 @@ begin
 end;
 
 
+function TX2App.GetVersion(): TX2AppVersion;
+begin
+  if not Assigned(FVersion) then
+    FVersion  := TX2AppVersion.Create(FFileName);
+
+  Result  := FVersion;
+end;
+
+
 {================================= TX2App
   Version
 ========================================}

X2UtOS.pas

@@ -16,7 +16,7 @@ uses
 type
   //:$ Enumeration of the recognized Operating System versions
   TX2OSVersion  = (osWin95, osWin98, osWinME, osWinNT3, osWinNT4,
-                   osWin2K, osWinXP, osWin2003, osUnknown);
+                   osWin2K, osWinXP, osWin2003, osWinVista, osUnknown);
 
   //:$ Record to hold the Common Controls version
   TX2CCVersion  = record
@@ -151,42 +151,44 @@ var
 begin
   FVersion  := osUnknown;
 
-  // Get version information
+  { Get version information }
   pVersion.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
   GetVersionEx(pVersion);
 
-  with FVersionEx do begin
-    // No Kylix support yet, sorry!
+  with FVersionEx do
+  begin
+    { No Kylix support yet, sorry! }
     RawInfo := pVersion;
     Name    := 'Windows';
 
-    // Analyze version
     case pVersion.dwMajorVersion of
-      3:      // Windows NT 3.51
+      3:      { Windows NT 3.51 }
         FVersion  := osWinNT3;
-      4:      // Windows 95/98/ME/NT 4
+      4:      { Windows 95/98/ME/NT 4 }
         case pVersion.dwMinorVersion of
-          0:  // Windows 95/NT 4
+          0:  { Windows 95/NT 4 }
             case pVersion.dwPlatformId of
-              VER_PLATFORM_WIN32_NT:        // Windows NT 4
+              VER_PLATFORM_WIN32_NT:        { Windows NT 4 }
                 FVersion  := osWinNT4;
-              VER_PLATFORM_WIN32_WINDOWS:   // Windows 95
+              VER_PLATFORM_WIN32_WINDOWS:   { Windows 95 }
                 FVersion  := osWin95;
             end;
-          10: // Windows 98
+          10: { Windows 98 }
             FVersion  := osWin98;
-          90: // Windows ME
+          90: { Windows ME }
             FVersion  := osWinME;
         end;
-      5:      // Windows 2000/XP/2003
+      5:      { Windows 2000/XP/2003 }
         case pVersion.dwMinorVersion of
-          0:  // Windows 2000
+          0:  { Windows 2000 }
             FVersion  := osWin2K;
-          1:  // Windows XP
+          1:  { Windows XP }
             FVersion  := osWinXP;
-          2:  // Windows Server 2003
+          2:  { Windows Server 2003 }
             FVersion  := osWin2003;
         end;
+      6:      { Windows Vista/Server 2008 }
+        FVersion  := osWinVista;
     end;
 
     case Version of
@@ -198,6 +200,7 @@ begin
       osWin2K:      VersionString := '2000';
       osWinXP:      VersionString := 'XP';
       osWin2003:    VersionString := 'Server 2003';
+      osWinVista:   VersionString := 'Vista';
       osUnknown:    VersionString := Format('%d.%d', [pVersion.dwMajorVersion,
                                                       pVersion.dwMinorVersion]);
     end;

X2UtPersist.pas

@@ -608,17 +608,32 @@ constructor TX2PersistSectionFilerProxy.Create(const AFiler: IX2PersistFiler; co
 var
   sections:       TSplitArray;
   sectionIndex:   Integer;
+  undoIndex:      Integer;
 
 begin
   inherited Create();
 
-  FFiler  := AFiler;
+  FFiler    := AFiler;
 
   Split(ASection, SectionSeparator, sections);
-  FSectionCount := Length(sections);
+  FSectionCount := 0;
 
   for sectionIndex := Low(sections) to High(sections) do
-    Filer.BeginSection(sections[sectionIndex]);
+  begin
+    if Length(sections[sectionIndex]) > 0 then
+    begin
+      if not Filer.BeginSection(sections[sectionIndex]) then
+      begin
+        { Undo all sections so far }
+        for undoIndex := 0 to Pred(SectionCount) do
+          Filer.EndSection();
+
+        FFiler  := nil;
+        Break;
+      end else
+        Inc(FSectionCount);
+    end;
+  end;
 end;
 
 
@@ -627,8 +642,9 @@ var
   sectionIndex:     Integer;
 
 begin
-  for sectionIndex := 0 to Pred(SectionCount) do
-    Filer.EndSection();
+  if Assigned(Filer) then
+    for sectionIndex := 0 to Pred(SectionCount) do
+      Filer.EndSection();
 
   inherited;
 end;
@@ -639,134 +655,177 @@ var
   filerInterface:   IInterface;
 
 begin
-  { Only return interfaces supported by the filer
-    - see TX2CustomPersistFiler.QueryInterface }
-  if Filer.QueryInterface(IID, filerInterface) = S_OK then
-    { ...but always return the proxy version of the interface to prevent
-         issues with reference counting. }
-    Result  := inherited QueryInterface(IID, Obj)
-  else
-    Result  := E_NOINTERFACE;
+  if Assigned(Filer) then
+  begin
+    { Only return interfaces supported by the filer
+      - see TX2CustomPersistFiler.QueryInterface }
+    if Filer.QueryInterface(IID, filerInterface) = S_OK then
+      { ...but always return the proxy version of the interface to prevent
+           issues with reference counting. }
+      Result  := inherited QueryInterface(IID, Obj)
+    else
+      Result  := E_NOINTERFACE;
+  end else
+    Result  := inherited QueryInterface(IID, Obj);
 end;
 
 
 function TX2PersistSectionFilerProxy.BeginSection(const AName: String): Boolean;
 begin
-  Result  := Filer.BeginSection(AName);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := Filer.BeginSection(AName);
 end;
 
 
 procedure TX2PersistSectionFilerProxy.EndSection();
 begin
-  Filer.EndSection();
+  if Assigned(Filer) then
+    Filer.EndSection();
 end;
 
 
 procedure TX2PersistSectionFilerProxy.GetKeys(const ADest: TStrings);
 begin
-  Filer.GetKeys(ADest);
+  if Assigned(Filer) then
+    Filer.GetKeys(ADest);
 end;
 
 
 procedure TX2PersistSectionFilerProxy.GetSections(const ADest: TStrings);
 begin
-  Filer.GetSections(ADest);
+  if Assigned(Filer) then
+    Filer.GetSections(ADest);
 end;
 
 
 function TX2PersistSectionFilerProxy.Read(AObject: TObject): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).Read(AObject);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).Read(AObject);
 end;
 
 
 function TX2PersistSectionFilerProxy.ReadBoolean(const AName: string; out AValue: Boolean): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).ReadBoolean(AName, AValue);
+  Result  := False;
+  AValue  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).ReadBoolean(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.ReadInteger(const AName: String; out AValue: Integer): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).ReadInteger(AName, AValue);
+  Result  := False;
+  AValue  := 0;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).ReadInteger(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.ReadFloat(const AName: String; out AValue: Extended): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).ReadFloat(AName, AValue);
+  Result  := False;
+  AValue  := 0;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).ReadFloat(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.ReadString(const AName: String; out AValue: String): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).ReadString(AName, AValue);
+  Result  := False;
+  AValue  := '';
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).ReadString(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.ReadInt64(const AName: String; out AValue: Int64): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).ReadInt64(AName, AValue);
+  Result  := False;
+  AValue  := 0;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).ReadInt64(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.ReadStream(const AName: String; AStream: TStream): Boolean;
 begin
-  Result  := (Filer as IX2PersistReader).ReadStream(AName, AStream);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistReader).ReadStream(AName, AStream);
 end;
 
 
 procedure TX2PersistSectionFilerProxy.Write(AObject: TObject);
 begin
-  (Filer as IX2PersistWriter).Write(AObject);
+  if Assigned(Filer) then
+    (Filer as IX2PersistWriter).Write(AObject);
 end;
 
 
 function TX2PersistSectionFilerProxy.WriteBoolean(const AName: String; AValue: Boolean): Boolean;
 begin
-  Result  := (Filer as IX2PersistWriter).WriteBoolean(AName, AValue);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistWriter).WriteBoolean(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.WriteInteger(const AName: String; AValue: Integer): Boolean;
 begin
-  Result  := (Filer as IX2PersistWriter).WriteInteger(AName, AValue);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistWriter).WriteInteger(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.WriteFloat(const AName: String; AValue: Extended): Boolean;
 begin
-  Result  := (Filer as IX2PersistWriter).WriteFloat(AName, AValue);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistWriter).WriteFloat(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.WriteString(const AName, AValue: String): Boolean;
 begin
-  Result  := (Filer as IX2PersistWriter).WriteString(AName, AValue);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistWriter).WriteString(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.WriteInt64(const AName: String; AValue: Int64): Boolean;
 begin
-  Result  := (Filer as IX2PersistWriter).WriteInt64(AName, AValue);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistWriter).WriteInt64(AName, AValue);
 end;
 
 
 function TX2PersistSectionFilerProxy.WriteStream(const AName: String; AStream: TStream): Boolean;
 begin
-  Result  := (Filer as IX2PersistWriter).WriteStream(AName, AStream);
+  Result  := False;
+  if Assigned(Filer) then
+    Result  := (Filer as IX2PersistWriter).WriteStream(AName, AStream);
 end;
 
 
 procedure TX2PersistSectionFilerProxy.DeleteKey(const AName: String);
 begin
-  (Filer as IX2PersistWriter).DeleteKey(AName);
+  if Assigned(Filer) then
+    (Filer as IX2PersistWriter).DeleteKey(AName);
 end;
 
 
 procedure TX2PersistSectionFilerProxy.DeleteSection(const AName: String);
 begin
-  (Filer as IX2PersistWriter).DeleteSection(AName);
+  if Assigned(Filer) then
+    (Filer as IX2PersistWriter).DeleteSection(AName);
 end;
 
 end.

X2UtPersistRegistry.pas

@@ -269,7 +269,7 @@ begin
   begin
     { Required for conversion of integer-based booleans }
     if Registry.GetDataType(AName) = rdInteger then
-      AValue  := IntToStr(Registry.ReadInteger(AName))
+      AValue  := BoolToStr(Registry.ReadBool(AName), True)
     else
       AValue  := Registry.ReadString(AName);
   end;

X2UtProcess.pas

@@ -0,0 +1,190 @@
+unit X2UtProcess;
+
+interface
+uses
+  Classes,
+  Windows;
+
+type
+  TProcess = class(TObject)
+  private
+    FEnvironment:       TStrings;
+    FCommandLine:       String;
+    FWorkingPath:       String;
+  protected
+    function BuildEnvironment(): String;
+  public
+    constructor Create();
+    destructor Destroy(); override;
+
+    function Execute(const AStream: TStream; out AExitCode: Cardinal): Boolean; overload;
+    function Execute(const AStream: TStream): Boolean; overload;
+
+    function Execute(out AExitCode: Cardinal): String; overload;
+    function Execute(): String; overload;
+
+    property CommandLine:   String    read FCommandLine write FCommandLine;
+    property Environment:   TStrings  read FEnvironment;
+    property WorkingPath:   String    read FWorkingPath write FWorkingPath;
+  end;
+
+
+implementation
+uses
+  SysUtils;
+
+
+{ TProcess }
+constructor TProcess.Create();
+begin
+  inherited;
+
+  FEnvironment  := TStringList.Create();
+  FWorkingPath  := GetCurrentDir();
+end;
+
+destructor TProcess.Destroy();
+begin
+  FreeAndNil(FEnvironment);
+
+  inherited;
+end;
+
+
+function TProcess.BuildEnvironment(): String;
+var
+  charPos: Integer;
+  resultLength: Integer;
+  value: String;
+  valueIndex: Integer;
+
+begin
+  if FEnvironment.Count = 0 then
+  begin
+    Result := '';
+    exit;
+  end;
+
+  resultLength := 1;
+  for valueIndex := 0 to Pred(FEnvironment.Count) do
+    Inc(resultLength, Length(FEnvironment[valueIndex]));
+
+  Result  := StringOfChar(#0, resultLength);
+  charPos := 1;
+
+  for valueIndex := 0 to Pred(FEnvironment.Count) do
+  begin
+    value := FEnvironment[valueIndex];
+
+    if Length(value) > 0 then
+      Move(value[1], Result[charPos], Length(value));
+
+    Inc(charPos, Succ(Length(value)));
+  end;
+end;
+
+
+function TProcess.Execute(const AStream: TStream;
+                          out AExitCode: Cardinal): Boolean;
+  function NilString(const AValue: String): PChar;
+  begin
+    Result := nil;
+    if Length(AValue) > 0 then
+      Result := PChar(AValue);
+  end;
+
+const
+  BufferSize  = 2048;
+
+var
+  buffer: PChar;
+  processInfo: TProcessInformation;
+  readPipe: Cardinal;
+  securityAttr: TSecurityAttributes;
+  startupInfo: TStartupInfo;
+  writePipe: Cardinal;
+  bytesRead: Cardinal;
+
+begin
+  Result := False;
+
+  FillChar(processInfo, SizeOf(TProcessInformation), #0);
+  FillChar(startupInfo, SizeOf(TStartupInfo), #0);
+  FillChar(securityAttr, SizeOf(TSecurityAttributes), #0);
+
+  securityAttr.nLength              := SizeOf(TSecurityAttributes);
+  securityAttr.lpSecurityDescriptor := nil;
+  securityAttr.bInheritHandle       := True;
+
+  if CreatePipe(readPipe, writePipe, @securityAttr, 0) then
+  try
+    SetHandleInformation(readPipe, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT);
+
+    startupInfo.cb          := SizeOf(TStartupInfo);
+    startupInfo.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
+    startupInfo.wShowWindow := SW_HIDE;
+    startupInfo.hStdOutput  := writePipe;
+    startupInfo.hStdError   := writePipe;
+
+    if CreateProcess(nil, NilString(FCommandLine), nil, nil, True, 0,
+                     NilString(BuildEnvironment()), NilString(FWorkingPath),
+                     startupInfo, processInfo) then
+    begin
+      CloseHandle(writePipe);
+      writePipe  := 0;
+
+      GetMem(buffer, BufferSize);
+      try
+        repeat
+          ReadFile(readPipe, buffer^, BufferSize, bytesRead, nil);
+          if bytesRead > 0 then
+            AStream.WriteBuffer(buffer^, bytesRead);
+        until bytesRead = 0;
+      finally
+        FreeMem(buffer, BufferSize);
+      end;
+
+      GetExitCodeProcess(processInfo.hProcess, AExitCode);
+      Result := True;
+    end else
+      RaiseLastOSError();
+  finally
+    CloseHandle(readPipe);
+    if writePipe <> 0 then
+      CloseHandle(writePipe);
+  end;
+end;
+
+function TProcess.Execute(const AStream: TStream): Boolean;
+var
+  exitCode: Cardinal;
+
+begin
+  Result := Execute(AStream, exitCode);
+end;
+
+
+function TProcess.Execute(out AExitCode: Cardinal): String;
+var
+  resultStream: TStringStream;
+
+begin
+  Result        := '';
+  resultStream  := TStringStream.Create('');
+  try
+    if Execute(resultStream, AExitCode) then
+      Result    := resultStream.DataString;
+  finally
+    FreeAndNil(resultStream);
+  end;
+end;
+
+function TProcess.Execute(): String;
+var
+  exitCode: Cardinal;
+
+begin
+  Result := Execute(exitCode);
+end;
+
+end.

X2UtSingleInstance.pas

@@ -525,7 +525,7 @@ var
 
 begin
   with Instance do
-begin
+  begin
     ApplicationID := AApplicationID;
     Global        := AGlobal;
     Active        := True;