* Windows: Reworked handling of command line arguments to properly support Unicode:

  - Use the CommandLineToArgvW API function to parse the Unicode command line (we can use it since Win9x is not supported anymore).
  - Implemented non-public functions ParamStrA and ParamStrU which are exposed in the objpas and uuchar units to provide correct AnsiString and UnicodeString versions of ParamStr(). 
  - The cleanup code is moved from InternalExit to the finalization section of the System unit.

git-svn-id: trunk@45037 -

rtl/inc/system.inc

@@ -1154,7 +1154,7 @@ Begin
   { Finalize units }
   FinalizeUnits;
 
-{$if (defined(MSWINDOWS) and not defined(win16)) or defined(OS2)}
+{$if defined(OS2)}
   { finally release the heap if possible, especially
     important for DLLs.
     Reset the array to nil, and finally also argv itself to

rtl/inc/uuchar.pp

@@ -23,7 +23,12 @@ interface
 
 
 {$ifdef FPC_HAS_FEATURE_COMMANDARGS}
+{$ifdef MSWINDOWS}
+  {$define HAS_PARAMSTRU}
+  {$undef FPC_HAS_FEATURE_COMMANDARGS} // Skip the implementation of ParamStr()
+{$endif MSWINDOWS}
 Function ParamStr(Param: Longint): UnicodeString;
+  {$ifdef HAS_PARAMSTRU} external name '_FPC_ParamStrU'; {$endif}
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
 implementation

rtl/objpas/objpas.pp

@@ -144,8 +144,13 @@ Var
 {$endif FPC_HAS_FEATURE_FILEIO}
 
 {$ifdef FPC_HAS_FEATURE_COMMANDARGS}
+{$ifdef MSWINDOWS}
+  {$define HAS_PARAMSTRA}
+  {$undef FPC_HAS_FEATURE_COMMANDARGS} // Skip the implementation of ParamStr()
+{$endif MSWINDOWS}
      { ParamStr should return also an ansistring }
      Function ParamStr(Param : Integer) : Ansistring;
+       {$ifdef HAS_PARAMSTRA} external name '_FPC_ParamStrA'; {$endif}
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
 {****************************************************************************

rtl/win/sysos.inc

@@ -246,15 +246,14 @@ type
    function GetStdHandle(nStdHandle:DWORD):THANDLE;
      stdcall;external KernelDLL name 'GetStdHandle';
 
-   {$ifdef FPC_UNICODE_RTLx}
    { command line/environment functions }
 
-   function GetCommandLine : pwidechar;
+  function GetCommandLineW : pwidechar;
      stdcall;external KernelDLL name 'GetCommandLineW';
-   {$else}
-   function GetCommandLine : pchar;
+  function GetCommandLineA : pansichar;
      stdcall;external KernelDLL name 'GetCommandLineA';
-   {$endif}
+  function CommandLineToArgvW(lpCmdLine: PWideChar; out pNumArgs: longint): PPWideChar;
+     stdcall; external 'shell32.dll' name 'CommandLineToArgvW';
 
   function GetCurrentProcessId:DWORD;
     stdcall; external KernelDLL name 'GetCurrentProcessId';
@@ -269,8 +268,8 @@ type
     stdcall;external 'kernel32' name 'ReadProcessMemory';
 
   { module functions }
-  function GetModuleFileName(l1:THandle;p:PChar;l2:longint):longint;
-    stdcall;external KernelDLL name 'GetModuleFileNameA';
+  function GetModuleFileNameW(l1:THandle;p:PWideChar;l2:longint):longint;
+    stdcall;external KernelDLL name 'GetModuleFileNameW';
 
   function GetModuleHandle(p : PChar) : THandle;
     stdcall;external KernelDLL name 'GetModuleHandleA';
@@ -359,6 +358,8 @@ type
      stdcall; external 'oleaut32.dll' name 'SysFreeString';
    function SysReAllocStringLen(var bstr:pointer;psz: pointer;
      len:dword): Integer; stdcall;external 'oleaut32.dll' name 'SysReAllocStringLen';
+   function GlobalFree(hMem: pointer): pointer;
+     stdcall; external KernelDLL name 'GlobalFree';
 {$endif WINCE}
 
    Procedure Errno2InOutRes(oserror: longword);

rtl/win/syswin.inc

@@ -217,155 +217,87 @@ begin
   end;
 end;
 
-  {*****************************************************************************
-                                Parameter Handling
-  *****************************************************************************}
+{*****************************************************************************
+                              Parameter Handling
+*****************************************************************************}
 
-  procedure setup_arguments;
-  var
-    arglen,
-    count   : longint;
-    argstart,
-    pc,arg  : pchar;
-    quote   : Boolean;
-    argvlen : longint;
-    buf: array[0..259] of char;  // need MAX_PATH bytes, not 256!
-
-    procedure allocarg(idx,len:longint);
-      var
-        oldargvlen : longint;
-      begin
-        if idx>=argvlen then
-         begin
-           oldargvlen:=argvlen;
-           argvlen:=(idx+8) and (not 7);
-           sysreallocmem(argv,argvlen*sizeof(pointer));
-           fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
-         end;
-        { use realloc to reuse already existing memory }
-        { always allocate, even if length is zero, since }
-        { the arg. is still present!                     }
-        sysreallocmem(argv[idx],len+1);
-      end;
-
-  begin
-    { create commandline, it starts with the executed filename which is argv[0] }
-    { Win32 passes the command NOT via the args, but via getmodulefilename}
-    count:=0;
-    argv:=nil;
-    argvlen:=0;
-    ArgLen := GetModuleFileName(0, @buf[0], sizeof(buf));
-    buf[ArgLen] := #0; // be safe
-    allocarg(0,arglen);
-    move(buf,argv[0]^,arglen+1);
-    { Setup cmdline variable }
-    cmdline:=GetCommandLine;
-    { process arguments }
-    pc:=cmdline;
-  {$IfDef SYSTEM_DEBUG_STARTUP}
-    Writeln(stderr,'Win32 GetCommandLine is #',pc,'#');
-  {$EndIf }
-    while pc^<>#0 do
-     begin
-       { skip leading spaces }
-       while pc^ in [#1..#32] do
-        inc(pc);
-       if pc^=#0 then
-        break;
-       { calc argument length }
-       quote:=False;
-       argstart:=pc;
-       arglen:=0;
-       while (pc^<>#0) do
-        begin
-          case pc^ of
-            #1..#32 :
-              begin
-                if quote then
-                 inc(arglen)
-                else
-                 break;
-              end;
-            '"' :
-              if pc[1]<>'"' then
-                quote := not quote
-                else
-                inc(pc);
-            else
-              inc(arglen);
-          end;
-          inc(pc);
-        end;
-       { copy argument }
-       { Don't copy the first one, it is already there.}
-       If Count<>0 then
-        begin
-          allocarg(count,arglen);
-          quote:=False;
-          pc:=argstart;
-          arg:=argv[count];
-          while (pc^<>#0) do
-           begin
-             case pc^ of
-               #1..#32 :
-                 begin
-                   if quote then
-                    begin
-                      arg^:=pc^;
-                      inc(arg);
-                    end
-                   else
-                    break;
-                 end;
-               '"' :
-                 if pc[1]<>'"' then
-                   quote := not quote
-                    else
-                  inc(pc);
-               else
-                 begin
-                   arg^:=pc^;
-                   inc(arg);
-                 end;
-             end;
-             inc(pc);
-           end;
-          arg^:=#0;
-        end;
-   {$IfDef SYSTEM_DEBUG_STARTUP}
-       Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
-   {$EndIf SYSTEM_DEBUG_STARTUP}
-       inc(count);
-     end;
-    { get argc }
-    argc:=count;
-    { free unused memory, leaving a nil entry at the end }
-    sysreallocmem(argv,(count+1)*sizeof(pointer));
-    argv[count] := nil;
-  end;
+var
+  argvw: PPWideChar;
 
+procedure setup_arguments;
+var
+  buf: array[0..MaxPathLen] of WideChar;
+  i, len: longint;
+  s: ansistring;
+begin
+  // Get argvw
+  argvw:=CommandLineToArgvW(GetCommandLineW, argc);
+  // Get the full module name for argvw[0]
+  len:=(GetModuleFileNameW(0, @buf, Length(buf)) + 1)*SizeOf(WideChar);
+  argvw[0]:=SysGetMem(len);
+  Move(buf, argvw[0]^, len);
+  // Construct the ansi argv
+  argv:=SysGetMem((argc + 1)*SizeOf(pointer));
+  for i:=0 to argc - 1 do
+    begin
+      // Convert argvw[i] to argv[i]
+      s:=ansistring(argvw[i]);
+      len:=Length(s) + 1;
+      argv[i]:=SysGetMem(len);
+      Move(s[1], argv[i]^, len);
+    end;
+  // argv is terminated by nil
+  argv[argc]:=nil;
+  // Get the ansi CmdLine
+  CmdLine:=GetCommandLineA;
+end;
 
-  function paramcount : longint;
-  begin
-    paramcount := argc - 1;
-  end;
+procedure finalize_arguments;
+var
+  i: longint;
+begin
+  // Free the module name
+  SysFreeMem(argvw[0]);
+  // Use GlobalFree to free the buffer returned by CommandLineToArgvW
+  GlobalFree(argvw);
+  // Free argv
+  for i:=0 to argc - 1 do
+    SysFreeMem(argv[i]);
+  SysFreeMem(argv);
+end;
 
-  function paramstr(l : longint) : string;
-  begin
-    if (l>=0) and (l<argc) then
-      paramstr:=strpas(argv[l])
-    else
-      paramstr:='';
-  end;
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
 
+Function ParamStrU(l:Longint): UnicodeString; [public,alias:'_FPC_ParamStrU'];
+begin
+  if (l >= 0) and (l < argc) then
+    Result:=argvw[l]
+  else
+    Result:='';
+end;
 
-  procedure randomize;
-  begin
-    randseed:=GetTickCount;
-  end;
+Function ParamStrA(l:Longint): AnsiString; [public,alias:'_FPC_ParamStrA'];
+begin
+  Result:=AnsiString(ParamStrU(l));
+end;
 
+Function ParamStr(l:Longint): string;
+begin
+  if (l >= 0) and (l < argc) then
+    Result:=argv[l]
+  else
+    Result:='';
+end;
 
+{*****************************************************************************}
 
+procedure randomize;
+begin
+  randseed:=GetTickCount;
+end;
 
 Var
   DLLInitState : Longint = -1;
@@ -781,3 +713,9 @@ begin
   SysSetCtrlBreakHandler := CtrlBreakHandler;
   CtrlBreakHandler := Handler;
 end;
+
+procedure WinFinalizeSystem;
+begin
+  finalize_arguments;
+end;
+

rtl/win/syswinh.inc

@@ -51,6 +51,7 @@ const
 
 var
 { C compatible arguments }
+{ CmdLine and argv are always in the current ANSI encoding set in Windows }
   argc : longint;
   argv : ppchar;
 { Win32 Info }

rtl/win32/system.pp

@@ -601,7 +601,7 @@ function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
     result:=tpeheader((pointer(getmodulehandle(nil))+(tdosheader(pointer(getmodulehandle(nil))^).e_lfanew))^).SizeOfStackReserve;
   end;
 
-begin
+initialization
   { get some helpful informations }
   GetStartupInfo(@startupinfo);
   { some misc Win32 stuff }
@@ -634,4 +634,8 @@ begin
   InOutRes:=0;
   ProcessID := GetCurrentProcessID;
   DispCallByIDProc:=@DoDispCallByIDError;
+
+finalization
+  WinFinalizeSystem;
+
 end.

rtl/win64/system.pp

@@ -615,7 +615,7 @@ function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
     result:=tpeheader((pointer(getmodulehandle(nil))+(tdosheader(pointer(getmodulehandle(nil))^).e_lfanew))^).SizeOfStackReserve;
   end;
 
-begin
+initialization
   { pass dummy value }
   StackLength := CheckInitialStkLen($1000000);
   StackBottom := StackTop - StackLength;
@@ -643,4 +643,8 @@ begin
   InOutRes:=0;
   ProcessID := GetCurrentProcessID;
   DispCallByIDProc:=@DoDispCallByIDError;
+
+finalization
+  WinFinalizeSystem;
+
 end.