diff --git a/rtl/win/sysfile.inc b/rtl/win/sysfile.inc index d6cc632b61..a934563b7c 100644 --- a/rtl/win/sysfile.inc +++ b/rtl/win/sysfile.inc @@ -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 - -} - diff --git a/rtl/win/sysos.inc b/rtl/win/sysos.inc index 014c0cdb9e..f01319e3ea 100644 --- a/rtl/win/sysos.inc +++ b/rtl/win/sysos.inc @@ -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 } diff --git a/rtl/win32/system.pp b/rtl/win32/system.pp index 4806a9d95f..3c54152428 100644 --- a/rtl/win32/system.pp +++ b/rtl/win32/system.pp @@ -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; diff --git a/rtl/win32/wininc/func.inc b/rtl/win32/wininc/func.inc index 935844612b..0d7af48c63 100644 --- a/rtl/win32/wininc/func.inc +++ b/rtl/win32/wininc/func.inc @@ -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';