diff --git a/rtl/inc/ustringh.inc b/rtl/inc/ustringh.inc index 999e8847a1..6b05d33076 100644 --- a/rtl/inc/ustringh.inc +++ b/rtl/inc/ustringh.inc @@ -50,6 +50,12 @@ procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp procedure DefaultAnsi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt); Type + TStandardCodePageEnum = ( + scpAnsi, // system Ansi code page (GetACP on windows) + scpConsoleInput, // system console input code page (GetConsoleCP on windows) + scpConsoleOutput // system console output code page (GetConsoleOutputCP on windows) + ); + { hooks for internationalization please add new procedures at the end, it makes it easier to detect new procedures } TUnicodeStringManager = record @@ -101,6 +107,9 @@ Type LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString; CompareUnicodeStringProc : function(const s1, s2 : UnicodeString) : PtrInt; CompareTextUnicodeStringProc : function(const s1, s2 : UnicodeString): PtrInt; + + { codepage retrieve function } + GetStandardCodePageProc: function(const stdcp: TStandardCodePageEnum): TSystemCodePage; end; var diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc index 8e374e03ac..704764c075 100644 --- a/rtl/inc/ustrings.inc +++ b/rtl/inc/ustrings.inc @@ -108,6 +108,12 @@ function DefaultCodePointLength(const Str: PChar; MaxLookAead: PtrInt): Ptrint; end; +function DefaultGetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage; + begin + { don't raise an exception here. We need this for text file handling } + Result:=DefaultSystemCodePage; + end; + Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager); begin manager:=widestringmanager; @@ -2631,5 +2637,6 @@ procedure initunicodestringmanager; widestringmanager.CharLengthPCharProc:=@DefaultCharLengthPChar; widestringmanager.CodePointLengthProc:=@DefaultCodePointLength; {$endif FPC_WIDESTRING_EQUAL_UNICODESTRING} + widestringmanager.GetStandardCodePageProc:=@DefaultGetStandardCodePage; end; diff --git a/rtl/unix/cwstring.pp b/rtl/unix/cwstring.pp index 06bf5586dd..7677d83f98 100644 --- a/rtl/unix/cwstring.pp +++ b/rtl/unix/cwstring.pp @@ -873,6 +873,10 @@ begin ansi2pchar(temp,str,result); end; +function GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage; +begin + Result := iconv2win(ansistring(nl_langinfo(CODESET))) +end; Procedure SetCWideStringManager; Var @@ -912,6 +916,8 @@ begin LowerUnicodeStringProc:=@LowerWideString; CompareUnicodeStringProc:=@CompareWideString; CompareTextUnicodeStringProc:=@CompareTextWideString; + { CodePage } + GetStandardCodePageProc:=@GetStandardCodePage; end; SetUnicodeStringManager(CWideStringManager); end; @@ -933,7 +939,7 @@ initialization pointer(iconvctl):=GetProcAddress(iconvlib,iconvctlname); { set the DefaultSystemCodePage } - DefaultSystemCodePage:=iconv2win(ansistring(nl_langinfo(CODESET))); + DefaultSystemCodePage:=GetStandardCodePage(scpAnsi); { init conversion tables for main program } InitThread; diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc index 6b970f7633..e40462b8f8 100644 --- a/rtl/win/syswin.inc +++ b/rtl/win/syswin.inc @@ -671,7 +671,17 @@ var WStrInitTablesTable: TWStrInitTablesTable; external name 'FPC_WIDEINITTABLES'; {$endif} -function GetACP:UINT; external 'kernel32' name 'GetACP'; +function GetACP:UINT; stdcall; external 'kernel32' name 'GetACP'; +function GetConsoleCP:UINT; stdcall; external 'kernel32' name 'GetConsoleCP'; + +function Win32GetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage; + begin + case stdcp of + scpAnsi: Result := GetACP; + scpConsoleInput: Result := GetConsoleCP; + scpConsoleOutput: Result := GetConsoleOutputCP; + end; + end; { there is a similiar procedure in sysutils which inits the fields which are only relevant for the sysutils units } @@ -706,6 +716,9 @@ procedure InitWin32Widestrings; widestringmanager.Ansi2UnicodeMoveProc:=@Win32Ansi2UnicodeMove; widestringmanager.UpperUnicodeStringProc:=@Win32UnicodeUpper; widestringmanager.LowerUnicodeStringProc:=@Win32UnicodeLower; + { Codepage } + widestringmanager.GetStandardCodePageProc:=@Win32GetStandardCodePage; + DefaultSystemCodePage:=GetACP; DefaultUnicodeCodePage:=CP_UTF16; end; diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp index 2ede829190..194ac2adec 100644 --- a/rtl/wince/system.pp +++ b/rtl/wince/system.pp @@ -309,7 +309,9 @@ function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cdecl; external 'coredll' name 'MultiByteToWideChar'; function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideChar; cchWideChar:longint; lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; lpUsedDefaultChar:pointer):longint; cdecl; external 'coredll' name 'WideCharToMultiByte'; -function GetACP:UINT; external 'coredll' name 'GetACP'; +function GetACP:UINT; cdecl; external 'coredll' name 'GetACP'; +function GetConsoleCP:UINT; cdecl; external 'coredll' name 'GetConsoleCP'; +function GetConsoleOutputCP:UINT; cdecl; external 'coredll' name 'GetConsoleOutputCP'; { Returns number of characters stored to WideBuf, including null-terminator. } function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint; @@ -1604,6 +1606,15 @@ begin Result:=WinCEWideLower(s); end; +function WinCEGetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystemCodePage; + begin + case stdcp of + scpAnsi: Result := GetACP; + scpConsoleInput: Result := GetConsoleCP; + scpConsoleOutput: Result := GetConsoleOutputCP; + end; + end; + { there is a similiar procedure in sysutils which inits the fields which are only relevant for the sysutils units } procedure InitWinCEWidestrings; @@ -1617,6 +1628,9 @@ procedure InitWinCEWidestrings; widestringmanager.Ansi2UnicodeMoveProc:=@WinCEAnsi2UnicodeMove; widestringmanager.UpperUnicodeStringProc:=@WinCEUnicodeUpper; widestringmanager.LowerUnicodeStringProc:=@WinCEUnicodeLower; + { Codepage } + widestringmanager.GetStandardCodePageProc:=@WinCEGetStandardCodePage; + DefaultSystemCodePage:=GetACP; DefaultUnicodeCodePage:=CP_UTF16; end;