paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 21:19:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* more 64 bit clean up

Browse Source 
git-svn-id: trunk@3224 -
This commit is contained in:
florian 2006-04-16 09:42:12 +00:00
parent 2a710b5fd4
commit 1db5db975e
2 changed files with 92 additions and 94 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
rtl/win/dos.pp
View File

@ -19,23 +19,23 @@ Const
Max_Path = 260; Max_Path = 260;
Type Type
PWin32FileTime = ^TWin32FileTime; PWinFileTime = ^TWinFileTime;
TWin32FileTime = record TWinFileTime = record
dwLowDateTime, dwLowDateTime,
dwHighDateTime : DWORD; dwHighDateTime : DWORD;
end; end;
PWin32FindData = ^TWin32FindData; PWinFindData = ^TWinFindData;
TWin32FindData = record TWinFindData = record
dwFileAttributes: Cardinal; dwFileAttributes: DWORD;
ftCreationTime: TWin32FileTime; ftCreationTime: TWinFileTime;
ftLastAccessTime: TWin32FileTime; ftLastAccessTime: TWinFileTime;
ftLastWriteTime: TWin32FileTime; ftLastWriteTime: TWinFileTime;
nFileSizeHigh: Cardinal; nFileSizeHigh: DWORD;
nFileSizeLow: Cardinal; nFileSizeLow: DWORD;
dwReserved0: Cardinal; dwReserved0: DWORD;
dwReserved1: Cardinal; dwReserved1: DWORD;
cFileName: array[0..MAX_PATH - 1] of Char; cFileName: array[0..MAX_PATH-1] of Char;
cAlternateFileName: array[0..13] of Char; cAlternateFileName: array[0..13] of Char;
// The structure should be 320 bytes long... // The structure should be 320 bytes long...
pad : system.integer; pad : system.integer;
@ -43,7 +43,7 @@ Type
Searchrec = Packed Record Searchrec = Packed Record
FindHandle : THandle; FindHandle : THandle;
W32FindData : TWin32FindData; WinFindData : TWinFindData;
ExcludeAttr : longint; ExcludeAttr : longint;
time : longint; time : longint;
size : longint; size : longint;
@ -77,7 +77,7 @@ uses
{$I dos.inc} {$I dos.inc}
const const
INVALID_HANDLE_VALUE = longint($ffffffff); INVALID_HANDLE_VALUE = THandle(-1);
VER_PLATFORM_WIN32s = 0; VER_PLATFORM_WIN32s = 0;
VER_PLATFORM_WIN32_WINDOWS = 1; VER_PLATFORM_WIN32_WINDOWS = 1;
@ -101,17 +101,17 @@ var
--- Conversion --- --- Conversion ---
******************************************************************************} ******************************************************************************}
function GetLastError : DWORD; function GetLastError : DWORD;
stdcall; external 'kernel32' name 'GetLastError'; stdcall; external 'kernel32' name 'GetLastError';
function FileTimeToDosDateTime(const ft :TWin32FileTime;var data,time : word) : longbool; function FileTimeToDosDateTime(const ft :TWinFileTime;var data,time : word) : longbool;
stdcall; external 'kernel32' name 'FileTimeToDosDateTime'; stdcall; external 'kernel32' name 'FileTimeToDosDateTime';
function DosDateTimeToFileTime(date,time : word;var ft :TWin32FileTime) : longbool; function DosDateTimeToFileTime(date,time : word;var ft :TWinFileTime) : longbool;
stdcall; external 'kernel32' name 'DosDateTimeToFileTime'; stdcall; external 'kernel32' name 'DosDateTimeToFileTime';
function FileTimeToLocalFileTime(const ft : TWin32FileTime;var lft : TWin32FileTime) : longbool; function FileTimeToLocalFileTime(const ft : TWinFileTime;var lft : TWinFileTime) : longbool;
stdcall; external 'kernel32' name 'FileTimeToLocalFileTime'; stdcall; external 'kernel32' name 'FileTimeToLocalFileTime';
function LocalFileTimeToFileTime(const lft : TWin32FileTime;var ft : TWin32FileTime) : longbool; function LocalFileTimeToFileTime(const lft : TWinFileTime;var ft : TWinFileTime) : longbool;
stdcall; external 'kernel32' name 'LocalFileTimeToFileTime'; stdcall; external 'kernel32' name 'LocalFileTimeToFileTime';
function GetTickCount : longint; function GetTickCount : longint;
stdcall;external 'kernel32' name 'GetTickCount'; stdcall;external 'kernel32' name 'GetTickCount';
function GetMsCount: int64; function GetMsCount: int64;
@ -147,18 +147,18 @@ begin
end; end;
Function DosToWinTime (DTime:longint;Var Wtime : TWin32FileTime):longbool; Function DosToWinTime (DTime:longint;Var Wtime : TWinFileTime):longbool;
var var
lft : TWin32FileTime; lft : TWinFileTime;
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 : TWin32FileTime;var DTime:longint):longbool; Function WinToDosTime (Const Wtime : TWinFileTime;var DTime:longint):longbool;
var var
lft : TWin32FileTime; lft : TWinFileTime;
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);
@ -263,17 +263,17 @@ type
dwThreadId: DWORD; dwThreadId: DWORD;
end; end;
function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar; function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
lpProcessAttributes, lpThreadAttributes: Pointer; lpProcessAttributes, lpThreadAttributes: Pointer;
bInheritHandles: Longbool; dwCreationFlags: DWORD; lpEnvironment: 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;
stdcall; external 'kernel32' name 'CreateProcessA'; stdcall; external 'kernel32' name 'CreateProcessA';
function getExitCodeProcess(h:THandle;var code:longint):longbool; function getExitCodeProcess(h:THandle;var code:longint):longbool;
stdcall; external 'kernel32' name 'GetExitCodeProcess'; stdcall; external 'kernel32' name 'GetExitCodeProcess';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD;
stdcall; external 'kernel32' name 'WaitForSingleObject'; stdcall; external 'kernel32' name 'WaitForSingleObject';
function CloseHandle(h : THandle) : longint; function CloseHandle(h : THandle) : longint;
stdcall; external 'kernel32' name 'CloseHandle'; stdcall; external 'kernel32' name 'CloseHandle';
procedure exec(const path : pathstr;const comline : comstr); procedure exec(const path : pathstr;const comline : comstr);
@ -340,7 +340,7 @@ function diskfree(drive : byte) : int64;
var var
disk : array[1..4] of char; disk : array[1..4] of char;
secs,bytes, secs,bytes,
free,total : longword; free,total : DWORD;
qwtotal,qwfree,qwcaller : int64; qwtotal,qwfree,qwcaller : int64;
@ -378,7 +378,7 @@ function disksize(drive : byte) : int64;
var var
disk : array[1..4] of char; disk : array[1..4] of char;
secs,bytes, secs,bytes,
free,total : longword; free,total : DWORD;
qwtotal,qwfree,qwcaller : int64; qwtotal,qwfree,qwcaller : int64;
begin begin
@ -417,11 +417,11 @@ end;
{ Needed kernel calls } { Needed kernel calls }
function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle; function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWinFindData): THandle;
stdcall; external 'kernel32' name 'FindFirstFileA'; stdcall; external 'kernel32' name 'FindFirstFileA';
function FindNextFile (hFindFile: THandle; var lpFindFileData: TWIN32FindData): LongBool; function FindNextFile (hFindFile: THandle; var lpFindFileData: TWinFindData): LongBool;
stdcall; external 'kernel32' name 'FindNextFileA'; stdcall; external 'kernel32' name 'FindNextFileA';
function FindCloseFile (hFindFile: THandle): LongBool; function FindCloseFile (hFindFile: THandle): LongBool;
stdcall; external 'kernel32' name 'FindClose'; stdcall; external 'kernel32' name 'FindClose';
Procedure StringToPchar (Var S : String); Procedure StringToPchar (Var S : String);
@ -444,9 +444,9 @@ end;
procedure FindMatch(var f:searchrec); procedure FindMatch(var f:searchrec);
begin begin
{ Find file with correct attribute } { Find file with correct attribute }
While (F.W32FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do While (F.WinFindData.dwFileAttributes and DWORD(F.ExcludeAttr))<>0 do
begin begin
if not FindNextFile (F.FindHandle,F.W32FindData) then if not FindNextFile (F.FindHandle,F.WinFindData) then
begin begin
DosError:=Last2DosError(GetLastError); DosError:=Last2DosError(GetLastError);
if DosError=2 then if DosError=2 then
@ -456,10 +456,10 @@ begin
end; end;
{ Convert some attributes back } { Convert some attributes back }
f.size:=F.W32FindData.NFileSizeLow; f.size:=F.WinFindData.NFileSizeLow;
f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes); f.attr:=WinToDosAttr(F.WinFindData.dwFileAttributes);
WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time); WinToDosTime(F.WinFindData.ftLastWriteTime,f.Time);
f.Name:=StrPas(@F.W32FindData.cFileName); f.Name:=StrPas(@F.WinFindData.cFileName);
end; end;
@ -474,10 +474,10 @@ begin
StringToPchar(f.name); StringToPchar(f.name);
{ FindFirstFile is a Win32 Call } { FindFirstFile is a Win32 Call }
F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr); F.WinFindData.dwFileAttributes:=DosToWinAttr(f.attr);
F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData); F.FindHandle:=FindFirstFile (pchar(@f.Name),F.WinFindData);
If longint(F.FindHandle)=Invalid_Handle_value then If F.FindHandle=Invalid_Handle_value then
begin begin
DosError:=Last2DosError(GetLastError); DosError:=Last2DosError(GetLastError);
if DosError=2 then if DosError=2 then
@ -493,7 +493,7 @@ procedure findnext(var f : searchRec);
begin begin
{ no error } { no error }
doserror:=0; doserror:=0;
if not FindNextFile (F.FindHandle,F.W32FindData) then if not FindNextFile (F.FindHandle,F.WinFindData) then
begin begin
DosError:=Last2DosError(GetLastError); DosError:=Last2DosError(GetLastError);
if DosError=2 then if DosError=2 then
@ -507,7 +507,7 @@ end;
Procedure FindClose(Var f: SearchRec); Procedure FindClose(Var f: SearchRec);
begin begin
If longint(F.FindHandle)<>Invalid_Handle_value then If F.FindHandle<>Invalid_Handle_value then
FindCloseFile(F.FindHandle); FindCloseFile(F.FindHandle);
end; end;
@ -516,13 +516,13 @@ end;
--- File --- --- File ---
******************************************************************************} ******************************************************************************}
function GeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool; function GetWinFileTime(h : longint;creation,lastaccess,lastwrite : PWinFileTime) : longbool;
stdcall; external 'kernel32' name 'GetFileTime'; stdcall; external 'kernel32' name 'GetFileTime';
function SeTWin32FileTime(h : longint;creation,lastaccess,lastwrite : PWin32FileTime) : longbool; function SetWinFileTime(h : longint;creation,lastaccess,lastwrite : PWinFileTime) : longbool;
stdcall; external 'kernel32' name 'SetFileTime'; stdcall; external 'kernel32' name 'SetFileTime';
function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : longbool; function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : longbool;
stdcall; external 'kernel32' name 'SetFileAttributesA'; stdcall; external 'kernel32' name 'SetFileAttributesA';
function GetFileAttributes(lpFileName : pchar) : longint; function GetFileAttributes(lpFileName : pchar) : longint;
stdcall; external 'kernel32' name 'GetFileAttributesA'; stdcall; external 'kernel32' name 'GetFileAttributesA';
@ -530,7 +530,6 @@ end;
function GetFullPathName(lpFileName: PChar; nBufferLength: Longint; lpBuffer: PChar; var lpFilePart : PChar):DWORD; function GetFullPathName(lpFileName: PChar; nBufferLength: Longint; lpBuffer: PChar; var lpFilePart : PChar):DWORD;
stdcall; external 'kernel32' name 'GetFullPathNameA'; stdcall; external 'kernel32' name 'GetFullPathNameA';
function GetShortPathName(lpszLongPath:pchar; lpszShortPath:pchar; cchBuffer:DWORD):DWORD; function GetShortPathName(lpszLongPath:pchar; lpszShortPath:pchar; cchBuffer:DWORD):DWORD;
stdcall; external 'kernel32' name 'GetShortPathNameA'; stdcall; external 'kernel32' name 'GetShortPathNameA';
@ -582,14 +581,13 @@ begin
findclose(s); findclose(s);
end; end;
{ </immobilizer> }
procedure getftime(var f;var time : longint); procedure getftime(var f;var time : longint);
var var
ft : TWin32FileTime; ft : TWinFileTime;
begin begin
doserror:=0; doserror:=0;
if GeTWin32FileTime(filerec(f).Handle,nil,nil,@ft) and if GetWinFileTime(filerec(f).Handle,nil,nil,@ft) and
WinToDosTime(ft,time) then WinToDosTime(ft,time) then
exit exit
else else
@ -602,11 +600,11 @@ end;
procedure setftime(var f;time : longint); procedure setftime(var f;time : longint);
var var
ft : TWin32FileTime; ft : TWinFileTime;
begin begin
doserror:=0; doserror:=0;
if DosToWinTime(time,ft) and if DosToWinTime(time,ft) and
SeTWin32FileTime(filerec(f).Handle,nil,nil,@ft) then SetWinFileTime(filerec(f).Handle,nil,nil,@ft) then
exit exit
else else
DosError:=Last2DosError(GetLastError); DosError:=Last2DosError(GetLastError);
@ -696,9 +694,9 @@ end;
terminated by a #0 terminated by a #0
} }
function GetEnvironmentStrings : pchar; function GetEnvironmentStrings : pchar;
stdcall; external 'kernel32' name 'GetEnvironmentStringsA'; stdcall; external 'kernel32' name 'GetEnvironmentStringsA';
function FreeEnvironmentStrings(p : pchar) : longbool; function FreeEnvironmentStrings(p : pchar) : longbool;
stdcall; external 'kernel32' name 'FreeEnvironmentStringsA'; stdcall; external 'kernel32' name 'FreeEnvironmentStringsA';
function envcount : longint; function envcount : longint;

8
rtl/win/sysos.inc
View File

@ -15,10 +15,10 @@
const const
{ constants for GetStdHandle } { constants for GetStdHandle }
STD_INPUT_HANDLE = dword($fffffff6); STD_INPUT_HANDLE = dword(-10);
STD_OUTPUT_HANDLE = dword($fffffff5); STD_OUTPUT_HANDLE = dword(-11);
STD_ERROR_HANDLE = dword($fffffff4); STD_ERROR_HANDLE = dword(-12);
INVALID_HANDLE_VALUE = dword($ffffffff); INVALID_HANDLE_VALUE = THandle(-1);
IGNORE = 0; { Ignore signal } IGNORE = 0; { Ignore signal }
INFINITE = longint($FFFFFFFF); { Infinite timeout } INFINITE = longint($FFFFFFFF); { Infinite timeout }