+ 64 bit fs support

git-svn-id: trunk@1793 -

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 assigned(SetFilePointerEx) then
-  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
     begin
-      errno:=GetLastError;
+      if not(SetFilePointerEx(handle,0,@result,FILE_CURRENT)) then
-      Errno2InoutRes;
+        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
-
-}
-

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 }

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;

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';