瀏覽代碼

* fix from Peter

Jonas Maebe 22 年之前
父節點
當前提交
7e26d3cc3b
共有 1 個文件被更改,包括 78 次插入40 次删除
  1. 78 40
      rtl/win32/dos.pp

+ 78 - 40
rtl/win32/dos.pp

@@ -16,9 +16,6 @@
 unit dos;
 interface
 
-{ Include Win32 Consts,Types }
-{$I win32.inc}
-
 Const
   Max_Path = 260;
 
@@ -72,12 +69,20 @@ Type
     Sec   : word;
   End;
 
+  TWin32Handle = longint;
+
+  PWin32FileTime = ^TWin32FileTime;
+  TWin32FileTime = record
+    dwLowDateTime,
+    dwHighDateTime : DWORD;
+  end;
+
   PWin32FindData = ^TWin32FindData;
   TWin32FindData = record
     dwFileAttributes: Cardinal;
-    ftCreationTime: TFileTime;
-    ftLastAccessTime: TFileTime;
-    ftLastWriteTime: TFileTime;
+    ftCreationTime: TWin32FileTime;
+    ftLastAccessTime: TWin32FileTime;
+    ftLastWriteTime: TWin32FileTime;
     nFileSizeHigh: Cardinal;
     nFileSizeLow: Cardinal;
     dwReserved0: Cardinal;
@@ -89,7 +94,7 @@ Type
   end;
 
   Searchrec = Packed Record
-    FindHandle  : THandle;
+    FindHandle  : TWin32Handle;
     W32FindData : TWin32FindData;
     ExcludeAttr : longint;
     time : longint;
@@ -167,10 +172,21 @@ Const
     now set to true by default because
     other OS also pass open handles to childs
     finally reset to false after Florian's response PM }
-  ExecInheritsHandles : BOOL = false;
+  ExecInheritsHandles : Longbool = false;
+
 
 implementation
-uses strings;
+
+uses
+   strings;
+
+const
+   INVALID_HANDLE_VALUE = longint($ffffffff);
+
+   VER_PLATFORM_WIN32s = 0;
+   VER_PLATFORM_WIN32_WINDOWS = 1;
+   VER_PLATFORM_WIN32_NT = 2;
+
 type
    OSVERSIONINFO = record
         dwOSVersionInfoSize : DWORD;
@@ -181,11 +197,9 @@ type
         szCSDVersion : array[0..127] of char;
      end;
 
-   LPOSVERSIONINFO = ^OSVERSIONINFO;
-
 var
    versioninfo : OSVERSIONINFO;
-   kernel32dll : THandle;
+   kernel32dll : TWin32Handle;
 
 {******************************************************************************
                            --- Conversion ---
@@ -193,13 +207,13 @@ var
 
    function GetLastError : DWORD;
      external 'kernel32' name 'GetLastError';
-   function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : longbool;
+   function FileTimeToDosDateTime(const ft :TWin32FileTime;var data,time : word) : longbool;
      external 'kernel32' name 'FileTimeToDosDateTime';
-   function DosDateTimeToFileTime(date,time : word;var ft :TFileTime) : longbool;
+   function DosDateTimeToFileTime(date,time : word;var ft :TWin32FileTime) : longbool;
      external 'kernel32' name 'DosDateTimeToFileTime';
-   function FileTimeToLocalFileTime(const ft : TFileTime;var lft : TFileTime) : longbool;
+   function FileTimeToLocalFileTime(const ft : TWin32FileTime;var lft : TWin32FileTime) : longbool;
      external 'kernel32' name 'FileTimeToLocalFileTime';
-   function LocalFileTimeToFileTime(const lft : TFileTime;var ft : TFileTime) : longbool;
+   function LocalFileTimeToFileTime(const lft : TWin32FileTime;var ft : TWin32FileTime) : longbool;
      external 'kernel32' name 'LocalFileTimeToFileTime';
 
 type
@@ -230,18 +244,18 @@ begin
 end;
 
 
-Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;
+Function DosToWinTime (DTime:longint;Var Wtime : TWin32FileTime):longbool;
 var
-  lft : TFileTime;
+  lft : TWin32FileTime;
 begin
   DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
                 LocalFileTimeToFileTime(lft,Wtime);
 end;
 
 
-Function WinToDosTime (Const Wtime : TFileTime;var DTime:longint):longbool;
+Function WinToDosTime (Const Wtime : TWin32FileTime;var DTime:longint):longbool;
 var
-  lft : TFileTime;
+  lft : TWin32FileTime;
 begin
   WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
                 FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
@@ -267,6 +281,18 @@ end;
                         --- Info / Date / Time ---
 ******************************************************************************}
 
+type
+  TSystemTime = record
+    wYear,
+    wMonth,
+    wDayOfWeek,
+    wDay,
+    wHour,
+    wMinute,
+    wSecond,
+    wMilliseconds: Word;
+  end;
+
    function GetVersion : longint;
      external 'kernel32' name 'GetVersion';
    procedure GetLocalTime(var t : TSystemTime);
@@ -360,17 +386,26 @@ End;
                                --- Exec ---
 ******************************************************************************}
 
+type
+  PProcessInformation = ^TProcessInformation;
+  TProcessInformation = record
+    hProcess: TWin32Handle;
+    hThread: TWin32Handle;
+    dwProcessId: DWORD;
+    dwThreadId: DWORD;
+  end;
+
    function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
-               lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
-               bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
+               lpProcessAttributes, lpThreadAttributes: Pointer;
+               bInheritHandles: Longbool; dwCreationFlags: DWORD; lpEnvironment: Pointer;
                lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
                var lpProcessInformation: TProcessInformation): longbool;
      external 'kernel32' name 'CreateProcessA';
-   function getExitCodeProcess(h:THandle;var code:longint):longbool;
+   function getExitCodeProcess(h:TWin32Handle;var code:longint):longbool;
      external 'kernel32' name 'GetExitCodeProcess';
-   function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
+   function WaitForSingleObject(hHandle: TWin32Handle; dwMilliseconds: DWORD): DWORD;
      external 'kernel32' name 'WaitForSingleObject';
-   function CloseHandle(h : THandle) : longint;
+   function CloseHandle(h : TWin32Handle) : longint;
      external 'kernel32' name 'CloseHandle';
 
 var
@@ -380,7 +415,7 @@ procedure exec(const path : pathstr;const comline : comstr);
 var
   SI: TStartupInfo;
   PI: TProcessInformation;
-  Proc : THandle;
+  Proc : TWin32Handle;
   l    : Longint;
   CommandLine : array[0..511] of char;
   AppParam : array[0..255] of char;
@@ -415,7 +450,7 @@ begin
    end;
   Proc:=PI.hProcess;
   CloseHandle(PI.hThread);
-  if WaitForSingleObject(Proc, dword(Infinite)) <> $ffffffff then
+  if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
     GetExitCodeProcess(Proc,l)
   else
     l:=-1;
@@ -551,11 +586,11 @@ end;
 
 { Needed kernel calls }
 
-   function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;
+   function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): TWin32Handle;
      external 'kernel32' name 'FindFirstFileA';
-   function FindNextFile  (hFindFile: THandle; var lpFindFileData: TWIN32FindData): LongBool;
+   function FindNextFile  (hFindFile: TWin32Handle; var lpFindFileData: TWIN32FindData): LongBool;
      external 'kernel32' name 'FindNextFileA';
-   function FindCloseFile (hFindFile: THandle): LongBool;
+   function FindCloseFile (hFindFile: TWin32Handle): LongBool;
      external 'kernel32' name 'FindClose';
 
 Procedure StringToPchar (Var S : String);
@@ -650,9 +685,9 @@ end;
                                --- File ---
 ******************************************************************************}
 
-   function GetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : longbool;
+   function GeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool;
      external 'kernel32' name 'GetFileTime';
-   function SetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : longbool;
+   function SeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool;
      external 'kernel32' name 'SetFileTime';
    function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : longbool;
      external 'kernel32' name 'SetFileAttributesA';
@@ -816,10 +851,10 @@ end;
 
 procedure getftime(var f;var time : longint);
 var
-   ft : TFileTime;
+   ft : TWin32FileTime;
 begin
   doserror:=0;
-  if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
+  if GeTWin32FileTime(filerec(f).Handle,nil,nil,@ft) and
      WinToDosTime(ft,time) then
     exit
   else
@@ -832,11 +867,11 @@ end;
 
 procedure setftime(var f;time : longint);
 var
-  ft : TFileTime;
+  ft : TWin32FileTime;
 begin
   doserror:=0;
   if DosToWinTime(time,ft) and
-     SetFileTime(filerec(f).Handle,nil,nil,@ft) then
+     SeTWin32FileTime(filerec(f).Handle,nil,nil,@ft) then
    exit
   else
    DosError:=Last2DosError(GetLastError);
@@ -1012,13 +1047,13 @@ Procedure setintvec(intno : byte;vector : pointer);
 Begin
 End;
 
-function FreeLibrary(hLibModule : THANDLE) : longbool;
+function FreeLibrary(hLibModule : TWin32Handle) : longbool;
   external 'kernel32' name 'FreeLibrary';
 function GetVersionEx(var VersionInformation:OSVERSIONINFO) : longbool;
   external 'kernel32' name 'GetVersionExA';
-function LoadLibrary(lpLibFileName : pchar):THandle;
+function LoadLibrary(lpLibFileName : pchar):TWin32Handle;
   external 'kernel32' name 'LoadLibraryA';
-function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
+function GetProcAddress(hModule : TWin32Handle;lpProcName : pchar) : pointer;
   external 'kernel32' name 'GetProcAddress';
 
 var
@@ -1050,7 +1085,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2002-12-24 15:35:15  peter
+  Revision 1.19  2003-06-10 11:16:15  jonas
+    * fix from Peter
+
+  Revision 1.18  2002/12/24 15:35:15  peter
     * error code fixes
 
   Revision 1.17  2002/12/15 20:23:53  peter