paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 07:19:17 +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 #14630

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
rtl/win/sysfile.inc
View File

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

18
rtl/win/sysos.inc
View File

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

29
rtl/win/sysutils.pp
View File

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

1
rtl/win32/system.pp
View File

@ -175,7 +175,6 @@ 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;

1
rtl/win64/system.pp
View File

@ -167,7 +167,6 @@ 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;