View Issue Details

IDProjectCategoryView StatusLast Update
0029136FPCFCLpublic2016-01-05 15:18
ReporterMattias Gaertner Assigned ToFlorian  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version3.1.1 
Fixed in Version3.1.1 
Summary0029136: TProcess does not support Unicode on Windows (patch)
DescriptionTProcess on Windows calls CreateProcess instead of CreateProcessW.

Attached patch changes this.
TagsNo tags attached.
Fixed in Revision32856
FPCOldBugId0
FPCTarget
Attached Files

Activities

Max Nazhalov

2015-12-05 13:49

reporter   ~0087799

I'm not sure about WStrAsUniquePWideChar. Typecast don't bump reference count, AFIR. Doesn't unique "s" got freed on return? This would leave the function result pointing to invalid (but probably still holding expected data) memory location..

Mattias Gaertner

2015-12-05 15:06

manager  

windows_createprocessw.patch (4,343 bytes)   
Index: packages/fcl-process/src/win/process.inc
===================================================================
--- packages/fcl-process/src/win/process.inc	(revision 32584)
+++ packages/fcl-process/src/win/process.inc	(working copy)
@@ -68,7 +68,7 @@
 begin
   With P do
     begin
-    Result:=0;
+    Result:=CREATE_UNICODE_ENVIRONMENT;
     if poNoConsole in FProcessOptions then
       Result:=Result or Detached_Process;
     if poNewConsole in FProcessOptions then
@@ -87,10 +87,19 @@
     end;
 end;
 
-Function StringsToPChars(List : TStrings): pointer;
+function WStrAsUniquePWideChar(var s: UnicodeString): PWideChar;
+begin
+  UniqueString(s);
+  if s<>'' then
+    Result:=PWideChar(s)
+  else
+    Result:=nil;
+end;
 
+Function StringsToWChars(List : TStrings): pointer;
+
 var
-  EnvBlock: string;
+  EnvBlock: UnicodeString;
   I: Integer;
 
 begin
@@ -98,8 +107,8 @@
   For I:=0 to List.Count-1 do
     EnvBlock := EnvBlock + List[i] + #0;
   EnvBlock := EnvBlock + #0;
-  GetMem(Result, Length(EnvBlock));
-  CopyMemory(Result, @EnvBlock[1], Length(EnvBlock));
+  GetMem(Result, Length(EnvBlock)*2);
+  CopyMemory(Result, @EnvBlock[1], Length(EnvBlock)*2);
 end;
 
 Procedure InitProcessAttributes(P : TProcess; Var PA : TSecurityAttributes);
@@ -116,7 +125,7 @@
   TA.nLength := SizeOf(TA);
 end;
 
-Procedure InitStartupInfo(P : TProcess; Var SI : STARTUPINFOA);
+Procedure InitStartupInfo(P : TProcess; Var SI : STARTUPINFOW);
 
 Const
   SWC : Array [TShowWindowOptions] of Cardinal =
@@ -179,7 +188,7 @@
 end;
 
 
-Procedure CreatePipes(Var HI,HO,HE : Thandle; Var SI : TStartupInfoA; CE : Boolean; APipeBufferSize : Cardinal);
+Procedure CreatePipes(Var HI,HO,HE : Thandle; Var SI : TStartupInfoW; CE : Boolean; APipeBufferSize : Cardinal);
 
 begin
   CreatePipeHandles(SI.hStdInput,HI, APipeBufferSize);
@@ -218,41 +227,42 @@
 Procedure TProcess.Execute;
 Var
   i : Integer;
-  PName,PDir,PCommandLine : PChar;
+  WName,WDir,WCommandLine : UnicodeString;
+  PWName,PWDir,PWCommandLine : PWideChar;
   FEnv: pointer;
   FCreationFlags : Cardinal;
   FProcessAttributes : TSecurityAttributes;
   FThreadAttributes : TSecurityAttributes;
   FProcessInformation : TProcessInformation;
-  FStartupInfo : STARTUPINFOA;
+  FStartupInfo : STARTUPINFOW;
   HI,HO,HE : THandle;
   Cmd : String;
   
 begin
-  PName:=Nil;
-  PCommandLine:=Nil;
-  PDir:=Nil;
-    
+  WName:='';
+  WCommandLine:='';
+  WDir:='';
+
   if (FApplicationName='') and (FCommandLine='') and (FExecutable='') then
     Raise EProcess.Create(SNoCommandline);
   if (FApplicationName<>'') then
     begin
-    PName:=Pchar(FApplicationName);
-    PCommandLine:=Pchar(FCommandLine);
+    WName:=FApplicationName;
+    WCommandLine:=FCommandLine;
     end
   else If (FCommandLine<>'') then
-    PCommandLine:=Pchar(FCommandLine)
-  else if (Fexecutable<>'') then
+    WCommandLine:=FCommandLine
+  else if (FExecutable<>'') then
     begin
     Cmd:=MaybeQuoteIfNotQuoted(Executable);
     For I:=0 to Parameters.Count-1 do
       Cmd:=Cmd+' '+MaybeQuoteIfNotQuoted(Parameters[i]);
-    PCommandLine:=PChar(Cmd);
+    WCommandLine:=Cmd;
     end;
   If FCurrentDirectory<>'' then
-    PDir:=Pchar(FCurrentDirectory);
+    WDir:=FCurrentDirectory;
   if FEnvironment.Count<>0 then
-    FEnv:=StringsToPChars(FEnvironment)
+    FEnv:=StringsToWChars(FEnvironment)
   else
     FEnv:=Nil;
   Try
@@ -263,8 +273,13 @@
     If poUsePipes in FProcessOptions then
       CreatePipes(HI,HO,HE,FStartupInfo,Not(poStdErrToOutPut in FProcessOptions), FPipeBufferSize);
     Try
-      If Not CreateProcess (PName,PCommandLine,@FProcessAttributes,@FThreadAttributes,
-                   FInheritHandles,FCreationFlags,FEnv,PDir,FStartupInfo,
+      // Beware: CreateProcess can alter the strings
+      // Beware: nil is not the same as a pointer to a #0
+      PWName:=WStrAsUniquePWideChar(WName);
+      PWCommandLine:=WStrAsUniquePWideChar(WCommandLine);
+      PWDir:=WStrAsUniquePWideChar(WDir);
+      If Not CreateProcessW (PWName,PWCommandLine,@FProcessAttributes,@FThreadAttributes,
+                   FInheritHandles,FCreationFlags,FEnv,PWDir,FStartupInfo,
                    fProcessInformation) then
         Raise EProcess.CreateFmt(SErrCannotExecute,[FCommandLine,GetLastError]);
       FProcessHandle:=FProcessInformation.hProcess;
windows_createprocessw.patch (4,343 bytes)   

Mattias Gaertner

2015-12-05 15:06

manager   ~0087800

You are right. The parameter should be 'var'. Uploaded a new patch.

Marco van de Voort

2015-12-05 18:44

manager   ~0087804

This doesn't allow unicode to be used since there is no unicode type (rawbytestring or unicodestring) in the interface?

Mattias Gaertner

2015-12-05 19:15

manager   ~0087805

It works with UTF8 and is a first step for the future UTF-16 version of TProcess.

Florian

2016-01-05 15:06

administrator   ~0088658

Thanks, applied.

Issue History

Date Modified Username Field Change
2015-12-05 00:53 Mattias Gaertner New Issue
2015-12-05 00:53 Mattias Gaertner File Added: windows_createprocessw.patch
2015-12-05 13:49 Max Nazhalov Note Added: 0087799
2015-12-05 15:06 Mattias Gaertner File Deleted: windows_createprocessw.patch
2015-12-05 15:06 Mattias Gaertner File Added: windows_createprocessw.patch
2015-12-05 15:06 Mattias Gaertner Note Added: 0087800
2015-12-05 18:44 Marco van de Voort Note Added: 0087804
2015-12-05 19:15 Mattias Gaertner Note Added: 0087805
2016-01-05 15:06 Florian Fixed in Revision => 32856
2016-01-05 15:06 Florian Note Added: 0088658
2016-01-05 15:06 Florian Status new => resolved
2016-01-05 15:06 Florian Fixed in Version => 3.1.1
2016-01-05 15:06 Florian Resolution open => fixed
2016-01-05 15:06 Florian Assigned To => Florian
2016-01-05 15:18 Mattias Gaertner Status resolved => closed