From bdefb849fc4dbb2e201abb31439a2cc46f3345e7 Mon Sep 17 00:00:00 2001
From: pierre <pierre@freepascal.org>
Date: Wed, 6 Oct 2010 16:04:46 +0000
Subject: [PATCH]  * Fix for Bug report 17550

git-svn-id: trunk@16089 -
---
 rtl/win/sysfile.inc | 31 +++++++++++++++++++++++++++++++
 rtl/win/sysos.inc   |  6 ++++++
 2 files changed, 37 insertions(+)

diff --git a/rtl/win/sysfile.inc b/rtl/win/sysfile.inc
index b6587b94c3..55d1f19f2e 100644
--- a/rtl/win/sysfile.inc
+++ b/rtl/win/sysfile.inc
@@ -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;
diff --git a/rtl/win/sysos.inc b/rtl/win/sysos.inc
index 0486dbde57..05daca97ab 100644
--- a/rtl/win/sysos.inc
+++ b/rtl/win/sysos.inc
@@ -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;