paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 23:09:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ 64 bit fs support

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

105
rtl/win/sysfile.inc
View File

@ -102,45 +102,78 @@ begin
end;
function do_filepos(handle : thandle) : longint;
function do_filepos(handle : thandle) : Int64;
var
l:longint;
begin
l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
if l=-1 then
begin
l:=0;
errno:=GetLastError;
Errno2InoutRes;
end;
do_filepos:=l;
end;
procedure do_seek(handle:thandle;pos : longint);
begin
if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
Begin
errno:=GetLastError;
Errno2InoutRes;
end;
end;
function do_seekend(handle:thandle):longint;
begin
do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
if do_seekend=-1 then
if assigned(SetFilePointerEx) then
begin
errno:=GetLastError;
Errno2InoutRes;
if not(SetFilePointerEx(handle,0,@result,FILE_CURRENT)) then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end
else
begin
l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
if l=-1 then
begin
l:=0;
errno:=GetLastError;
Errno2InoutRes;
end;
do_filepos:=l;
end;
end;
function do_filesize(handle : thandle) : longint;
procedure do_seek(handle:thandle;pos : Int64);
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
Begin
errno:=GetLastError;
Errno2InoutRes;
end;
end;
end;
function do_seekend(handle:thandle):Int64;
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);
if do_seekend=-1 then
begin
errno:=GetLastError;
Errno2InoutRes;
end;
end;
end;
function do_filesize(handle : thandle) : Int64;
var
aktfilepos : longint;
aktfilepos : Int64;
begin
aktfilepos:=do_filepos(handle);
do_filesize:=do_seekend(handle);
@ -148,7 +181,7 @@ begin
end;
procedure do_truncate (handle:thandle;pos:longint);
procedure do_truncate (handle:thandle;pos:Int64);
begin
do_seek(handle,pos);
if not(SetEndOfFile(handle)) then
@ -263,13 +296,3 @@ begin
Errno2InoutRes;
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
}

24
rtl/win/sysos.inc
View File

@ -221,6 +221,11 @@ threadvar
stdcall;external KernelDLL name 'GetFileSize';
function SetEndOfFile(h : thandle) : longbool;
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}
function GetFileType(Handle:thandle):DWord;
stdcall;external KernelDLL name 'GetFileType';
@ -246,6 +251,25 @@ threadvar
stdcall;external KernelDLL name 'GetCurrentDirectoryA';
{$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;
Begin
{ DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }

5
rtl/win32/system.pp
View File

@ -1,6 +1,6 @@
{
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.
FPC Pascal system unit for the Win32 API.
@ -170,8 +170,9 @@ var
{ the arg. is still present! }
sysreallocmem(argv[idx],len+1);
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;

3
rtl/win32/wininc/func.inc
View File

@ -56,7 +56,8 @@ function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockRe
{$ifdef Unknown_functions}
{ WARNING: function not found !!}
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';
function DisableThreadLibraryCalls(hLibModule:HMODULE):WINBOOL; external 'kernel32' name 'DisableThreadLibraryCalls';
function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress';