+ 64 bit fs support

git-svn-id: trunk@1793 -
This commit is contained in:
florian 2005-11-20 15:50:06 +00:00
parent 4a6939e354
commit b88fcfda62
4 changed files with 93 additions and 44 deletions

View File

@ -102,10 +102,20 @@ begin
end; end;
function do_filepos(handle : thandle) : longint; function do_filepos(handle : thandle) : Int64;
var var
l:longint; l:longint;
begin begin
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(handle,0,@result,FILE_CURRENT)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
begin
l:=SetFilePointer(handle,0,nil,FILE_CURRENT); l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
if l=-1 then if l=-1 then
begin begin
@ -114,33 +124,56 @@ begin
Errno2InoutRes; Errno2InoutRes;
end; end;
do_filepos:=l; do_filepos:=l;
end;
end; end;
procedure do_seek(handle:thandle;pos : longint); procedure do_seek(handle:thandle;pos : Int64);
begin begin
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(handle,pos,nil,FILE_BEGIN)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
begin
if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
Begin Begin
errno:=GetLastError; errno:=GetLastError;
Errno2InoutRes; Errno2InoutRes;
end; end;
end;
end; end;
function do_seekend(handle:thandle):longint; function do_seekend(handle:thandle):Int64;
begin begin
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(handle,0,@result,FILE_END)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
begin
do_seekend:=SetFilePointer(handle,0,nil,FILE_END); do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
if do_seekend=-1 then if do_seekend=-1 then
begin begin
errno:=GetLastError; errno:=GetLastError;
Errno2InoutRes; Errno2InoutRes;
end; end;
end;
end; end;
function do_filesize(handle : thandle) : longint; function do_filesize(handle : thandle) : Int64;
var var
aktfilepos : longint; aktfilepos : Int64;
begin begin
aktfilepos:=do_filepos(handle); aktfilepos:=do_filepos(handle);
do_filesize:=do_seekend(handle); do_filesize:=do_seekend(handle);
@ -148,7 +181,7 @@ begin
end; end;
procedure do_truncate (handle:thandle;pos:longint); procedure do_truncate (handle:thandle;pos:Int64);
begin begin
do_seek(handle,pos); do_seek(handle,pos);
if not(SetEndOfFile(handle)) then if not(SetEndOfFile(handle)) then
@ -263,13 +296,3 @@ begin
Errno2InoutRes; Errno2InoutRes;
end; end;
end; end;
{
$Log: sysfile.inc,v $
Revision 1.1 2005/02/06 13:06:20 peter
* moved file and dir functions to sysfile/sysdir
* win32 thread in systemunit
}

View File

@ -221,6 +221,11 @@ threadvar
stdcall;external KernelDLL name 'GetFileSize'; stdcall;external KernelDLL name 'GetFileSize';
function SetEndOfFile(h : thandle) : longbool; function SetEndOfFile(h : thandle) : longbool;
stdcall;external KernelDLL name 'SetEndOfFile'; stdcall;external KernelDLL name 'SetEndOfFile';
function LoadLibrary(lpLibFileName:pchar):THandle; stdcall; external KernelDLL name 'LoadLibraryA';
function FreeLibrary(hLibModule:THandle):ByteBool; stdcall; external KernelDLL name 'FreeLibrary';
function GetProcAddress(hModule:THandle; lpProcName:pchar):pointer; stdcall; external KernelDLL name 'GetProcAddress';
{$ifndef WINCE} {$ifndef WINCE}
function GetFileType(Handle:thandle):DWord; function GetFileType(Handle:thandle):DWord;
stdcall;external KernelDLL name 'GetFileType'; stdcall;external KernelDLL name 'GetFileType';
@ -246,6 +251,25 @@ threadvar
stdcall;external KernelDLL name 'GetCurrentDirectoryA'; stdcall;external KernelDLL name 'GetCurrentDirectoryA';
{$endif WINCE} {$endif WINCE}
var
SetFilePointerEx : function(hFile : THandle;
liDistanceToMove : int64;lpNewFilePointer : pint64;
dwMoveMethod : DWord) : ByteBool;stdcall;
procedure SetupProcVars;
var
hinstLib : THandle;
begin
SetFilePointerEx:=nil;
hinstLib:=LoadLibrary(KernelDLL);
if hinstLib<>0 then
begin
pointer(SetFilePointerEx):=GetProcAddress(hinstLib,'SetFilePointerEx');
FreeLibrary(hinstLib);
end;
end;
Procedure Errno2InOutRes; Procedure Errno2InOutRes;
Begin Begin
{ DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING } { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }

View File

@ -1,6 +1,6 @@
{ {
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski
member of the Free Pascal development team. member of the Free Pascal development team.
FPC Pascal system unit for the Win32 API. FPC Pascal system unit for the Win32 API.
@ -172,6 +172,7 @@ var
end; end;
begin begin
SetupProcVars;
{ create commandline, it starts with the executed filename which is argv[0] } { create commandline, it starts with the executed filename which is argv[0] }
{ Win32 passes the command NOT via the args, but via getmodulefilename} { Win32 passes the command NOT via the args, but via getmodulefilename}
count:=0; count:=0;

View File

@ -56,7 +56,8 @@ function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockRe
{$ifdef Unknown_functions} {$ifdef Unknown_functions}
{ WARNING: function not found !!} { WARNING: function not found !!}
function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:longint):longint; external External_library name 'WinMain'; function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:longint):longint; external External_library name 'WinMain';
{$endif Unknown_functions}function FreeLibrary(hLibModule:HINST):WINBOOL; external 'kernel32' name 'FreeLibrary'; {$endif Unknown_functions}
function FreeLibrary(hLibModule:HINST):WINBOOL; external 'kernel32' name 'FreeLibrary';
procedure FreeLibraryAndExitThread(hLibModule:HMODULE; dwExitCode:DWORD); external 'kernel32' name 'FreeLibraryAndExitThread'; procedure FreeLibraryAndExitThread(hLibModule:HMODULE; dwExitCode:DWORD); external 'kernel32' name 'FreeLibraryAndExitThread';
function DisableThreadLibraryCalls(hLibModule:HMODULE):WINBOOL; external 'kernel32' name 'DisableThreadLibraryCalls'; function DisableThreadLibraryCalls(hLibModule:HMODULE):WINBOOL; external 'kernel32' name 'DisableThreadLibraryCalls';
function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress'; function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress';