paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 14:59:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Sergei Gorelkin to use always SetFilePointer, also for files with >2GB, this saves some lines of code, resolves

Browse Source 
git-svn-id: trunk@13838 -
This commit is contained in:
florian 2009-10-10 18:52:50 +00:00
parent 1b977aa8c9
commit cba72c423d
5 changed files with 42 additions and 102 deletions

95
rtl/win/sysfile.inc
View File

@ -93,78 +93,53 @@ begin
end;
type
tint64rec = record
low, high: dword;
end;
function do_filepos(handle : thandle) : Int64;
var
l:longint;
rslt: tint64rec;
begin
{$ifndef wince}
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(handle,0,@result,FILE_CURRENT)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
{$endif wince}
begin
l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
if l=-1 then
begin
l:=0;
errno:=GetLastError;
Errno2InoutRes;
end;
do_filepos:=l;
end;
rslt.high := 0;
rslt.low := SetFilePointer(handle, 0, @rslt.high, FILE_CURRENT);
if (rslt.low = $FFFFFFFF) and (GetLastError <> 0) then
begin
errno := GetLastError;
Errno2InoutRes;
end;
do_filepos := int64(rslt);
end;
procedure do_seek(handle:thandle;pos : Int64);
procedure do_seek(handle: thandle; pos: Int64);
var
posHigh: LongInt;
begin
{$ifndef wince}
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(handle,pos,nil,FILE_BEGIN)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
{$endif wince}
begin
if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
Begin
errno:=GetLastError;
Errno2InoutRes;
end;
end;
posHigh := tint64rec(pos).high;
if (SetFilePointer(handle, pos, @posHigh, FILE_BEGIN)=-1) and
{ return value of -1 is valid unless GetLastError is non-zero }
(GetLastError <> 0) then
begin
errno := GetLastError;
Errno2InoutRes;
end;
end;
function do_seekend(handle:thandle):Int64;
var
rslt: tint64rec;
begin
{$ifndef wince}
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(handle,0,@result,FILE_END)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
{$endif wince}
begin
do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
if do_seekend=-1 then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end;
rslt.high := 0;
rslt.low := SetFilePointer(handle, 0, @rslt.high, FILE_END);
if (rslt.low = $FFFFFFFF) and (GetLastError <> 0) then
begin
errno := GetLastError;
Errno2InoutRes;
end;
do_seekend := int64(rslt);
end;

18
rtl/win/sysos.inc
View File

@ -253,24 +253,6 @@ threadvar
stdcall;external KernelDLL name 'SetCurrentDirectoryA';
function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
stdcall;external KernelDLL name 'GetCurrentDirectoryA';
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;
{$endif WINCE}
Procedure Errno2InOutRes;

29
rtl/win/sysutils.pp
View File

@ -278,14 +278,14 @@ end;
Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Longint) : Int64;
var
rslt: Int64Rec;
begin
if assigned(SetFilePointerEx) then
begin
if not(SetFilePointerEx(Handle, FOffset, @result, Origin)) then
Result:=-1;
end
else
Result:=longint(SetFilePointer(Handle, FOffset, nil, Origin));
rslt := Int64Rec(FOffset);
rslt.lo := SetFilePointer(Handle, rslt.lo, @rslt.hi, Origin);
if (rslt.lo = $FFFFFFFF) and (GetLastError <> 0) then
rslt.hi := $FFFFFFFF;
Result := Int64(rslt);
end;
@ -1215,27 +1215,12 @@ procedure InitWin32Widestrings;
end;
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;
Initialization
InitWin32Widestrings;
InitExceptions; { Initialize exceptions. OS independent }
InitInternational; { Initialize internationalization settings }
LoadVersionInfo;
InitSysConfigDir;
SetupProcVars;
Finalization
DoneExceptions;
if kernel32dll<>0 then

1
rtl/win32/system.pp
View File

@ -175,7 +175,6 @@ var
end;
begin
SetupProcVars;
{ create commandline, it starts with the executed filename which is argv[0] }
{ Win32 passes the command NOT via the args, but via getmodulefilename}
count:=0;

1
rtl/win64/system.pp
View File

@ -167,7 +167,6 @@ var
end;
begin
SetupProcVars;
{ create commandline, it starts with the executed filename which is argv[0] }
{ Win32 passes the command NOT via the args, but via getmodulefilename}
count:=0;