* disksize/diskfree return now a int64

This commit is contained in:
florian 2000-01-24 21:57:56 +00:00
parent f53621ffe2
commit a8c87c6549

View File

@ -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 DiskFree(drive: byte) : int64;
Function DiskSize(drive: byte) : longint; 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;
function diskfree(drive : byte) : longint; var
GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
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 if assigned(GetDiskFreeSpaceEx) then
diskfree:=free*secs*bytes 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 if assigned(GetDiskFreeSpaceEx) then
disksize:=total*secs*bytes 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
} }