From 8d95da3feafcffcd7b2bf539bfdf4b90a09c2963 Mon Sep 17 00:00:00 2001 From: yury Date: Thu, 23 Apr 2020 12:38:42 +0000 Subject: [PATCH] * 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 | 2 +- rtl/inc/uuchar.pp | 5 + rtl/objpas/objpas.pp | 5 + rtl/win/sysos.inc | 15 +-- rtl/win/syswin.inc | 218 ++++++++++++++++--------------------------- rtl/win/syswinh.inc | 1 + rtl/win32/system.pp | 6 +- rtl/win64/system.pp | 6 +- 8 files changed, 108 insertions(+), 150 deletions(-) diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 6ab6bfcc74..f28cf3ccec 100644 --- a/rtl/inc/system.inc +++ b/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 diff --git a/rtl/inc/uuchar.pp b/rtl/inc/uuchar.pp index 8b4b11308c..550068c597 100644 --- a/rtl/inc/uuchar.pp +++ b/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 diff --git a/rtl/objpas/objpas.pp b/rtl/objpas/objpas.pp index 52f6a20525..8672653844 100644 --- a/rtl/objpas/objpas.pp +++ b/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} {**************************************************************************** diff --git a/rtl/win/sysos.inc b/rtl/win/sysos.inc index e8842297fd..a85f424900 100644 --- a/rtl/win/sysos.inc +++ b/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); diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc index 1639aa7fea..7204e6797e 100644 --- a/rtl/win/syswin.inc +++ b/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! +var + argvw: PPWideChar; - 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; +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; - 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; +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 paramcount : longint; +begin + paramcount := argc - 1; +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; - function paramstr(l : longint) : string; - begin - if (l>=0) and (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; + diff --git a/rtl/win/syswinh.inc b/rtl/win/syswinh.inc index 90b691dc40..767557baf7 100644 --- a/rtl/win/syswinh.inc +++ b/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 } diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index f0dee6a272..4ffa0b65ff 100644 --- a/rtl/win32/system.pp +++ b/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. diff --git a/rtl/win64/system.pp b/rtl/win64/system.pp index fc69b61215..6cf7b174cd 100644 --- a/rtl/win64/system.pp +++ b/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.