Merged revisions 8468 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r8468 | peter | 2007-09-14 09:19:48 +0200 (Fri, 14 Sep 2007) | 2 lines
  
    * svn props
........

git-svn-id: branches/fixes_2_2@8470 -

.gitattributes

@@ -5484,16 +5484,16 @@ rtl/win64/system.pp svneol=native#text/plain
 rtl/win64/windows.pp svneol=native#text/plain
 rtl/wince/Makefile svneol=native#text/plain
 rtl/wince/Makefile.fpc svneol=native#text/plain
-rtl/wince/classes.pp -text
-rtl/wince/dos.pp -text
-rtl/wince/dynlibs.inc -text
+rtl/wince/classes.pp svneol=native#text/plain
+rtl/wince/dos.pp svneol=native#text/plain
+rtl/wince/dynlibs.inc svneol=native#text/plain
 rtl/wince/gx.pp svneol=native#text/plain
-rtl/wince/messages.pp -text
-rtl/wince/readme.txt -text
+rtl/wince/messages.pp svneol=native#text/plain
+rtl/wince/readme.txt svneol=native#text/plain
 rtl/wince/system.pp svneol=native#text/plain
-rtl/wince/sysutils.pp -text
-rtl/wince/varutils.pp -text
-rtl/wince/windows.pp -text
+rtl/wince/sysutils.pp svneol=native#text/plain
+rtl/wince/varutils.pp svneol=native#text/plain
+rtl/wince/windows.pp svneol=native#text/plain
 rtl/wince/wininc/aygshell.inc svneol=native#text/plain
 rtl/wince/wininc/base.inc svneol=native#text/plain
 rtl/wince/wininc/cemiss.inc svneol=native#text/plain

rtl/wince/classes.pp

@@ -1,52 +1,55 @@
-{
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for wince
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$define UNICODE}  //ce is unicode only, needed here for classes.inc
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  rtlconsts,
-  sysutils,
-  types,
-  typinfo,
-  windows;
-
-type
-  TWndMethod = procedure(var msg : TMessage) of object;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-  sysconst;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-initialization
-  CommonInit;
-
-finalization
-  CommonCleanup;
-end.
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for wince
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$define UNICODE}  //ce is unicode only, needed here for classes.inc
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  rtlconsts,
+  sysutils,
+  types,
+{$ifdef FPC_TESTGENERICS}
+  fgl,
+{$endif}
+  typinfo,
+  windows;
+
+type
+  TWndMethod = procedure(var msg : TMessage) of object;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+  sysconst;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+initialization
+  CommonInit;
+
+finalization
+  CommonCleanup;
+end.

rtl/wince/dos.pp

@@ -1,568 +1,568 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2004 by the Free Pascal development team.
-
-    Dos unit for BP7 compatible RTL
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit dos;
-interface
-
-uses windows;
-
-Const
-  Max_Path = MaxPathLen;
-
-Type
-  Searchrec = Packed Record
-    FindHandle  : THandle;
-    W32FindData : TWin32FindData;
-    ExcludeAttr : longint;
-    time : longint;
-    size : longint;
-    attr : longint;
-    name : string;
-  end;
-
-{$i dosh.inc}
-
-Function WinToDosTime (Const Wtime : TFileTime; var DTime:longint):longbool;
-Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
-
-implementation
-
-{$DEFINE HAS_GETMSCOUNT}
-
-{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
-{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
-
-{$I dos.inc}
-
-{******************************************************************************
-                           --- Conversion ---
-******************************************************************************}
-
-function GetMsCount: int64;
-begin
-  GetMsCount := cardinal (GetTickCount);
-end;
-
-function Last2DosError(d:dword):integer;
-begin
-  case d of
-    87 : { Parameter invalid -> Data invalid }
-      Last2DosError:=13;
-    else
-      Last2DosError:=integer(d);
-  end;
-end;
-
-
-Function DosToWinAttr (Const Attr : Longint) : longint;
-begin
-  DosToWinAttr:=Attr;
-end;
-
-
-Function WinToDosAttr (Const Attr : Longint) : longint;
-begin
-  WinToDosAttr:=Attr;
-end;
-
-type
-  Longrec=packed record
-    lo,hi : word;
-  end;
-  
-Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
-var
-  FatDate, FatTime: WORD;
-  lft: TFileTime;
-  st: SYSTEMTIME;
-begin
-  FatDate:=Longrec(Dtime).Hi;
-  FatTime:=Longrec(Dtime).Lo;
-  with st do
-  begin
-    wDay:=FatDate and $1F;
-    wMonth:=(FatDate shr 5) and $F;
-    wYear:=(FatDate shr 9) + 1980;
-    wSecond:=(FatTime and $1F)*2;
-    wMinute:=(FatTime shr 5) and $1F;
-    wHour:=FatTime shr 11;
-    wMilliseconds:=0;
-    wDayOfWeek:=0;
-  end;
-  DosToWinTime:=SystemTimeToFileTime(@st, @lft) and LocalFileTimeToFileTime(@lft, @Wtime);
-end;
-
-
-Function WinToDosTime (Const Wtime : TFileTime; var DTime:longint):longbool;
-var
-  FatDate, FatTime: WORD;
-  lft: TFileTime;
-  st: SYSTEMTIME;
-  res: longbool;
-begin
-  res:=FileTimeToLocalFileTime(@WTime, @lft) and FileTimeToSystemTime(@lft, @st);
-  if res then
-  begin
-    FatDate:=st.wDay or (st.wMonth shl 5) or ((st.wYear - 1980) shl 9);
-    FatTime:=(st.wSecond div 2) or (st.wMinute shl 5) or (st.wHour shl 11);
-    Longrec(Dtime).Hi:=FatDate;
-    Longrec(Dtime).Lo:=FatTime;
-  end;
-  WinToDosTime:=res;
-end;
-
-
-{******************************************************************************
-                        --- Info / Date / Time ---
-******************************************************************************}
-
-function dosversion : word;
-var
-  versioninfo : OSVERSIONINFO;
-begin
-  versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
-  GetVersionEx(versioninfo);
-  dosversion:=versioninfo.dwMajorVersion and $FF or versioninfo.dwMinorVersion and $FF shl 8;
-end;
-
-
-procedure getdate(var year,month,mday,wday : word);
-var
-  t : TSystemTime;
-begin
-  GetLocalTime(t);
-  year:=t.wYear;
-  month:=t.wMonth;
-  mday:=t.wDay;
-  wday:=t.wDayOfWeek;
-end;
-
-
-procedure setdate(year,month,day : word);
-var
-  t : TSystemTime;
-begin
-  GetLocalTime(t);
-  t.wYear:=year;
-  t.wMonth:=month;
-  t.wDay:=day;
-  { only a quite good solution, we can loose some ms }
-  SetLocalTime(t);
-end;
-
-
-procedure gettime(var hour,minute,second,sec100 : word);
-var
-  t : TSystemTime;
-begin
-   GetLocalTime(t);
-   hour:=t.wHour;
-   minute:=t.wMinute;
-   second:=t.wSecond;
-   sec100:=t.wMilliSeconds div 10;
-end;
-
-
-procedure settime(hour,minute,second,sec100 : word);
-var
-   t : TSystemTime;
-begin
-   GetLocalTime(t);
-   t.wHour:=hour;
-   t.wMinute:=minute;
-   t.wSecond:=second;
-   t.wMilliSeconds:=sec100*10;
-   SetLocalTime(t);
-end;
-
-
-{******************************************************************************
-                               --- Exec ---
-******************************************************************************}
-
-procedure exec(const path : pathstr;const comline : comstr);
-var
-  PI: TProcessInformation;
-  Proc : THandle;
-  l    : LongInt;
-  PathW : array[0..FileNameLen] of WideChar;
-  CmdLineW : array[0..FileNameLen] of WideChar;
-begin
-  DosError := 0;
-  AnsiToWideBuf(@path[1], Length(path), PathW, SizeOf(PathW));
-  AnsiToWideBuf(@comline[1], Length(comline), CmdLineW, SizeOf(CmdLineW));
-  if not CreateProcess(PathW, CmdLineW,
-           nil, nil, FALSE, 0, nil, nil, nil, PI) then
-   begin
-     DosError:=Last2DosError(GetLastError);
-     exit;
-   end;
-  Proc:=PI.hProcess;
-  CloseHandle(PI.hThread);
-  if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
-    GetExitCodeProcess(Proc, @l)
-  else
-    l:=-1;
-  CloseHandle(Proc);
-  LastDosExitCode:=l;
-end;
-
-
-{******************************************************************************
-                               --- Disk ---
-******************************************************************************}
-
-var
-  DriveNames: array[1..24] of PWideChar;
-
-function GetDriveName(drive: byte): PWideChar;
-const
-  dev_attr = FILE_ATTRIBUTE_TEMPORARY or FILE_ATTRIBUTE_DIRECTORY;
-
-var
-  h: THandle;
-  fd: TWin32FindData;
-  i, len: LongInt;
-begin
-  GetDriveName:=nil;
-  // Current drive is C: drive always
-  if drive = 0 then
-    drive:=2;
-  if (drive < 3) or (drive > 26) then
-    exit;
-  if DriveNames[1] = nil then
-  begin
-    // Drive C: is filesystem root always
-    GetMem(DriveNames[1], 2*SizeOf(WideChar));
-    DriveNames[1][0]:='\';
-    DriveNames[1][1]:=#0;
-    
-    // Other drives are found dinamically
-    h:=FindFirstFile('\*', @fd);
-    if h <> 0 then
-    begin
-      i:=2;
-      repeat
-        if fd.dwFileAttributes and dev_attr = dev_attr then begin
-          len:=0;
-          while fd.cFileName[len] <> #0 do
-            Inc(len);
-          len:=(len + 2)*SizeOf(WideChar);
-          GetMem(DriveNames[i], len);
-          DriveNames[i]^:='\';
-          Move(fd.cFileName, DriveNames[i][1], len - SizeOf(WideChar));
-          Inc(i);
-        end;
-      until (i > 24) or not FindNextFile(h, fd);
-      Windows.FindClose(h);
-    end;
-  end;
-  GetDriveName:=DriveNames[drive - 2];
-end;
-
-function diskfree(drive : byte) : int64;
-var
-  disk: PWideChar;
-  qwtotal,qwfree,qwcaller : int64;
-begin
-  disk:=GetDriveName(drive);
-  if (disk <> nil) and GetDiskFreeSpaceEx(disk, @qwcaller, @qwtotal, @qwfree) then
-    diskfree:=qwfree
-  else
-    diskfree:=-1;
-end;
-
-
-function disksize(drive : byte) : int64;
-var
-  disk : PWideChar;
-  qwtotal,qwfree,qwcaller : int64;
-begin
-  disk:=GetDriveName(drive);
-  if (disk <> nil) and GetDiskFreeSpaceEx(disk, @qwcaller, @qwtotal, @qwfree) then
-    disksize:=qwtotal
-  else
-    disksize:=-1;
-end;
-
-
-{******************************************************************************
-                         --- Findfirst FindNext ---
-******************************************************************************}
-
-Procedure StringToPchar (Var S : String);
-Var L : Longint;
-begin
-  L:=ord(S[0]);
-  Move (S[1],S[0],L);
-  S[L]:=#0;
-end;
-
-Procedure PCharToString (Var S : String);
-Var L : Longint;
-begin
-  L:=strlen(pchar(@S[0]));
-  Move (S[0],S[1],L);
-  S[0]:=char(l);
-end;
-
-
-procedure FindMatch(var f:searchrec);
-var
-  buf: array[0..MaxPathLen] of char;
-begin
-  { Find file with correct attribute }
-  While (F.W32FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
-   begin
-     if not FindNextFile (F.FindHandle, F.W32FindData) then
-      begin
-        DosError:=Last2DosError(GetLastError);
-        if DosError=2 then
-         DosError:=18;
-        exit;
-      end;
-   end;
-
-  { Convert some attributes back }
-  f.size:=F.W32FindData.NFileSizeLow;
-  f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
-  WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
-  WideToAnsiBuf(@F.W32FindData.cFileName, -1, buf, SizeOf(buf));
-  f.Name:=StrPas(@buf);
-end;
-
-
-procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
-var
-  buf: array[0..MaxPathLen] of WideChar;
-begin
-  if path = ''then
-    begin
-      DosError:=3;
-      exit;
-    end;
-  fillchar(f,sizeof(f),0);
-  { no error }
-  doserror:=0;
-  F.Name:=Path;
-  F.Attr:=attr;
-  F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume}
-  StringToPchar(f.name);
-
-  { FindFirstFile is a WinCE Call }
-  F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr);
-  AnsiToWideBuf(@f.Name, -1, buf, SizeOf(buf));
-  F.FindHandle:=FindFirstFile (buf, F.W32FindData);
-
-  If F.FindHandle = Invalid_Handle_value then
-   begin
-     DosError:=Last2DosError(GetLastError);
-     if DosError=2 then
-      DosError:=18;
-     exit;
-   end;
-  { Find file with correct attribute }
-  FindMatch(f);
-end;
-
-
-procedure findnext(var f : searchRec);
-begin
-{ no error }
-  doserror:=0;
-  if not FindNextFile (F.FindHandle, F.W32FindData) then
-   begin
-     DosError:=Last2DosError(GetLastError);
-     if DosError=2 then
-      DosError:=18;
-     exit;
-   end;
-{ Find file with correct attribute }
-  FindMatch(f);
-end;
-
-
-Procedure FindClose(Var f: SearchRec);
-begin
-  If F.FindHandle <> Invalid_Handle_value then
-    Windows.FindClose(F.FindHandle);
-end;
-
-
-{******************************************************************************
-                               --- File ---
-******************************************************************************}
-
-Function FSearch(path: pathstr; dirlist: string): pathstr;
-var
-  i,p1   : longint;
-  s      : searchrec;
-  newdir : pathstr;
-begin
-  { check if the file specified exists }
-  findfirst(path,anyfile and not(directory),s);
-  if doserror=0 then
-   begin
-     findclose(s);
-     fsearch:=path;
-     exit;
-   end;
-  { No wildcards allowed in these things }
-  if (pos('?',path)<>0) or (pos('*',path)<>0) then
-    fsearch:=''
-  else
-    begin
-       { allow slash as backslash }
-       for i:=1 to length(dirlist) do
-         if dirlist[i]='/' then dirlist[i]:='\';
-       repeat
-         p1:=pos(';',dirlist);
-         if p1<>0 then
-          begin
-            newdir:=copy(dirlist,1,p1-1);
-            delete(dirlist,1,p1);
-          end
-         else
-          begin
-            newdir:=dirlist;
-            dirlist:='';
-          end;
-         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
-          newdir:=newdir+'\';
-         findfirst(newdir+path,anyfile and not(directory),s);
-         if doserror=0 then
-          newdir:=newdir+path
-         else
-          newdir:='';
-       until (dirlist='') or (newdir<>'');
-       fsearch:=newdir;
-    end;
-  findclose(s);
-end;
-
-{ </immobilizer> }
-
-procedure getftime(var f;var time : longint);
-var
-   ft : TFileTime;
-begin
-  doserror:=0;
-  if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
-     WinToDosTime(ft,time) then
-    exit
-  else
-    begin
-      DosError:=Last2DosError(GetLastError);
-      time:=0;
-    end;
-end;
-
-
-procedure setftime(var f;time : longint);
-var
-  ft : TFileTime;
-begin
-  doserror:=0;
-  if DosToWinTime(time,ft) and
-     SetFileTime(filerec(f).Handle,nil,nil,@ft) then
-   exit
-  else
-   DosError:=Last2DosError(GetLastError);
-end;
-
-
-procedure getfattr(var f;var attr : word);
-var
-  l : cardinal;
-  buf: array[0..MaxPathLen] of WideChar;
-begin
-  if filerec(f).name[1] = #0 then 
-    begin
-      doserror:=3;
-      attr:=0;
-    end
-  else
-    begin  
-      doserror:=0;
-      AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
-      l:=GetFileAttributes(buf);
-      if l = $ffffffff then
-       begin
-         doserror:=Last2DosError(GetLastError);
-         attr:=0;
-       end
-      else
-       attr:=l and $ffff;
-    end;   
-end;
-
-
-procedure setfattr(var f;attr : word);
-var
-  buf: array[0..MaxPathLen] of WideChar;
-begin
-  { Fail for setting VolumeId }
-  if (attr and VolumeID)<>0 then
-    doserror:=5
-  else
-    begin
-      AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
-      if SetFileAttributes(buf,attr) then
-        doserror:=0
-      else
-        doserror:=Last2DosError(GetLastError);
-    end;  
-end;
-
-{******************************************************************************
-                             --- Environment ---
-******************************************************************************}
-
-// WinCE does not have environment. It can be emulated via registry or file. (YS)
-
-function envcount : longint;
-begin
-  envcount:=0;
-end;
-
-Function EnvStr (Index: longint): string;
-begin
-  EnvStr:='';
-end;
-
-Function  GetEnv(envvar: string): string;
-begin
-  GetEnv:='';
-end;
-
-var
-  oldexitproc : pointer;
-
-procedure dosexitproc;
-var
-  i: LongInt;
-begin
-  exitproc:=oldexitproc;
-  if DriveNames[1] <> nil then
-    for i:=1 to 24 do
-      if DriveNames[i] <> nil then
-        FreeMem(DriveNames[i])
-      else
-        break;
-end;
-
-begin
-  oldexitproc:=exitproc;
-  exitproc:=@dosexitproc;
-end.
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2004 by the Free Pascal development team.
+
+    Dos unit for BP7 compatible RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+interface
+
+uses windows;
+
+Const
+  Max_Path = MaxPathLen;
+
+Type
+  Searchrec = Packed Record
+    FindHandle  : THandle;
+    W32FindData : TWin32FindData;
+    ExcludeAttr : longint;
+    time : longint;
+    size : longint;
+    attr : longint;
+    name : string;
+  end;
+
+{$i dosh.inc}
+
+Function WinToDosTime (Const Wtime : TFileTime; var DTime:longint):longbool;
+Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
+
+implementation
+
+{$DEFINE HAS_GETMSCOUNT}
+
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+
+{$I dos.inc}
+
+{******************************************************************************
+                           --- Conversion ---
+******************************************************************************}
+
+function GetMsCount: int64;
+begin
+  GetMsCount := cardinal (GetTickCount);
+end;
+
+function Last2DosError(d:dword):integer;
+begin
+  case d of
+    87 : { Parameter invalid -> Data invalid }
+      Last2DosError:=13;
+    else
+      Last2DosError:=integer(d);
+  end;
+end;
+
+
+Function DosToWinAttr (Const Attr : Longint) : longint;
+begin
+  DosToWinAttr:=Attr;
+end;
+
+
+Function WinToDosAttr (Const Attr : Longint) : longint;
+begin
+  WinToDosAttr:=Attr;
+end;
+
+type
+  Longrec=packed record
+    lo,hi : word;
+  end;
+  
+Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
+var
+  FatDate, FatTime: WORD;
+  lft: TFileTime;
+  st: SYSTEMTIME;
+begin
+  FatDate:=Longrec(Dtime).Hi;
+  FatTime:=Longrec(Dtime).Lo;
+  with st do
+  begin
+    wDay:=FatDate and $1F;
+    wMonth:=(FatDate shr 5) and $F;
+    wYear:=(FatDate shr 9) + 1980;
+    wSecond:=(FatTime and $1F)*2;
+    wMinute:=(FatTime shr 5) and $1F;
+    wHour:=FatTime shr 11;
+    wMilliseconds:=0;
+    wDayOfWeek:=0;
+  end;
+  DosToWinTime:=SystemTimeToFileTime(@st, @lft) and LocalFileTimeToFileTime(@lft, @Wtime);
+end;
+
+
+Function WinToDosTime (Const Wtime : TFileTime; var DTime:longint):longbool;
+var
+  FatDate, FatTime: WORD;
+  lft: TFileTime;
+  st: SYSTEMTIME;
+  res: longbool;
+begin
+  res:=FileTimeToLocalFileTime(@WTime, @lft) and FileTimeToSystemTime(@lft, @st);
+  if res then
+  begin
+    FatDate:=st.wDay or (st.wMonth shl 5) or ((st.wYear - 1980) shl 9);
+    FatTime:=(st.wSecond div 2) or (st.wMinute shl 5) or (st.wHour shl 11);
+    Longrec(Dtime).Hi:=FatDate;
+    Longrec(Dtime).Lo:=FatTime;
+  end;
+  WinToDosTime:=res;
+end;
+
+
+{******************************************************************************
+                        --- Info / Date / Time ---
+******************************************************************************}
+
+function dosversion : word;
+var
+  versioninfo : OSVERSIONINFO;
+begin
+  versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
+  GetVersionEx(versioninfo);
+  dosversion:=versioninfo.dwMajorVersion and $FF or versioninfo.dwMinorVersion and $FF shl 8;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+var
+  t : TSystemTime;
+begin
+  GetLocalTime(t);
+  year:=t.wYear;
+  month:=t.wMonth;
+  mday:=t.wDay;
+  wday:=t.wDayOfWeek;
+end;
+
+
+procedure setdate(year,month,day : word);
+var
+  t : TSystemTime;
+begin
+  GetLocalTime(t);
+  t.wYear:=year;
+  t.wMonth:=month;
+  t.wDay:=day;
+  { only a quite good solution, we can loose some ms }
+  SetLocalTime(t);
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+var
+  t : TSystemTime;
+begin
+   GetLocalTime(t);
+   hour:=t.wHour;
+   minute:=t.wMinute;
+   second:=t.wSecond;
+   sec100:=t.wMilliSeconds div 10;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+var
+   t : TSystemTime;
+begin
+   GetLocalTime(t);
+   t.wHour:=hour;
+   t.wMinute:=minute;
+   t.wSecond:=second;
+   t.wMilliSeconds:=sec100*10;
+   SetLocalTime(t);
+end;
+
+
+{******************************************************************************
+                               --- Exec ---
+******************************************************************************}
+
+procedure exec(const path : pathstr;const comline : comstr);
+var
+  PI: TProcessInformation;
+  Proc : THandle;
+  l    : LongInt;
+  PathW : array[0..FileNameLen] of WideChar;
+  CmdLineW : array[0..FileNameLen] of WideChar;
+begin
+  DosError := 0;
+  AnsiToWideBuf(@path[1], Length(path), PathW, SizeOf(PathW));
+  AnsiToWideBuf(@comline[1], Length(comline), CmdLineW, SizeOf(CmdLineW));
+  if not CreateProcess(PathW, CmdLineW,
+           nil, nil, FALSE, 0, nil, nil, nil, PI) then
+   begin
+     DosError:=Last2DosError(GetLastError);
+     exit;
+   end;
+  Proc:=PI.hProcess;
+  CloseHandle(PI.hThread);
+  if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
+    GetExitCodeProcess(Proc, @l)
+  else
+    l:=-1;
+  CloseHandle(Proc);
+  LastDosExitCode:=l;
+end;
+
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+var
+  DriveNames: array[1..24] of PWideChar;
+
+function GetDriveName(drive: byte): PWideChar;
+const
+  dev_attr = FILE_ATTRIBUTE_TEMPORARY or FILE_ATTRIBUTE_DIRECTORY;
+
+var
+  h: THandle;
+  fd: TWin32FindData;
+  i, len: LongInt;
+begin
+  GetDriveName:=nil;
+  // Current drive is C: drive always
+  if drive = 0 then
+    drive:=2;
+  if (drive < 3) or (drive > 26) then
+    exit;
+  if DriveNames[1] = nil then
+  begin
+    // Drive C: is filesystem root always
+    GetMem(DriveNames[1], 2*SizeOf(WideChar));
+    DriveNames[1][0]:='\';
+    DriveNames[1][1]:=#0;
+    
+    // Other drives are found dinamically
+    h:=FindFirstFile('\*', @fd);
+    if h <> 0 then
+    begin
+      i:=2;
+      repeat
+        if fd.dwFileAttributes and dev_attr = dev_attr then begin
+          len:=0;
+          while fd.cFileName[len] <> #0 do
+            Inc(len);
+          len:=(len + 2)*SizeOf(WideChar);
+          GetMem(DriveNames[i], len);
+          DriveNames[i]^:='\';
+          Move(fd.cFileName, DriveNames[i][1], len - SizeOf(WideChar));
+          Inc(i);
+        end;
+      until (i > 24) or not FindNextFile(h, fd);
+      Windows.FindClose(h);
+    end;
+  end;
+  GetDriveName:=DriveNames[drive - 2];
+end;
+
+function diskfree(drive : byte) : int64;
+var
+  disk: PWideChar;
+  qwtotal,qwfree,qwcaller : int64;
+begin
+  disk:=GetDriveName(drive);
+  if (disk <> nil) and GetDiskFreeSpaceEx(disk, @qwcaller, @qwtotal, @qwfree) then
+    diskfree:=qwfree
+  else
+    diskfree:=-1;
+end;
+
+
+function disksize(drive : byte) : int64;
+var
+  disk : PWideChar;
+  qwtotal,qwfree,qwcaller : int64;
+begin
+  disk:=GetDriveName(drive);
+  if (disk <> nil) and GetDiskFreeSpaceEx(disk, @qwcaller, @qwtotal, @qwfree) then
+    disksize:=qwtotal
+  else
+    disksize:=-1;
+end;
+
+
+{******************************************************************************
+                         --- Findfirst FindNext ---
+******************************************************************************}
+
+Procedure StringToPchar (Var S : String);
+Var L : Longint;
+begin
+  L:=ord(S[0]);
+  Move (S[1],S[0],L);
+  S[L]:=#0;
+end;
+
+Procedure PCharToString (Var S : String);
+Var L : Longint;
+begin
+  L:=strlen(pchar(@S[0]));
+  Move (S[0],S[1],L);
+  S[0]:=char(l);
+end;
+
+
+procedure FindMatch(var f:searchrec);
+var
+  buf: array[0..MaxPathLen] of char;
+begin
+  { Find file with correct attribute }
+  While (F.W32FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
+   begin
+     if not FindNextFile (F.FindHandle, F.W32FindData) then
+      begin
+        DosError:=Last2DosError(GetLastError);
+        if DosError=2 then
+         DosError:=18;
+        exit;
+      end;
+   end;
+
+  { Convert some attributes back }
+  f.size:=F.W32FindData.NFileSizeLow;
+  f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
+  WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
+  WideToAnsiBuf(@F.W32FindData.cFileName, -1, buf, SizeOf(buf));
+  f.Name:=StrPas(@buf);
+end;
+
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+  buf: array[0..MaxPathLen] of WideChar;
+begin
+  if path = ''then
+    begin
+      DosError:=3;
+      exit;
+    end;
+  fillchar(f,sizeof(f),0);
+  { no error }
+  doserror:=0;
+  F.Name:=Path;
+  F.Attr:=attr;
+  F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume}
+  StringToPchar(f.name);
+
+  { FindFirstFile is a WinCE Call }
+  F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr);
+  AnsiToWideBuf(@f.Name, -1, buf, SizeOf(buf));
+  F.FindHandle:=FindFirstFile (buf, F.W32FindData);
+
+  If F.FindHandle = Invalid_Handle_value then
+   begin
+     DosError:=Last2DosError(GetLastError);
+     if DosError=2 then
+      DosError:=18;
+     exit;
+   end;
+  { Find file with correct attribute }
+  FindMatch(f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+{ no error }
+  doserror:=0;
+  if not FindNextFile (F.FindHandle, F.W32FindData) then
+   begin
+     DosError:=Last2DosError(GetLastError);
+     if DosError=2 then
+      DosError:=18;
+     exit;
+   end;
+{ Find file with correct attribute }
+  FindMatch(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+  If F.FindHandle <> Invalid_Handle_value then
+    Windows.FindClose(F.FindHandle);
+end;
+
+
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+  i,p1   : longint;
+  s      : searchrec;
+  newdir : pathstr;
+begin
+  { check if the file specified exists }
+  findfirst(path,anyfile and not(directory),s);
+  if doserror=0 then
+   begin
+     findclose(s);
+     fsearch:=path;
+     exit;
+   end;
+  { No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+    fsearch:=''
+  else
+    begin
+       { allow slash as backslash }
+       for i:=1 to length(dirlist) do
+         if dirlist[i]='/' then dirlist[i]:='\';
+       repeat
+         p1:=pos(';',dirlist);
+         if p1<>0 then
+          begin
+            newdir:=copy(dirlist,1,p1-1);
+            delete(dirlist,1,p1);
+          end
+         else
+          begin
+            newdir:=dirlist;
+            dirlist:='';
+          end;
+         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+          newdir:=newdir+'\';
+         findfirst(newdir+path,anyfile and not(directory),s);
+         if doserror=0 then
+          newdir:=newdir+path
+         else
+          newdir:='';
+       until (dirlist='') or (newdir<>'');
+       fsearch:=newdir;
+    end;
+  findclose(s);
+end;
+
+{ </immobilizer> }
+
+procedure getftime(var f;var time : longint);
+var
+   ft : TFileTime;
+begin
+  doserror:=0;
+  if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
+     WinToDosTime(ft,time) then
+    exit
+  else
+    begin
+      DosError:=Last2DosError(GetLastError);
+      time:=0;
+    end;
+end;
+
+
+procedure setftime(var f;time : longint);
+var
+  ft : TFileTime;
+begin
+  doserror:=0;
+  if DosToWinTime(time,ft) and
+     SetFileTime(filerec(f).Handle,nil,nil,@ft) then
+   exit
+  else
+   DosError:=Last2DosError(GetLastError);
+end;
+
+
+procedure getfattr(var f;var attr : word);
+var
+  l : cardinal;
+  buf: array[0..MaxPathLen] of WideChar;
+begin
+  if filerec(f).name[1] = #0 then 
+    begin
+      doserror:=3;
+      attr:=0;
+    end
+  else
+    begin  
+      doserror:=0;
+      AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
+      l:=GetFileAttributes(buf);
+      if l = $ffffffff then
+       begin
+         doserror:=Last2DosError(GetLastError);
+         attr:=0;
+       end
+      else
+       attr:=l and $ffff;
+    end;   
+end;
+
+
+procedure setfattr(var f;attr : word);
+var
+  buf: array[0..MaxPathLen] of WideChar;
+begin
+  { Fail for setting VolumeId }
+  if (attr and VolumeID)<>0 then
+    doserror:=5
+  else
+    begin
+      AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
+      if SetFileAttributes(buf,attr) then
+        doserror:=0
+      else
+        doserror:=Last2DosError(GetLastError);
+    end;  
+end;
+
+{******************************************************************************
+                             --- Environment ---
+******************************************************************************}
+
+// WinCE does not have environment. It can be emulated via registry or file. (YS)
+
+function envcount : longint;
+begin
+  envcount:=0;
+end;
+
+Function EnvStr (Index: longint): string;
+begin
+  EnvStr:='';
+end;
+
+Function  GetEnv(envvar: string): string;
+begin
+  GetEnv:='';
+end;
+
+var
+  oldexitproc : pointer;
+
+procedure dosexitproc;
+var
+  i: LongInt;
+begin
+  exitproc:=oldexitproc;
+  if DriveNames[1] <> nil then
+    for i:=1 to 24 do
+      if DriveNames[i] <> nil then
+        FreeMem(DriveNames[i])
+      else
+        break;
+end;
+
+begin
+  oldexitproc:=exitproc;
+  exitproc:=@dosexitproc;
+end.

rtl/wince/dynlibs.inc

@@ -1,60 +1,60 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Implements OS dependent part for loading of dynamic libraries.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-
-{$ifdef readinterface}
-
-{ ---------------------------------------------------------------------
-    Interface declarations
-  ---------------------------------------------------------------------}
-
-Type
-  TLibHandle = Longint;
-
-Const
-  NilHandle = 0;
-
-{$else}
-
-{ ---------------------------------------------------------------------
-    Implementation section
-  ---------------------------------------------------------------------}
-
-Uses windows;
-
-Function LoadLibrary(Name : AnsiString) : TlibHandle;
-var
-  ws: PWideChar;
-begin
-  ws:=StringToPWideChar(Name);
-  Result:=Windows.LoadLibrary(ws);
-  FreeMem(ws);
-end;
-
-Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
-var
-  ws: PWideChar;
-begin
-  ws:=StringToPWideChar(ProcName);
-  Result:=Windows.GetProcAddress(Lib, ws);
-  FreeMem(ws);
-end;
-
-Function UnloadLibrary(Lib : TLibHandle) : Boolean;
-begin
-  Result:=Windows.FreeLibrary(Lib);
-end;
-
-{$endif}
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Implements OS dependent part for loading of dynamic libraries.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+
+{$ifdef readinterface}
+
+{ ---------------------------------------------------------------------
+    Interface declarations
+  ---------------------------------------------------------------------}
+
+Type
+  TLibHandle = Longint;
+
+Const
+  NilHandle = 0;
+
+{$else}
+
+{ ---------------------------------------------------------------------
+    Implementation section
+  ---------------------------------------------------------------------}
+
+Uses windows;
+
+Function LoadLibrary(Name : AnsiString) : TlibHandle;
+var
+  ws: PWideChar;
+begin
+  ws:=StringToPWideChar(Name);
+  Result:=Windows.LoadLibrary(ws);
+  FreeMem(ws);
+end;
+
+Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
+var
+  ws: PWideChar;
+begin
+  ws:=StringToPWideChar(ProcName);
+  Result:=Windows.GetProcAddress(Lib, ws);
+  FreeMem(ws);
+end;
+
+Function UnloadLibrary(Lib : TLibHandle) : Boolean;
+begin
+  Result:=Windows.FreeLibrary(Lib);
+end;
+
+{$endif}

rtl/wince/messages.pp

@@ -1,15 +1,15 @@
-unit messages;
-
-
-interface
-
-  uses
-    windows;
-
-{$DEFINE read_interface}
-{$DEFINE MESSAGESUNIT}
-{$I messages.inc}
-
-implementation
-
-end.
+unit messages;
+
+
+interface
+
+  uses
+    windows;
+
+{$DEFINE read_interface}
+{$DEFINE MESSAGESUNIT}
+{$I messages.inc}
+
+implementation
+
+end.

rtl/wince/readme.txt

@@ -1,48 +1,48 @@
-WinCE port
-==========
-
-WinCE port is quite complete and usable. The port was started and maintained by Yury Sidorov. Oliver (Oro06) ported WinCE API headers.
-
-Status
-------
-* The 2.1.x compiler has compiler support WinCE.
-* ARM and i386 (old WinCE emulator) CPUs are supported.
-* The following platforms are supported: 
-  * Pocket PC 2002 – WinCE version: 3.0 
-  * Pocket PC 2003 – WinCE version: 4.20 
-  * Pocket PC 2003 Second Edition – WinCE version: 4.21 
-* Base units are complete.
-* Windows unit is almost complete. Delphi compatible declarations is not ready.
-
-Building
---------
-* You need cross binutils for arm-wince, get them fromftp://ftp.freepascal.org/pub/fpc/contrib/cross/arm-wince-binutils.zip for Win32.
-* Extract them to some dir in the path on your machine.
-* Get the 2.1 source repository from SVN: http://www.freepascal.org/develop.html#svn
-* Go to fpc/compiler and execute: 
-  make cycle CPU_TARGET=arm OS_TARGET=wince
-
-You should end with the units compiled to fpc/rtl/units/arm-wince and a ppccrossarm.exe in fpc/compiler. Copy them to locations fitting your fpc installation.
-
-WinCE port notes
-----------------
-* chdir procedure always produces an error (WinCE does not support setting of current directory).
-* All file/dir paths must be absolute (started with \).
-* WinCE is unicode OS. All string parameters to API calls must be PWideChar.
-* WinCE does not have support for environment strings.
-* WinCE does not have support for console applications by default. But you can install console support by yourself. Please note that FPC creates GUI applications for WinCE target by default. To create console application you should use -WC compiler switch or put {$APPTYPE CONSOLE} directive to source code.<br>To enable console in WinCE install one of the following programs:
-
-  - PocketCMD by SymbolicTools. It is recommended solution. Get it here: http://www.symbolictools.de/public/pocketconsole/applications/PocketCMD
-
-  - PPC Command Shell from Microsoft Windows Mobile Developer Power Toys. Get it here: http://www.microsoft.com/downloads/details.aspx?FamilyID=74473fd6-1dcc-47aa-ab28-6a2b006edfe9&displaylang=en
-
-PPC Command Shell have less features than PocketCMD. Also it have some issues. One of them - a new console window is opened even if an application is started from a console command prompt.
-
-Links
------
-* WinCE Port page at Free Pascal Wiki: http://www.freepascal.org/wiki/index.php/WinCE_port
-* Useful WinCE info: http://www.rainer-keuchel.de/documents.html
-
-Contacts
---------
-Write any questions regarding WinCE port to Yury Sidorov [email protected]
+WinCE port
+==========
+
+WinCE port is quite complete and usable. The port was started and maintained by Yury Sidorov. Oliver (Oro06) ported WinCE API headers.
+
+Status
+------
+* The 2.1.x compiler has compiler support WinCE.
+* ARM and i386 (old WinCE emulator) CPUs are supported.
+* The following platforms are supported: 
+  * Pocket PC 2002 – WinCE version: 3.0 
+  * Pocket PC 2003 – WinCE version: 4.20 
+  * Pocket PC 2003 Second Edition – WinCE version: 4.21 
+* Base units are complete.
+* Windows unit is almost complete. Delphi compatible declarations is not ready.
+
+Building
+--------
+* You need cross binutils for arm-wince, get them fromftp://ftp.freepascal.org/pub/fpc/contrib/cross/arm-wince-binutils.zip for Win32.
+* Extract them to some dir in the path on your machine.
+* Get the 2.1 source repository from SVN: http://www.freepascal.org/develop.html#svn
+* Go to fpc/compiler and execute: 
+  make cycle CPU_TARGET=arm OS_TARGET=wince
+
+You should end with the units compiled to fpc/rtl/units/arm-wince and a ppccrossarm.exe in fpc/compiler. Copy them to locations fitting your fpc installation.
+
+WinCE port notes
+----------------
+* chdir procedure always produces an error (WinCE does not support setting of current directory).
+* All file/dir paths must be absolute (started with \).
+* WinCE is unicode OS. All string parameters to API calls must be PWideChar.
+* WinCE does not have support for environment strings.
+* WinCE does not have support for console applications by default. But you can install console support by yourself. Please note that FPC creates GUI applications for WinCE target by default. To create console application you should use -WC compiler switch or put {$APPTYPE CONSOLE} directive to source code.<br>To enable console in WinCE install one of the following programs:
+
+  - PocketCMD by SymbolicTools. It is recommended solution. Get it here: http://www.symbolictools.de/public/pocketconsole/applications/PocketCMD
+
+  - PPC Command Shell from Microsoft Windows Mobile Developer Power Toys. Get it here: http://www.microsoft.com/downloads/details.aspx?FamilyID=74473fd6-1dcc-47aa-ab28-6a2b006edfe9&displaylang=en
+
+PPC Command Shell have less features than PocketCMD. Also it have some issues. One of them - a new console window is opened even if an application is started from a console command prompt.
+
+Links
+-----
+* WinCE Port page at Free Pascal Wiki: http://www.freepascal.org/wiki/index.php/WinCE_port
+* Useful WinCE info: http://www.rainer-keuchel.de/documents.html
+
+Contacts
+--------
+Write any questions regarding WinCE port to Yury Sidorov [email protected]

rtl/wince/sysutils.pp

@@ -1,991 +1,991 @@
-{
-
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2005 by Florian Klaempfl and Yury Sidorov
-    members of the Free Pascal development team
-
-    Sysutils unit for wince
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit sysutils;
-interface
-
-{$MODE objfpc}
-{ force ansistrings }
-{$H+}
-
-uses
-  dos,
-  windows;
-
-{$DEFINE HAS_SLEEP}
-{$DEFINE HAS_OSERROR}
-{$DEFINE HAS_OSCONFIG}
-{$DEFINE HAS_TEMPDIR}
-
-{ Include platform independent interface part }
-{$i sysutilh.inc}
-
-type
-  TSystemTime = Windows.TSystemTime;
-  
-  EWinCEError = class(Exception)
-  public
-    ErrorCode : DWORD;
-  end;
-
-
-Var
-  WinCEPlatform : Longint;
-  WinCEMajorVersion,
-  WinCEMinorVersion,
-  WinCEBuildNumber   : dword;
-  WinCECSDVersion    : ShortString;   // CSD record is 128 bytes only?
-
-
-implementation
-
-  uses
-    sysconst;
-
-{$DEFINE FPC_NOGENERICANSIROUTINES}
-{$define HASEXPANDUNCFILENAME}
-
-{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
-{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
-
-{ Include platform independent implementation part }
-{$i sysutils.inc}
-
-procedure PWideCharToString(const str: PWideChar; out Result: string; strlen: longint = -1);
-var
-  len: longint;
-begin
-  if str^ = #0 then
-    Result:=''
-  else
-  begin
-    while True do begin
-      if strlen <> -1 then
-        len:=(strlen + 1) div SizeOf(WideChar)
-      else
-        len:=WideToAnsiBuf(str, -1, nil, 0);
-      if len > 0 then
-      begin
-        SetLength(Result, len - 1);
-        if (WideToAnsiBuf(str, -1, @Result[1], len) = 0) and (strlen <> -1) then
-        begin
-          strlen:=-1;
-          continue;
-        end;
-      end
-      else
-        Result:='';
-      break;
-    end;
-  end;
-end;
-
-function ExpandUNCFileName (const filename:string) : string;
-{ returns empty string on errors }
-var
-  s    : widestring;
-  size : dword;
-  rc   : dword;
-  buf  : pwidechar;
-begin
-  s := ExpandFileName (filename);
-
-  size := max_path*SizeOf(WideChar);
-  getmem(buf,size);
-
-  try
-    rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
-
-    if rc=ERROR_MORE_DATA then
-      begin
-        buf:=reallocmem(buf,size);
-        rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
-      end;
-    if rc = NO_ERROR then
-      Result := PRemoteNameInfo(buf)^.lpUniversalName
-    else if rc = ERROR_NOT_CONNECTED then
-      Result := filename
-    else
-      Result := '';
-  finally
-    freemem(buf);
-  end;
-end;
-
-{****************************************************************************
-                              File Functions
-****************************************************************************}
-
-Function FileOpen (Const FileName : string; Mode : Integer) : THandle;
-const
-  AccessMode: array[0..2] of Cardinal  = (
-    GENERIC_READ,
-    GENERIC_WRITE,
-    GENERIC_READ or GENERIC_WRITE);
-  ShareMode: array[0..4] of Integer = (
-               0,
-               0,
-               FILE_SHARE_READ,
-               FILE_SHARE_WRITE,
-               FILE_SHARE_READ or FILE_SHARE_WRITE);
-var
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(FileName);
-  result := CreateFile(fn, dword(AccessMode[Mode and 3]),
-                       dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
-                       FILE_ATTRIBUTE_NORMAL, 0);
-  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
-  FreeMem(fn);
-end;
-
-
-Function FileCreate (Const FileName : String) : THandle;
-var
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(FileName);
-  Result := CreateFile(fn, GENERIC_READ or GENERIC_WRITE,
-                       0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
-  FreeMem(fn);
-end;
-
-
-Function FileCreate (Const FileName : String; Mode:longint) : THandle;
-begin
-  FileCreate:=FileCreate(FileName);
-end;
-
-
-Function FileRead (Handle : THandle; Var Buffer; Count : longint) : Longint;
-Var
-  res : dword;
-begin
-  if ReadFile(Handle, Buffer, Count, res, nil) then
-   FileRead:=Res
-  else
-   FileRead:=-1;
-end;
-
-
-Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
-Var
-  Res : dword;
-begin
-  if WriteFile(Handle, Buffer, Count, Res, nil) then
-   FileWrite:=Res
-  else
-   FileWrite:=-1;
-end;
-
-
-Function FileSeek (Handle : THandle;FOffset,Origin : Longint) : Longint;
-begin
-  Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
-end;
-
-
-Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
-begin
-  Result := SetFilePointer(Handle, longint(FOffset), nil, longint(Origin));
-end;
-
-
-Procedure FileClose (Handle : THandle);
-begin
-  if Handle<=4 then
-   exit;
-  CloseHandle(Handle);
-end;
-
-
-Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
-begin
-  if FileSeek (Handle, Size, FILE_BEGIN) = Size then
-   Result:=SetEndOfFile(handle)
-  else
-   Result := false;
-end;
-
-
-Function DosToWinTime (DTime:longint; out Wtime : TFileTime):longbool;
-begin
-  DosToWinTime:=dos.DosToWinTime(DTime, Wtime);
-end;
-
-
-Function WinToDosTime (Const Wtime : TFileTime; out DTime:longint):longbool;
-begin
-  WinToDosTime:=dos.WinToDosTime(Wtime, DTime);
-end;
-
-
-Function FileAge (Const FileName : String): Longint;
-var
-  Handle: THandle;
-  FindData: TWin32FindData;
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(FileName);
-  Handle := FindFirstFile(fn, FindData);
-  FreeMem(fn);
-  if Handle <> INVALID_HANDLE_VALUE then
-    begin
-      Windows.FindClose(Handle);
-      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-        If WinToDosTime(FindData.ftLastWriteTime,Result) then
-          exit;
-    end;
-  Result := -1;
-end;
-
-
-Function FileExists (Const FileName : String) : Boolean;
-var
-  Attr:Dword;
-begin
-  Attr:=FileGetAttr(FileName);
-  if Attr <> $ffffffff then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
-  else
-    Result:=False;
-end;
-
-
-Function DirectoryExists (Const Directory : String) : Boolean;
-var
-  Attr:Dword;
-begin
-  Attr:=FileGetAttr(Directory);
-  if Attr <> $ffffffff then
-    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0
-  else
-    Result:=False;
-end;
-
-
-Function FindMatch(var f: TSearchRec) : Longint;
-begin
-  { Find file with correct attribute }
-  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
-   begin
-     if not FindNextFile (F.FindHandle,F.FindData) then
-      begin
-        Result:=GetLastError;
-        exit;
-      end;
-   end;
-  { Convert some attributes back }
-  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
-  f.size:=F.FindData.NFileSizeLow;
-  f.attr:=F.FindData.dwFileAttributes;
-  PWideCharToString(@F.FindData.cFileName[0], f.Name);
-  Result:=0;
-end;
-
-
-Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
-var
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(Path);
-  Rslt.Name:=Path;
-  Rslt.Attr:=attr;
-  Rslt.ExcludeAttr:=(not Attr) and ($1e);
-                 { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
-  { FindFirstFile is a WinCE Call }
-  Rslt.FindHandle:=FindFirstFile (fn, Rslt.FindData);
-  FreeMem(fn);
-  If Rslt.FindHandle=Invalid_Handle_value then
-   begin
-     Result:=GetLastError;
-     exit;
-   end;
-  { Find file with correct attribute }
-  Result:=FindMatch(Rslt);
-end;
-
-
-Function FindNext (Var Rslt : TSearchRec) : Longint;
-begin
-  if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
-    Result := FindMatch(Rslt)
-  else
-    Result := GetLastError;
-end;
-
-
-Procedure FindClose (Var F : TSearchrec);
-begin
-   if F.FindHandle <> INVALID_HANDLE_VALUE then
-    Windows.FindClose(F.FindHandle);
-end;
-
-
-Function FileGetDate (Handle : THandle) : Longint;
-Var
-  FT : TFileTime;
-begin
-  If GetFileTime(Handle,nil,nil,@ft) and
-     WinToDosTime(FT, Result) then
-    exit;
-  Result:=-1;
-end;
-
-
-Function FileSetDate (Handle : THandle;Age : Longint) : Longint;
-Var
-  FT: TFileTime;
-begin
-  Result := 0;
-  if DosToWinTime(Age, FT) and SetFileTime(Handle, FT, FT, FT) then
-    Exit;
-  Result := GetLastError;
-end;
-
-
-Function FileGetAttr (Const FileName : String) : Longint;
-var
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(FileName);
-  Result:=GetFileAttributes(fn);
-  FreeMem(fn);
-end;
-
-
-Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-var
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(FileName);
-  if not SetFileAttributes(fn, Attr) then
-    Result := GetLastError
-  else
-    Result:=0;
-  FreeMem(fn);
-end;
-
-
-Function DeleteFile (Const FileName : String) : Boolean;
-var
-  fn: PWideChar;
-begin
-  fn:=StringToPWideChar(FileName);
-  DeleteFile:=Windows.DeleteFile(fn);
-  FreeMem(fn);
-end;
-
-
-Function RenameFile (Const OldName, NewName : String) : Boolean;
-var
-  fold, fnew: PWideChar;
-begin
-  fold:=StringToPWideChar(OldName);
-  fnew:=StringToPWideChar(NewName);
-  Result := MoveFile(fold, fnew);
-  FreeMem(fnew);
-  FreeMem(fold);
-end;
-
-
-{****************************************************************************
-                              Disk Functions
-****************************************************************************}
-
-function diskfree(drive : byte) : int64;
-begin
-  Result := Dos.diskfree(drive);
-end;
-
-
-function disksize(drive : byte) : int64;
-begin
-  Result := Dos.disksize(drive);
-end;
-
-
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-{****************************************************************************
-                              Time Functions
-****************************************************************************}
-
-
-Procedure GetLocalTime(var SystemTime: TSystemTime);
-Var
-  Syst : Windows.TSystemtime;
-begin
-  windows.Getlocaltime(@syst);
-  SystemTime.year:=syst.wYear;
-  SystemTime.month:=syst.wMonth;
-  SystemTime.day:=syst.wDay;
-  SystemTime.hour:=syst.wHour;
-  SystemTime.minute:=syst.wMinute;
-  SystemTime.second:=syst.wSecond;
-  SystemTime.millisecond:=syst.wMilliSeconds;
-end;
-
-
-{****************************************************************************
-                              Misc Functions
-****************************************************************************}
-
-procedure Beep;
-begin
-  MessageBeep(0);
-end;
-
-
-{****************************************************************************
-                              Locale Functions
-****************************************************************************}
-
-Procedure InitAnsi;
-Var
-  i : longint;
-begin
-  {  Fill table entries 0 to 127  }
-  for i := 0 to 96 do
-    UpperCaseTable[i] := chr(i);
-  for i := 97 to 122 do
-    UpperCaseTable[i] := chr(i - 32);
-  for i := 123 to 191 do
-    UpperCaseTable[i] := chr(i);
-  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
-  for i := 0 to 64 do
-    LowerCaseTable[i] := chr(i);
-  for i := 65 to 90 do
-    LowerCaseTable[i] := chr(i + 32);
-  for i := 91 to 191 do
-    LowerCaseTable[i] := chr(i);
-  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-end;
-
-
-function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
-var
-  L: Integer;
-  Buf: array[0..255] of WideChar;
-  s: widestring;
-begin
-  L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf) div SizeOf(WideChar));
-  if L > 0 then
-  begin
-    SetString(s, Buf, L - 1);
-    Result:=s;
-  end
-  else
-    Result := Def;
-end;
-
-
-function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
-var
-  Buf: array[0..1] of WideChar;
-  Buf2: array[0..1] of Char;
-begin
-  if GetLocaleInfo(LID, LT, Buf, 2) > 0 then
-  begin
-    WideToAnsiBuf(Buf, -1, Buf2, SizeOf(Buf2));
-    Result := Buf2[0];
-  end
-  else
-    Result := Def;
-end;
-
-
-Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
-Var
-  S: String;
-  C: Integer;
-Begin
-  S:=GetLocaleStr(LID,TP,'0');
-  Val(S,Result,C);
-  If C<>0 Then
-    Result:=Def;
-End;
-
-
-procedure GetFormatSettings;
-var
-  HF  : Shortstring;
-  LID : LCID;
-  I,Day,DateOrder : longint;
-begin
-  LID := GetUserDefaultLCID;
-  { Date stuff }
-  for I := 1 to 12 do
-    begin
-    ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
-    LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
-    end;
-  for I := 1 to 7 do
-    begin
-    Day := (I + 5) mod 7;
-    ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
-    LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
-    end;
-  DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
-  DateOrder := GetLocaleInt(LID, LOCALE_IDate, 0);
-  Case DateOrder Of
-     1: Begin
-        ShortDateFormat := 'dd/mm/yyyy';
-        LongDateFormat := 'dddd, d. mmmm yyyy';
-        End;
-     2: Begin
-        ShortDateFormat := 'yyyy/mm/dd';
-        LongDateFormat := 'dddd, yyyy mmmm d.';
-        End;
-  else
-    // Default american settings...
-    ShortDateFormat := 'mm/dd/yyyy';
-    LongDateFormat := 'dddd, mmmm d. yyyy';
-  End;
-  { Time stuff }
-  TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
-  TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
-  TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
-  if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
-    HF:='h'
-  else
-    HF:='hh';
-  // No support for 12 hour stuff at the moment...
-  ShortTimeFormat := HF+':nn';
-  LongTimeFormat := HF + ':nn:ss';
-  { Currency stuff }
-  CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
-  CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
-  NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
-  { Number stuff }
-  ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
-  DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
-  CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
-end;
-
-
-Procedure InitInternational;
-begin
-  InitInternationalGeneric;
-  SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
-  SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
-  InitAnsi;
-  GetFormatSettings;
-end;
-
-
-{****************************************************************************
-                           Target Dependent
-****************************************************************************}
-
-function SysErrorMessage(ErrorCode: Integer): String;
-var
-  MsgBuffer: PWideChar;
-  len: longint;
-begin
-  len:=FormatMessage(
-         FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS,
-         nil,
-         ErrorCode,
-         0,
-         PWideChar(@MsgBuffer),    { This function allocs the memory (in this case you pass a PPwidechar)}
-         0,
-         nil);
-  while (len > 0) and (MsgBuffer[len - 1] <= #32) do
-    Dec(len);
-  MsgBuffer[len]:=#0;
-  PWideCharToString(PWideChar(MsgBuffer), Result);
-  LocalFree(HLOCAL(MsgBuffer));
-end;
-
-{****************************************************************************
-                              Initialization code
-****************************************************************************}
-
-// WinCE does not have environment. It can be emulated via registry or file. (YS)
-
-Function GetEnvironmentVariable(Const EnvVar : String) : String;
-begin
-  Result := '';
-end;
-
-Function GetEnvironmentVariableCount : Integer;
-begin
-  Result := 0;
-end;
-
-Function GetEnvironmentString(Index : Integer) : String;
-begin
-  Result := '';
-end;
-
-
-function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
-var
-  PI: TProcessInformation;
-  Proc : THandle;
-  l    : DWord;
-  e : EOSError;
-
-begin
-  DosError := 0;
-  if not CreateProcess(PWideChar(widestring(Path)), PWideChar(widestring(ComLine)),
-                       nil, nil, FALSE, 0, nil, nil, nil, PI) then
-    begin
-      e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]);
-      e.ErrorCode:=GetLastError;
-      raise e;
-    end;
-  Proc:=PI.hProcess;
-  CloseHandle(PI.hThread);
-  if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
-    begin
-      GetExitCodeProcess(Proc,l);
-      CloseHandle(Proc);
-      result:=l;
-    end
-  else
-    begin
-      e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]);
-      e.ErrorCode:=GetLastError;
-      CloseHandle(Proc);
-      raise e;
-    end;
-end;
-
-function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
-
-Var
-  CommandLine : AnsiString;
-  i : Integer;
-
-Begin
-  Commandline:='';
-  For i:=0 to high(ComLine) Do
-   Commandline:=CommandLine+' '+Comline[i];
-  ExecuteProcess:=ExecuteProcess(Path,CommandLine);
-End;
-
-Procedure Sleep(Milliseconds : Cardinal);
-
-begin
-  Windows.Sleep(MilliSeconds)
-end;
-
-Function GetLastOSError : Integer;
-
-begin
-  Result:=GetLastError;
-end;
-
-{****************************************************************************
-                              Initialization code
-****************************************************************************}
-
-Procedure LoadVersionInfo;
-Var
-   versioninfo : TOSVERSIONINFO;
-   i          : Integer;
-
-begin
-  versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
-  GetVersionEx(versioninfo);
-  WinCEPlatform:=versionInfo.dwPlatformId;
-  WinCEMajorVersion:=versionInfo.dwMajorVersion;
-  WinCEMinorVersion:=versionInfo.dwMinorVersion;
-  WinCEBuildNumber:=versionInfo.dwBuildNumber;
-  i:=WideToAnsiBuf(@versioninfo.szCSDVersion[0], -1, @WinCECSDVersion[1], SizeOf(WinCECSDVersion) - 1);
-  if i <> 0 then
-    WinCECSDVersion[0]:=chr(i - 1);
-end;
-
-Function GetSpecialDir(ID: Integer) : String;
-
-Var
-  APath : array[0..MAX_PATH] of WideChar;
-begin
-  if SHGetSpecialFolderPath(0, APath, ID, True) then
-  begin
-    PWideCharToString(APath, Result);
-    Result:=IncludeTrailingPathDelimiter(Result);
-  end
-  else
-    Result:='';
-end;
-
-Function GetAppConfigDir(Global : Boolean) : String;
-
-begin
-  If Global then
-    Result:=DGetAppConfigDir(Global) // or use windows dir ??
-  else
-    begin
-    Result:=GetSpecialDir(CSIDL_APPDATA)+ApplicationName;
-    If (Result='') then
-      Result:=DGetAppConfigDir(Global);
-    end;
-end;
-
-Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
-
-begin
-  if Global then
-    begin
-    Result:=IncludeTrailingPathDelimiter(DGetAppConfigDir(Global));
-    if SubDir then
-      Result:=IncludeTrailingPathDelimiter(Result+'Config');
-    Result:=Result+ApplicationName+ConfigExtension;
-    end
-  else
-    begin
-    Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
-    if SubDir then
-      Result:=Result+'Config\';
-    Result:=Result+ApplicationName+ConfigExtension;
-    end;
-end;
-
-Function GetTempDir(Global : Boolean) : String;
-var
-  buf: widestring;
-begin
-  SetLength(buf, MAX_PATH);
-  SetLength(buf, GetTempPath(Length(buf) + 1, PWideChar(buf)));
-  Result:=buf;
-end;
-
-{****************************************************************************
-                    Target Dependent WideString stuff
-****************************************************************************}
-
-
-function WinCECompareWideString(const s1, s2 : WideString) : PtrInt;
-begin
-  SetLastError(0);
-  Result:=CompareString(LOCALE_USER_DEFAULT,0,pwidechar(s1),
-    length(s1),pwidechar(s2),length(s2))-2;
-  if GetLastError<>0 then
-    RaiseLastOSError;
-end;
-
-
-function WinCECompareTextWideString(const s1, s2 : WideString) : PtrInt;
-begin
-  SetLastError(0);
-  Result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,pwidechar(s1),
-    length(s1),pwidechar(s2),length(s2))-2;
-  if GetLastError<>0 then
-    RaiseLastOSError;
-end;
-
-
-function WinCEAnsiUpperCase(const s: string): string;
-var
-  buf: PWideChar;
-  len: longint;
-begin
-  if s <> '' then
-  begin
-    buf:=StringToPWideChar(s, @len);
-    CharUpperBuff(buf, len);
-    PWideCharToString(buf, Result, len);
-    FreeMem(buf);
-  end
-  else
-    Result:='';
-end;
-
-
-function WinCEAnsiLowerCase(const s: string): string;
-var
-  buf: PWideChar;
-  len: longint;
-begin
-  if s <> '' then
-  begin
-    buf:=StringToPWideChar(s, @len);
-    CharLowerBuff(buf, len);
-    PWideCharToString(buf, Result, len);
-    FreeMem(buf);
-  end
-  else
-    Result:='';
-end;
-
-
-function WinCEAnsiCompareStr(const S1, S2: string): PtrInt;
-var
-  ws1, ws2: PWideChar;
-begin
-  ws1:=StringToPWideChar(S1);
-  ws2:=StringToPWideChar(S2);
-  Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, Length(S1), ws2, Length(S2)) - 2;
-  FreeMem(ws2);
-  FreeMem(ws1);
-end;
-
-
-function WinCEAnsiCompareText(const S1, S2: string): PtrInt;
-var
-  ws1, ws2: PWideChar;
-begin
-  ws1:=StringToPWideChar(S1);
-  ws2:=StringToPWideChar(S2);
-  Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, Length(S1), ws2, Length(S2)) - 2;
-  FreeMem(ws2);
-  FreeMem(ws1);
-end;
-
-function WinCEAnsiStrComp(S1, S2: PChar): PtrInt;
-var
-  ws1, ws2: PWideChar;
-begin
-  ws1:=PCharToPWideChar(S1);
-  ws2:=PCharToPWideChar(S2);
-  Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, -1, ws2, -1) - 2;
-  FreeMem(ws2);
-  FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrIComp(S1, S2: PChar): PtrInt;
-var
-  ws1, ws2: PWideChar;
-begin
-  ws1:=PCharToPWideChar(S1);
-  ws2:=PCharToPWideChar(S2);
-  Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, -1, ws2, -1) - 2;
-  FreeMem(ws2);
-  FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-var
-  ws1, ws2: PWideChar;
-  len1, len2: longint;
-begin
-  ws1:=PCharToPWideChar(S1, MaxLen, @len1);
-  ws2:=PCharToPWideChar(S2, MaxLen, @len2);
-  Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, len1, ws2, len2) - 2;
-  FreeMem(ws2);
-  FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-var
-  ws1, ws2: PWideChar;
-  len1, len2: longint;
-begin
-  ws1:=PCharToPWideChar(S1, MaxLen, @len1);
-  ws2:=PCharToPWideChar(S2, MaxLen, @len2);
-  Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, len1, ws2, len2) - 2;
-  FreeMem(ws2);
-  FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrLower(Str: PChar): PChar;
-var
-  buf: PWideChar;
-  len: longint;
-begin
-  buf:=PCharToPWideChar(Str, -1, @len);
-  CharLowerBuff(buf, len);
-  Result:=Str;
-  WideToAnsiBuf(buf, -1, Result, len + 1);
-  FreeMem(buf);
-end;
-
-
-function WinCEAnsiStrUpper(Str: PChar): PChar;
-var
-  buf: PWideChar;
-  len: longint;
-begin
-  buf:=PCharToPWideChar(Str, -1, @len);
-  CharUpperBuff(buf, len);
-  Result:=Str;
-  WideToAnsiBuf(buf, -1, Result, len + 1);
-  FreeMem(buf);
-end;
-
-
-{ there is a similiar procedure in the system unit which inits the fields which
-  are relevant already for the system unit }
-procedure InitWinCEWidestrings;
-  begin
-    widestringmanager.CompareWideStringProc:=@WinCECompareWideString;
-    widestringmanager.CompareTextWideStringProc:=@WinCECompareTextWideString;
-    
-    widestringmanager.UpperAnsiStringProc:=@WinCEAnsiUpperCase;
-    widestringmanager.LowerAnsiStringProc:=@WinCEAnsiLowerCase;
-    widestringmanager.CompareStrAnsiStringProc:=@WinCEAnsiCompareStr;
-    widestringmanager.CompareTextAnsiStringProc:=@WinCEAnsiCompareText;
-    widestringmanager.StrCompAnsiStringProc:=@WinCEAnsiStrComp;
-    widestringmanager.StrICompAnsiStringProc:=@WinCEAnsiStrIComp;
-    widestringmanager.StrLCompAnsiStringProc:=@WinCEAnsiStrLComp;
-    widestringmanager.StrLICompAnsiStringProc:=@WinCEAnsiStrLIComp;
-    widestringmanager.StrLowerAnsiStringProc:=@WinCEAnsiStrLower;
-    widestringmanager.StrUpperAnsiStringProc:=@WinCEAnsiStrUpper;
-  end;
-
-
-
-Initialization
-  InitWinCEWidestrings;
-  InitExceptions;       { Initialize exceptions. OS independent }
-  InitInternational;    { Initialize internationalization settings }
-  LoadVersionInfo;
-  SysConfigDir:='\Windows';
-
-Finalization
-  DoneExceptions;
-
-end.
+{
+
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2005 by Florian Klaempfl and Yury Sidorov
+    members of the Free Pascal development team
+
+    Sysutils unit for wince
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+  dos,
+  windows;
+
+{$DEFINE HAS_SLEEP}
+{$DEFINE HAS_OSERROR}
+{$DEFINE HAS_OSCONFIG}
+{$DEFINE HAS_TEMPDIR}
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+type
+  TSystemTime = Windows.TSystemTime;
+  
+  EWinCEError = class(Exception)
+  public
+    ErrorCode : DWORD;
+  end;
+
+
+Var
+  WinCEPlatform : Longint;
+  WinCEMajorVersion,
+  WinCEMinorVersion,
+  WinCEBuildNumber   : dword;
+  WinCECSDVersion    : ShortString;   // CSD record is 128 bytes only?
+
+
+implementation
+
+  uses
+    sysconst;
+
+{$DEFINE FPC_NOGENERICANSIROUTINES}
+{$define HASEXPANDUNCFILENAME}
+
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+procedure PWideCharToString(const str: PWideChar; out Result: string; strlen: longint = -1);
+var
+  len: longint;
+begin
+  if str^ = #0 then
+    Result:=''
+  else
+  begin
+    while True do begin
+      if strlen <> -1 then
+        len:=(strlen + 1) div SizeOf(WideChar)
+      else
+        len:=WideToAnsiBuf(str, -1, nil, 0);
+      if len > 0 then
+      begin
+        SetLength(Result, len - 1);
+        if (WideToAnsiBuf(str, -1, @Result[1], len) = 0) and (strlen <> -1) then
+        begin
+          strlen:=-1;
+          continue;
+        end;
+      end
+      else
+        Result:='';
+      break;
+    end;
+  end;
+end;
+
+function ExpandUNCFileName (const filename:string) : string;
+{ returns empty string on errors }
+var
+  s    : widestring;
+  size : dword;
+  rc   : dword;
+  buf  : pwidechar;
+begin
+  s := ExpandFileName (filename);
+
+  size := max_path*SizeOf(WideChar);
+  getmem(buf,size);
+
+  try
+    rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
+
+    if rc=ERROR_MORE_DATA then
+      begin
+        buf:=reallocmem(buf,size);
+        rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
+      end;
+    if rc = NO_ERROR then
+      Result := PRemoteNameInfo(buf)^.lpUniversalName
+    else if rc = ERROR_NOT_CONNECTED then
+      Result := filename
+    else
+      Result := '';
+  finally
+    freemem(buf);
+  end;
+end;
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : THandle;
+const
+  AccessMode: array[0..2] of Cardinal  = (
+    GENERIC_READ,
+    GENERIC_WRITE,
+    GENERIC_READ or GENERIC_WRITE);
+  ShareMode: array[0..4] of Integer = (
+               0,
+               0,
+               FILE_SHARE_READ,
+               FILE_SHARE_WRITE,
+               FILE_SHARE_READ or FILE_SHARE_WRITE);
+var
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(FileName);
+  result := CreateFile(fn, dword(AccessMode[Mode and 3]),
+                       dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
+                       FILE_ATTRIBUTE_NORMAL, 0);
+  //if fail api return feInvalidHandle (INVALIDE_HANDLE=feInvalidHandle=-1)
+  FreeMem(fn);
+end;
+
+
+Function FileCreate (Const FileName : String) : THandle;
+var
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(FileName);
+  Result := CreateFile(fn, GENERIC_READ or GENERIC_WRITE,
+                       0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+  FreeMem(fn);
+end;
+
+
+Function FileCreate (Const FileName : String; Mode:longint) : THandle;
+begin
+  FileCreate:=FileCreate(FileName);
+end;
+
+
+Function FileRead (Handle : THandle; Var Buffer; Count : longint) : Longint;
+Var
+  res : dword;
+begin
+  if ReadFile(Handle, Buffer, Count, res, nil) then
+   FileRead:=Res
+  else
+   FileRead:=-1;
+end;
+
+
+Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
+Var
+  Res : dword;
+begin
+  if WriteFile(Handle, Buffer, Count, Res, nil) then
+   FileWrite:=Res
+  else
+   FileWrite:=-1;
+end;
+
+
+Function FileSeek (Handle : THandle;FOffset,Origin : Longint) : Longint;
+begin
+  Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
+end;
+
+
+Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
+begin
+  Result := SetFilePointer(Handle, longint(FOffset), nil, longint(Origin));
+end;
+
+
+Procedure FileClose (Handle : THandle);
+begin
+  if Handle<=4 then
+   exit;
+  CloseHandle(Handle);
+end;
+
+
+Function FileTruncate (Handle : THandle;Size: Int64) : boolean;
+begin
+  if FileSeek (Handle, Size, FILE_BEGIN) = Size then
+   Result:=SetEndOfFile(handle)
+  else
+   Result := false;
+end;
+
+
+Function DosToWinTime (DTime:longint; out Wtime : TFileTime):longbool;
+begin
+  DosToWinTime:=dos.DosToWinTime(DTime, Wtime);
+end;
+
+
+Function WinToDosTime (Const Wtime : TFileTime; out DTime:longint):longbool;
+begin
+  WinToDosTime:=dos.WinToDosTime(Wtime, DTime);
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+var
+  Handle: THandle;
+  FindData: TWin32FindData;
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(FileName);
+  Handle := FindFirstFile(fn, FindData);
+  FreeMem(fn);
+  if Handle <> INVALID_HANDLE_VALUE then
+    begin
+      Windows.FindClose(Handle);
+      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
+        If WinToDosTime(FindData.ftLastWriteTime,Result) then
+          exit;
+    end;
+  Result := -1;
+end;
+
+
+Function FileExists (Const FileName : String) : Boolean;
+var
+  Attr:Dword;
+begin
+  Attr:=FileGetAttr(FileName);
+  if Attr <> $ffffffff then
+    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
+  else
+    Result:=False;
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+var
+  Attr:Dword;
+begin
+  Attr:=FileGetAttr(Directory);
+  if Attr <> $ffffffff then
+    Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0
+  else
+    Result:=False;
+end;
+
+
+Function FindMatch(var f: TSearchRec) : Longint;
+begin
+  { Find file with correct attribute }
+  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
+   begin
+     if not FindNextFile (F.FindHandle,F.FindData) then
+      begin
+        Result:=GetLastError;
+        exit;
+      end;
+   end;
+  { Convert some attributes back }
+  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
+  f.size:=F.FindData.NFileSizeLow;
+  f.attr:=F.FindData.dwFileAttributes;
+  PWideCharToString(@F.FindData.cFileName[0], f.Name);
+  Result:=0;
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
+var
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(Path);
+  Rslt.Name:=Path;
+  Rslt.Attr:=attr;
+  Rslt.ExcludeAttr:=(not Attr) and ($1e);
+                 { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
+  { FindFirstFile is a WinCE Call }
+  Rslt.FindHandle:=FindFirstFile (fn, Rslt.FindData);
+  FreeMem(fn);
+  If Rslt.FindHandle=Invalid_Handle_value then
+   begin
+     Result:=GetLastError;
+     exit;
+   end;
+  { Find file with correct attribute }
+  Result:=FindMatch(Rslt);
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+begin
+  if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
+    Result := FindMatch(Rslt)
+  else
+    Result := GetLastError;
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+begin
+   if F.FindHandle <> INVALID_HANDLE_VALUE then
+    Windows.FindClose(F.FindHandle);
+end;
+
+
+Function FileGetDate (Handle : THandle) : Longint;
+Var
+  FT : TFileTime;
+begin
+  If GetFileTime(Handle,nil,nil,@ft) and
+     WinToDosTime(FT, Result) then
+    exit;
+  Result:=-1;
+end;
+
+
+Function FileSetDate (Handle : THandle;Age : Longint) : Longint;
+Var
+  FT: TFileTime;
+begin
+  Result := 0;
+  if DosToWinTime(Age, FT) and SetFileTime(Handle, FT, FT, FT) then
+    Exit;
+  Result := GetLastError;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+var
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(FileName);
+  Result:=GetFileAttributes(fn);
+  FreeMem(fn);
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(FileName);
+  if not SetFileAttributes(fn, Attr) then
+    Result := GetLastError
+  else
+    Result:=0;
+  FreeMem(fn);
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+var
+  fn: PWideChar;
+begin
+  fn:=StringToPWideChar(FileName);
+  DeleteFile:=Windows.DeleteFile(fn);
+  FreeMem(fn);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+var
+  fold, fnew: PWideChar;
+begin
+  fold:=StringToPWideChar(OldName);
+  fnew:=StringToPWideChar(NewName);
+  Result := MoveFile(fold, fnew);
+  FreeMem(fnew);
+  FreeMem(fold);
+end;
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+function diskfree(drive : byte) : int64;
+begin
+  Result := Dos.diskfree(drive);
+end;
+
+
+function disksize(drive : byte) : int64;
+begin
+  Result := Dos.disksize(drive);
+end;
+
+
+Function GetCurrentDir : String;
+begin
+  GetDir(0, result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+  {$I-}
+   ChDir(NewDir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+  {$I-}
+   MkDir(NewDir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+  {$I-}
+   RmDir(Dir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+                              Time Functions
+****************************************************************************}
+
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+Var
+  Syst : Windows.TSystemtime;
+begin
+  windows.Getlocaltime(@syst);
+  SystemTime.year:=syst.wYear;
+  SystemTime.month:=syst.wMonth;
+  SystemTime.day:=syst.wDay;
+  SystemTime.hour:=syst.wHour;
+  SystemTime.minute:=syst.wMinute;
+  SystemTime.second:=syst.wSecond;
+  SystemTime.millisecond:=syst.wMilliSeconds;
+end;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+  MessageBeep(0);
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+Procedure InitAnsi;
+Var
+  i : longint;
+begin
+  {  Fill table entries 0 to 127  }
+  for i := 0 to 96 do
+    UpperCaseTable[i] := chr(i);
+  for i := 97 to 122 do
+    UpperCaseTable[i] := chr(i - 32);
+  for i := 123 to 191 do
+    UpperCaseTable[i] := chr(i);
+  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+  for i := 0 to 64 do
+    LowerCaseTable[i] := chr(i);
+  for i := 65 to 90 do
+    LowerCaseTable[i] := chr(i + 32);
+  for i := 91 to 191 do
+    LowerCaseTable[i] := chr(i);
+  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
+var
+  L: Integer;
+  Buf: array[0..255] of WideChar;
+  s: widestring;
+begin
+  L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf) div SizeOf(WideChar));
+  if L > 0 then
+  begin
+    SetString(s, Buf, L - 1);
+    Result:=s;
+  end
+  else
+    Result := Def;
+end;
+
+
+function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
+var
+  Buf: array[0..1] of WideChar;
+  Buf2: array[0..1] of Char;
+begin
+  if GetLocaleInfo(LID, LT, Buf, 2) > 0 then
+  begin
+    WideToAnsiBuf(Buf, -1, Buf2, SizeOf(Buf2));
+    Result := Buf2[0];
+  end
+  else
+    Result := Def;
+end;
+
+
+Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
+Var
+  S: String;
+  C: Integer;
+Begin
+  S:=GetLocaleStr(LID,TP,'0');
+  Val(S,Result,C);
+  If C<>0 Then
+    Result:=Def;
+End;
+
+
+procedure GetFormatSettings;
+var
+  HF  : Shortstring;
+  LID : LCID;
+  I,Day,DateOrder : longint;
+begin
+  LID := GetUserDefaultLCID;
+  { Date stuff }
+  for I := 1 to 12 do
+    begin
+    ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
+    LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
+    end;
+  for I := 1 to 7 do
+    begin
+    Day := (I + 5) mod 7;
+    ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
+    LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
+    end;
+  DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
+  DateOrder := GetLocaleInt(LID, LOCALE_IDate, 0);
+  Case DateOrder Of
+     1: Begin
+        ShortDateFormat := 'dd/mm/yyyy';
+        LongDateFormat := 'dddd, d. mmmm yyyy';
+        End;
+     2: Begin
+        ShortDateFormat := 'yyyy/mm/dd';
+        LongDateFormat := 'dddd, yyyy mmmm d.';
+        End;
+  else
+    // Default american settings...
+    ShortDateFormat := 'mm/dd/yyyy';
+    LongDateFormat := 'dddd, mmmm d. yyyy';
+  End;
+  { Time stuff }
+  TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
+  TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
+  TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
+  if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
+    HF:='h'
+  else
+    HF:='hh';
+  // No support for 12 hour stuff at the moment...
+  ShortTimeFormat := HF+':nn';
+  LongTimeFormat := HF + ':nn:ss';
+  { Currency stuff }
+  CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
+  CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
+  NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
+  { Number stuff }
+  ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
+  DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
+  CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
+end;
+
+
+Procedure InitInternational;
+begin
+  InitInternationalGeneric;
+  SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
+  SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
+  InitAnsi;
+  GetFormatSettings;
+end;
+
+
+{****************************************************************************
+                           Target Dependent
+****************************************************************************}
+
+function SysErrorMessage(ErrorCode: Integer): String;
+var
+  MsgBuffer: PWideChar;
+  len: longint;
+begin
+  len:=FormatMessage(
+         FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS,
+         nil,
+         ErrorCode,
+         0,
+         PWideChar(@MsgBuffer),    { This function allocs the memory (in this case you pass a PPwidechar)}
+         0,
+         nil);
+  while (len > 0) and (MsgBuffer[len - 1] <= #32) do
+    Dec(len);
+  MsgBuffer[len]:=#0;
+  PWideCharToString(PWideChar(MsgBuffer), Result);
+  LocalFree(HLOCAL(MsgBuffer));
+end;
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+// WinCE does not have environment. It can be emulated via registry or file. (YS)
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+begin
+  Result := '';
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+begin
+  Result := 0;
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+begin
+  Result := '';
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
+var
+  PI: TProcessInformation;
+  Proc : THandle;
+  l    : DWord;
+  e : EOSError;
+
+begin
+  DosError := 0;
+  if not CreateProcess(PWideChar(widestring(Path)), PWideChar(widestring(ComLine)),
+                       nil, nil, FALSE, 0, nil, nil, nil, PI) then
+    begin
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]);
+      e.ErrorCode:=GetLastError;
+      raise e;
+    end;
+  Proc:=PI.hProcess;
+  CloseHandle(PI.hThread);
+  if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
+    begin
+      GetExitCodeProcess(Proc,l);
+      CloseHandle(Proc);
+      result:=l;
+    end
+  else
+    begin
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]);
+      e.ErrorCode:=GetLastError;
+      CloseHandle(Proc);
+      raise e;
+    end;
+end;
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
+
+Var
+  CommandLine : AnsiString;
+  i : Integer;
+
+Begin
+  Commandline:='';
+  For i:=0 to high(ComLine) Do
+   Commandline:=CommandLine+' '+Comline[i];
+  ExecuteProcess:=ExecuteProcess(Path,CommandLine);
+End;
+
+Procedure Sleep(Milliseconds : Cardinal);
+
+begin
+  Windows.Sleep(MilliSeconds)
+end;
+
+Function GetLastOSError : Integer;
+
+begin
+  Result:=GetLastError;
+end;
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Procedure LoadVersionInfo;
+Var
+   versioninfo : TOSVERSIONINFO;
+   i          : Integer;
+
+begin
+  versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
+  GetVersionEx(versioninfo);
+  WinCEPlatform:=versionInfo.dwPlatformId;
+  WinCEMajorVersion:=versionInfo.dwMajorVersion;
+  WinCEMinorVersion:=versionInfo.dwMinorVersion;
+  WinCEBuildNumber:=versionInfo.dwBuildNumber;
+  i:=WideToAnsiBuf(@versioninfo.szCSDVersion[0], -1, @WinCECSDVersion[1], SizeOf(WinCECSDVersion) - 1);
+  if i <> 0 then
+    WinCECSDVersion[0]:=chr(i - 1);
+end;
+
+Function GetSpecialDir(ID: Integer) : String;
+
+Var
+  APath : array[0..MAX_PATH] of WideChar;
+begin
+  if SHGetSpecialFolderPath(0, APath, ID, True) then
+  begin
+    PWideCharToString(APath, Result);
+    Result:=IncludeTrailingPathDelimiter(Result);
+  end
+  else
+    Result:='';
+end;
+
+Function GetAppConfigDir(Global : Boolean) : String;
+
+begin
+  If Global then
+    Result:=DGetAppConfigDir(Global) // or use windows dir ??
+  else
+    begin
+    Result:=GetSpecialDir(CSIDL_APPDATA)+ApplicationName;
+    If (Result='') then
+      Result:=DGetAppConfigDir(Global);
+    end;
+end;
+
+Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
+
+begin
+  if Global then
+    begin
+    Result:=IncludeTrailingPathDelimiter(DGetAppConfigDir(Global));
+    if SubDir then
+      Result:=IncludeTrailingPathDelimiter(Result+'Config');
+    Result:=Result+ApplicationName+ConfigExtension;
+    end
+  else
+    begin
+    Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
+    if SubDir then
+      Result:=Result+'Config\';
+    Result:=Result+ApplicationName+ConfigExtension;
+    end;
+end;
+
+Function GetTempDir(Global : Boolean) : String;
+var
+  buf: widestring;
+begin
+  SetLength(buf, MAX_PATH);
+  SetLength(buf, GetTempPath(Length(buf) + 1, PWideChar(buf)));
+  Result:=buf;
+end;
+
+{****************************************************************************
+                    Target Dependent WideString stuff
+****************************************************************************}
+
+
+function WinCECompareWideString(const s1, s2 : WideString) : PtrInt;
+begin
+  SetLastError(0);
+  Result:=CompareString(LOCALE_USER_DEFAULT,0,pwidechar(s1),
+    length(s1),pwidechar(s2),length(s2))-2;
+  if GetLastError<>0 then
+    RaiseLastOSError;
+end;
+
+
+function WinCECompareTextWideString(const s1, s2 : WideString) : PtrInt;
+begin
+  SetLastError(0);
+  Result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,pwidechar(s1),
+    length(s1),pwidechar(s2),length(s2))-2;
+  if GetLastError<>0 then
+    RaiseLastOSError;
+end;
+
+
+function WinCEAnsiUpperCase(const s: string): string;
+var
+  buf: PWideChar;
+  len: longint;
+begin
+  if s <> '' then
+  begin
+    buf:=StringToPWideChar(s, @len);
+    CharUpperBuff(buf, len);
+    PWideCharToString(buf, Result, len);
+    FreeMem(buf);
+  end
+  else
+    Result:='';
+end;
+
+
+function WinCEAnsiLowerCase(const s: string): string;
+var
+  buf: PWideChar;
+  len: longint;
+begin
+  if s <> '' then
+  begin
+    buf:=StringToPWideChar(s, @len);
+    CharLowerBuff(buf, len);
+    PWideCharToString(buf, Result, len);
+    FreeMem(buf);
+  end
+  else
+    Result:='';
+end;
+
+
+function WinCEAnsiCompareStr(const S1, S2: string): PtrInt;
+var
+  ws1, ws2: PWideChar;
+begin
+  ws1:=StringToPWideChar(S1);
+  ws2:=StringToPWideChar(S2);
+  Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, Length(S1), ws2, Length(S2)) - 2;
+  FreeMem(ws2);
+  FreeMem(ws1);
+end;
+
+
+function WinCEAnsiCompareText(const S1, S2: string): PtrInt;
+var
+  ws1, ws2: PWideChar;
+begin
+  ws1:=StringToPWideChar(S1);
+  ws2:=StringToPWideChar(S2);
+  Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, Length(S1), ws2, Length(S2)) - 2;
+  FreeMem(ws2);
+  FreeMem(ws1);
+end;
+
+function WinCEAnsiStrComp(S1, S2: PChar): PtrInt;
+var
+  ws1, ws2: PWideChar;
+begin
+  ws1:=PCharToPWideChar(S1);
+  ws2:=PCharToPWideChar(S2);
+  Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, -1, ws2, -1) - 2;
+  FreeMem(ws2);
+  FreeMem(ws1);
+end;
+
+
+function WinCEAnsiStrIComp(S1, S2: PChar): PtrInt;
+var
+  ws1, ws2: PWideChar;
+begin
+  ws1:=PCharToPWideChar(S1);
+  ws2:=PCharToPWideChar(S2);
+  Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, -1, ws2, -1) - 2;
+  FreeMem(ws2);
+  FreeMem(ws1);
+end;
+
+
+function WinCEAnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+var
+  ws1, ws2: PWideChar;
+  len1, len2: longint;
+begin
+  ws1:=PCharToPWideChar(S1, MaxLen, @len1);
+  ws2:=PCharToPWideChar(S2, MaxLen, @len2);
+  Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, len1, ws2, len2) - 2;
+  FreeMem(ws2);
+  FreeMem(ws1);
+end;
+
+
+function WinCEAnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
+var
+  ws1, ws2: PWideChar;
+  len1, len2: longint;
+begin
+  ws1:=PCharToPWideChar(S1, MaxLen, @len1);
+  ws2:=PCharToPWideChar(S2, MaxLen, @len2);
+  Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, len1, ws2, len2) - 2;
+  FreeMem(ws2);
+  FreeMem(ws1);
+end;
+
+
+function WinCEAnsiStrLower(Str: PChar): PChar;
+var
+  buf: PWideChar;
+  len: longint;
+begin
+  buf:=PCharToPWideChar(Str, -1, @len);
+  CharLowerBuff(buf, len);
+  Result:=Str;
+  WideToAnsiBuf(buf, -1, Result, len + 1);
+  FreeMem(buf);
+end;
+
+
+function WinCEAnsiStrUpper(Str: PChar): PChar;
+var
+  buf: PWideChar;
+  len: longint;
+begin
+  buf:=PCharToPWideChar(Str, -1, @len);
+  CharUpperBuff(buf, len);
+  Result:=Str;
+  WideToAnsiBuf(buf, -1, Result, len + 1);
+  FreeMem(buf);
+end;
+
+
+{ there is a similiar procedure in the system unit which inits the fields which
+  are relevant already for the system unit }
+procedure InitWinCEWidestrings;
+  begin
+    widestringmanager.CompareWideStringProc:=@WinCECompareWideString;
+    widestringmanager.CompareTextWideStringProc:=@WinCECompareTextWideString;
+    
+    widestringmanager.UpperAnsiStringProc:=@WinCEAnsiUpperCase;
+    widestringmanager.LowerAnsiStringProc:=@WinCEAnsiLowerCase;
+    widestringmanager.CompareStrAnsiStringProc:=@WinCEAnsiCompareStr;
+    widestringmanager.CompareTextAnsiStringProc:=@WinCEAnsiCompareText;
+    widestringmanager.StrCompAnsiStringProc:=@WinCEAnsiStrComp;
+    widestringmanager.StrICompAnsiStringProc:=@WinCEAnsiStrIComp;
+    widestringmanager.StrLCompAnsiStringProc:=@WinCEAnsiStrLComp;
+    widestringmanager.StrLICompAnsiStringProc:=@WinCEAnsiStrLIComp;
+    widestringmanager.StrLowerAnsiStringProc:=@WinCEAnsiStrLower;
+    widestringmanager.StrUpperAnsiStringProc:=@WinCEAnsiStrUpper;
+  end;
+
+
+
+Initialization
+  InitWinCEWidestrings;
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+  LoadVersionInfo;
+  SysConfigDir:='\Windows';
+
+Finalization
+  DoneExceptions;
+
+end.

rtl/wince/varutils.pp

@@ -1,38 +1,38 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Interface and OS-dependent part of variant support
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$MODE ObjFPC}
-
-Unit varutils;
-
-Interface
-
-Uses sysutils;
-
-// Read definitions.
-
-{$i varutilh.inc}
-
-Implementation
-
-// Code common to all platforms.
-
-{$i cvarutil.inc}
-
-// Code common to non-win32 platforms.
-
-{$i varutils.inc}
-
-end.
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    Interface and OS-dependent part of variant support
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$MODE ObjFPC}
+
+Unit varutils;
+
+Interface
+
+Uses sysutils;
+
+// Read definitions.
+
+{$i varutilh.inc}
+
+Implementation
+
+// Code common to all platforms.
+
+{$i cvarutil.inc}
+
+// Code common to non-win32 platforms.
+
+{$i varutils.inc}
+
+end.

rtl/wince/windows.pp

@@ -1,82 +1,82 @@
-{
-    This file is part of the Free Pascal run time library.
-    This unit contains the record definition for the Win32 API
-    Copyright (c) 1999-2000 by Florian KLaempfl,
-    member of the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************
-
-}
-
-unit windows;
-
-{$PACKSET 1}
-
-{$ifndef NO_SMART_LINK}
-{$smartlink on}
-{$endif}
-
-{ stuff like array of const is used }
-{$mode objfpc}
-{ convention is cdecl for WinCE API}
-{$calling cdecl}
-
-interface
-
-
-{$define read_interface}
-{$undef read_implementation}
-
-
-{$i base.inc}
-{$i errors.inc}
-{$i defines.inc}
-{$i struct.inc}
-{$i messages.inc}
-{$i coredll.inc}
-{$i aygshell.inc}
-{$i commctrl.inc}
-{$i commdlg.inc}
-{$i ceshell.inc}
-{$i oleaut32.inc}
-{$i iphlpapi.inc}
-{$i simmgr.inc}
-{$i tapi.inc}
-{$i cemiss.inc}
-
-{$i redef.inc}
-
-{$undef read_interface}
-
-implementation
-
-{$define read_implementation}
-
-{$i base.inc}
-{$i errors.inc}
-{$i defines.inc}
-{$i struct.inc}
-{$i messages.inc}
-{$i coredll.inc}
-{$i aygshell.inc}
-{$i commctrl.inc}
-{$i commdlg.inc}
-{$i ceshell.inc}
-{$i oleaut32.inc}
-{$i simmgr.inc}
-{$i tapi.inc}
-{$i cemiss.inc}
-
-{$i redef.inc}
-
-{$undef read_implementation}
-
-begin
-end.
+{
+    This file is part of the Free Pascal run time library.
+    This unit contains the record definition for the Win32 API
+    Copyright (c) 1999-2000 by Florian KLaempfl,
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+
+}
+
+unit windows;
+
+{$PACKSET 1}
+
+{$ifndef NO_SMART_LINK}
+{$smartlink on}
+{$endif}
+
+{ stuff like array of const is used }
+{$mode objfpc}
+{ convention is cdecl for WinCE API}
+{$calling cdecl}
+
+interface
+
+
+{$define read_interface}
+{$undef read_implementation}
+
+
+{$i base.inc}
+{$i errors.inc}
+{$i defines.inc}
+{$i struct.inc}
+{$i messages.inc}
+{$i coredll.inc}
+{$i aygshell.inc}
+{$i commctrl.inc}
+{$i commdlg.inc}
+{$i ceshell.inc}
+{$i oleaut32.inc}
+{$i iphlpapi.inc}
+{$i simmgr.inc}
+{$i tapi.inc}
+{$i cemiss.inc}
+
+{$i redef.inc}
+
+{$undef read_interface}
+
+implementation
+
+{$define read_implementation}
+
+{$i base.inc}
+{$i errors.inc}
+{$i defines.inc}
+{$i struct.inc}
+{$i messages.inc}
+{$i coredll.inc}
+{$i aygshell.inc}
+{$i commctrl.inc}
+{$i commdlg.inc}
+{$i ceshell.inc}
+{$i oleaut32.inc}
+{$i simmgr.inc}
+{$i tapi.inc}
+{$i cemiss.inc}
+
+{$i redef.inc}
+
+{$undef read_implementation}
+
+begin
+end.