Browse Source

* fix from Peter

Jonas Maebe 22 years ago
parent
commit
7e26d3cc3b
1 changed files with 78 additions and 40 deletions
  1. 78 40
      rtl/win32/dos.pp

+ 78 - 40
rtl/win32/dos.pp

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