paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-03 08:09:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Fix for Bug report 17550

Browse Source 
git-svn-id: trunk@16089 -
This commit is contained in:
pierre 2010-10-06 16:04:46 +00:00
parent 7961fec295
commit bdefb849fc
2 changed files with 37 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
rtl/win/sysfile.inc
View File

@ -67,11 +67,42 @@ end;
function do_write(h:thandle;addr:pointer;len : longint) : longint;
var
size:longint;
{$ifndef WINCE}
ConsoleMode : dword;
CodePage : UInt;
accept_smaller_size : boolean;
{$endif ndef WINCE}
begin
if writefile(h,addr,len,size,nil)=0 then
Begin
errno:=GetLastError;
Errno2InoutRes;
{$ifndef WINCE}
end
else if (size<len) then
Begin
if GetConsoleMode (h, @ConsoleMode) then
Begin
accept_smaller_size:=false;
{ GetConsoleMode success means that we do have a
console handle that might return less than
LEN because a UTF-8 with length LEN input was
transformed into a shorter string of size SIZE }
CodePage:=GetConsoleOutputCP;
Case CodePage of
1200, {utf-16}
1201, {unicodeFFFE}
12000, {utf-32}
12001, {utf-32BE}
65000, {utf-7}
65001: {utf-8}
accept_smaller_size:=true;
end;
if accept_smaller_size then
size:=len;
end;
{$endif ndef WINCE}
end;
do_write:=size;
end;

6
rtl/win/sysos.inc
View File

@ -253,6 +253,12 @@ threadvar
stdcall;external KernelDLL name 'SetCurrentDirectoryA';
function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
stdcall;external KernelDLL name 'GetCurrentDirectoryA';
{ Console functions needed for WriteFile fix for bug 17550 }
function GetConsoleMode(hConsoleHandle:thandle; lpMode:LPDWORD):BOOL;
stdcall;external KernelDLL name 'GetConsoleMode';
function GetConsoleOutputCP : UINT;
stdcall; external KernelDLL name 'GetConsoleOutputCP';
{$endif WINCE}
Procedure Errno2InOutRes;