paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 22:07:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl: add WideStringManager.GetStandardCodePageProc method to retrieve system ansi and console code pages

Browse Source 
git-svn-id: trunk@19539 -
This commit is contained in:
paul 2011-10-25 01:39:11 +00:00
parent 3e29f0b179
commit 270fb09e87
5 changed files with 52 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
rtl/inc/ustringh.inc
View File

@ -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

7
rtl/inc/ustrings.inc
View File

@ -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;

8
rtl/unix/cwstring.pp
View File

@ -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;

15
rtl/win/syswin.inc
View File

@ -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;

16
rtl/wince/system.pp
View File

@ -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;