|
@@ -127,8 +127,8 @@ Procedure Exec(const path: pathstr; const comline: comstr);
|
|
Function DosExitCode: word;
|
|
Function DosExitCode: word;
|
|
|
|
|
|
{Disk}
|
|
{Disk}
|
|
-Function DiskFree(drive: byte) : longint;
|
|
|
|
-Function DiskSize(drive: byte) : longint;
|
|
|
|
|
|
+Function DiskFree(drive: byte) : int64;
|
|
|
|
+Function DiskSize(drive: byte) : int64;
|
|
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
|
|
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
|
|
Procedure FindNext(var f: searchRec);
|
|
Procedure FindNext(var f: searchRec);
|
|
Procedure FindClose(Var f: SearchRec);
|
|
Procedure FindClose(Var f: SearchRec);
|
|
@@ -169,6 +169,21 @@ Const
|
|
|
|
|
|
implementation
|
|
implementation
|
|
uses strings;
|
|
uses strings;
|
|
|
|
+type
|
|
|
|
+ OSVERSIONINFO = record
|
|
|
|
+ dwOSVersionInfoSize : DWORD;
|
|
|
|
+ dwMajorVersion : DWORD;
|
|
|
|
+ dwMinorVersion : DWORD;
|
|
|
|
+ dwBuildNumber : DWORD;
|
|
|
|
+ dwPlatformId : DWORD;
|
|
|
|
+ szCSDVersion : array[0..127] of char;
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+ LPOSVERSIONINFO = ^OSVERSIONINFO;
|
|
|
|
+
|
|
|
|
+var
|
|
|
|
+ versioninfo : OSVERSIONINFO;
|
|
|
|
+ kernel32dll : THandle;
|
|
|
|
|
|
{******************************************************************************
|
|
{******************************************************************************
|
|
--- Conversion ---
|
|
--- Conversion ---
|
|
@@ -426,12 +441,21 @@ end;
|
|
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
|
function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
|
|
freeclusters,totalclusters:longint):longbool;
|
|
freeclusters,totalclusters:longint):longbool;
|
|
external 'kernel32' name 'GetDiskFreeSpaceA';
|
|
external 'kernel32' name 'GetDiskFreeSpaceA';
|
|
|
|
+type
|
|
|
|
+ TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,
|
|
|
|
+ total,free):longbool;stdcall;
|
|
|
|
+
|
|
|
|
+var
|
|
|
|
+ GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
|
|
|
|
|
|
-function diskfree(drive : byte) : longint;
|
|
|
|
|
|
+function diskfree(drive : byte) : int64;
|
|
var
|
|
var
|
|
disk : array[1..4] of char;
|
|
disk : array[1..4] of char;
|
|
secs,bytes,
|
|
secs,bytes,
|
|
free,total : longint;
|
|
free,total : longint;
|
|
|
|
+ qwtotal,qwfree,qwcaller : int64;
|
|
|
|
+
|
|
|
|
+
|
|
begin
|
|
begin
|
|
if drive=0 then
|
|
if drive=0 then
|
|
begin
|
|
begin
|
|
@@ -445,18 +469,30 @@ begin
|
|
disk[3]:='\';
|
|
disk[3]:='\';
|
|
disk[4]:=#0;
|
|
disk[4]:=#0;
|
|
end;
|
|
end;
|
|
- if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
|
|
|
- diskfree:=free*secs*bytes
|
|
|
|
|
|
+ if assigned(GetDiskFreeSpaceEx) then
|
|
|
|
+ begin
|
|
|
|
+ if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
|
|
|
|
+ diskfree:=qwfree
|
|
|
|
+ else
|
|
|
|
+ diskfree:=-1;
|
|
|
|
+ end
|
|
else
|
|
else
|
|
- diskfree:=-1;
|
|
|
|
|
|
+ begin
|
|
|
|
+ if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
|
|
|
+ diskfree:=free*secs*bytes
|
|
|
|
+ else
|
|
|
|
+ diskfree:=-1;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
-function disksize(drive : byte) : longint;
|
|
|
|
|
|
+function disksize(drive : byte) : int64;
|
|
var
|
|
var
|
|
disk : array[1..4] of char;
|
|
disk : array[1..4] of char;
|
|
secs,bytes,
|
|
secs,bytes,
|
|
free,total : longint;
|
|
free,total : longint;
|
|
|
|
+ qwtotal,qwfree,qwcaller : int64;
|
|
|
|
+
|
|
begin
|
|
begin
|
|
if drive=0 then
|
|
if drive=0 then
|
|
begin
|
|
begin
|
|
@@ -470,10 +506,20 @@ begin
|
|
disk[3]:='\';
|
|
disk[3]:='\';
|
|
disk[4]:=#0;
|
|
disk[4]:=#0;
|
|
end;
|
|
end;
|
|
- if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
|
|
|
- disksize:=total*secs*bytes
|
|
|
|
|
|
+ if assigned(GetDiskFreeSpaceEx) then
|
|
|
|
+ begin
|
|
|
|
+ if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
|
|
|
|
+ disksize:=qwtotal
|
|
|
|
+ else
|
|
|
|
+ disksize:=-1;
|
|
|
|
+ end
|
|
else
|
|
else
|
|
- disksize:=-1;
|
|
|
|
|
|
+ begin
|
|
|
|
+ if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
|
|
|
|
+ disksize:=total*secs*bytes
|
|
|
|
+ else
|
|
|
|
+ disksize:=-1;
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
@@ -848,11 +894,48 @@ Procedure setintvec(intno : byte;vector : pointer);
|
|
Begin
|
|
Begin
|
|
End;
|
|
End;
|
|
|
|
|
|
|
|
+function FreeLibrary(hLibModule : THANDLE) : longbool;
|
|
|
|
+ external 'kernel32' name 'FreeLibrary';
|
|
|
|
+function GetVersionEx(var VersionInformation:OSVERSIONINFO) : longbool;
|
|
|
|
+ external 'kernel32' name 'GetVersionExA';
|
|
|
|
+function LoadLibrary(lpLibFileName : pchar):THandle;
|
|
|
|
+ external 'kernel32' name 'LoadLibraryA';
|
|
|
|
+function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
|
|
|
|
+ external 'kernel32' name 'GetProcAddress';
|
|
|
|
|
|
|
|
+var
|
|
|
|
+ oldexitproc : pointer;
|
|
|
|
+
|
|
|
|
+procedure dosexitproc;
|
|
|
|
+
|
|
|
|
+ begin
|
|
|
|
+ exitproc:=oldexitproc;
|
|
|
|
+ if kernel32dll<>0 then
|
|
|
|
+ FreeLibrary(kernel32dll);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+begin
|
|
|
|
+ oldexitproc:=exitproc;
|
|
|
|
+ exitproc:=@dosexitproc;
|
|
|
|
+ versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
|
|
|
|
+ GetVersionEx(versioninfo);
|
|
|
|
+ kernel32dll:=0;
|
|
|
|
+ GetDiskFreeSpaceEx:=nil;
|
|
|
|
+ if ((versioninfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
|
|
|
|
+ (versioninfo.dwBuildNUmber>=1000)) or
|
|
|
|
+ (versioninfo.dwPlatformId=VER_PLATFORM_WIN32_NT) then
|
|
|
|
+ begin
|
|
|
|
+ kernel32dll:=LoadLibrary('kernel32');
|
|
|
|
+ if kernel32dll<>0 then
|
|
|
|
+ GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
|
|
|
|
+ end;
|
|
end.
|
|
end.
|
|
{
|
|
{
|
|
$Log$
|
|
$Log$
|
|
- Revision 1.30 2000-01-11 13:45:19 pierre
|
|
|
|
|
|
+ Revision 1.31 2000-01-24 21:57:56 florian
|
|
|
|
+ * disksize/diskfree return now a int64
|
|
|
|
+
|
|
|
|
+ Revision 1.30 2000/01/11 13:45:19 pierre
|
|
* fsearch was still worng for multiple pathes
|
|
* fsearch was still worng for multiple pathes
|
|
|
|
|
|
Revision 1.29 2000/01/11 12:49:26 pierre
|
|
Revision 1.29 2000/01/11 12:49:26 pierre
|
|
@@ -939,4 +1022,4 @@ end.
|
|
|
|
|
|
Revision 1.2 1998/04/26 21:49:09 florian
|
|
Revision 1.2 1998/04/26 21:49:09 florian
|
|
+ first compiling and working version
|
|
+ first compiling and working version
|
|
-}
|
|
|
|
|
|
+}
|