Templates: Get system and disk resources 1999-01-15 -- John (silverghost) Newsgroups: comp.lang.clarion
Editors note: Please note that some lines may wrap in the template code.
Randy,
I've made a template for checking file size, diskspace & diskleft
Hope this helps.
John
Randy McCharles wrote:
> Does anyone know the best way for a Clarion W4 Application to test for
> available disk space and memory in Windows 95, 98, & NT? I'd like to warn
> the user if the system is about to hang due to lack of resources.
#Template(Volume,'Serial Number,Disksize & Diskleft'),FAMILY('ABC'),FAMILY('CW20')
#Extension(Volume,'32 Bit Only - Functions to Add to Program' )
#!-----------------------------------------------------------------
#BOXED('32 bit ONLY Serial No, Disksize & Diskleft by SilverGhost')
#DISPLAY('')
#BOXED('To use Functions ')
#DISPLAY('Volume Serial Number = volume() '),AT(30)
#DISPLAY('Disksize K bytes = disksize() '),AT(30)
#DISPLAY('Diskleft K bytes= diskleft() '),AT(30)
#DISPLAY('Drivetype = Drivetype() '),AT(30)
#DISPLAY('')
#ENDBOXED
#BOXED('Select the Drive')
#display('')
#PROMPT('Enter Drive Letter',@S1),%Globaldrive,REQ
#DISPLAY('')
#ENDBOXED
#DISPLAY('')
#BOXED('Extra Functions')
#DISPLAY('')
#DISPLAY('Display Windows Directory = WINDIR()'),AT(30)
#DISPLAY('')
#DISPLAY('Display System Directory = SYSDIR()'),AT(30)
#DISPLAY('')
#DISPLAY('Display Processor Type = INFO(dwProcessorType)'),AT(15)
#DISPLAY('')
#ENDBOXED
#DISPLAY('')
#ENDBOXED
#!=====================================================================
#AT(%AfterGlobalIncludes)
INCLUDE('VOLUMEQU.CLW')
dwOEMID EQUATE(1)
dwNumberOfProcessors EQUATE(2)
dwProcessorType EQUATE(3)
dwProcessorRevision EQUATE(4)
#ENDAT
#!----------------------------------------------------------------
#AT(%GlobalMap)
MODULE('Windows.DLL')
GetSystemInfo(*SYSTEM_INFO),PASCAL,RAW
GetLastError(),DWORD,PASCAL
GetVolumeInformationA(*LPCSTR,*LPSTR,DWORD,*DWORD,|
*DWORD,*DWORD, *LPSTR ,DWORD),BOOL,PASCAL,RAW
GetDiskFreeSpaceA(*LPCSTR,*DWORD,*DWORD,*DWORD,|
*DWORD),BOOL,PASCAL,RAW
OMIT('***',_WIDTH32_)
GetDriveType( SIGNED),WORD,PASCAL
***
COMPILE('***',_WIDTH32_)
GetDriveType(*LPCSTR),UNSIGNED,PASCAL,RAW,NAME('GetDriveTypeA')
***
OMIT('***',_WIDTH32_)
GetSystemDirectory(*LPSTR, WORD),WORD,PASCAL,RAW
***
COMPILE('***',_WIDTH32_)
GetSystemDirectory(*LPSTR,UNSIGNED),UNSIGNED,PASCAL,RAW,NAME('GetSystemDirectoryA')
***
! GetSystemDir(*LPCSTR,*LPSTR),SIGNED,PASCAL,RAW
OMIT('***',_WIDTH32_)
GetWindowsDirectory(*LPSTR, WORD),WORD,PASCAL,RAW
***
COMPILE('***',_WIDTH32_)
GetWindowsDirectory(*LPSTR,UNSIGNED),UNSIGNED,PASCAL,RAW,NAME('GetWindowsDirectoryA')
***
END
VOLUME(),LONG,PASCAL
DISKSIZE(),LONG,PASCAL
DISKLEFT(),LONG,PASCAL
DRIVETYPE(),STRING,PASCAL
INFO(STRING),STRING
WINDIR(),STRING,PASCAL
SYSDIR(),STRING,PASCAL
#ENDAT
#!----------------------------------------------------------------
#GLOBALDATA
GLOBALDRIVE STRING(1)
#ENDGLOBALDATA
#!----------------------------------------------------------------
#AT(%Programsetup)
GLOBALDRIVE = UPPER('%GLOBALDRIVE')
#ENDAT
#!================================================================
#AT(%ProgramProcedures)
VOLUME FUNCTION()
RootPathName LPCSTR(4)
VolumeName LPTSTR(15)
VolumeNameSize DWORD(128)
VolSerialNum DWORD(15)
MaxCompLen DWORD(15)
FileSysFlags DWORD(15)
FileSysName LPTSTR(15)
FileSName DWORD(15)
CODE
RootPathName = GLOBALDRIVE &':'
CASE GetVolumeInformationA(RootPathName, |
VolumeName, |
VolumeNameSize, |
VolSerialNum, |
MaxCompLen, |
FileSysFlags, |
FileSysName, |
FileSName)
OF FALSE
IF GETLASTERROR() = 161 THEN
MESSAGE('Please specify Drive |' &|
'Volume Serial No')
else
MESSAGE('API Error '&GetLastError())
end
END
RETURN(VolSerialNum)
!---------------------------------------------------------------------------
DISKSIZE FUNCTION()
ROOTPATH LPCSTR(4)
SECTSPERCLUSTER DWORD(0)
BYTESPERSECTOR DWORD(0)
FREECLUSTERS DWORD(0)
TOTALCLUSTERS DWORD(0)
DRIVENAME CSTRING(4)
DISK REAL
CODE
ROOTPATH = GLOBALDRIVE &':'
CASE
GetDiskFreeSpaceA(ROOTPATH,SECTSPERCLUSTER,BYTESPERSECTOR,FREECLUSTERS,TOTALCLUSTERS)
OF TRUE
DISK = SECTSPERCLUSTER * BYTESPERSECTOR * TOTALCLUSTERS / 1024
OF FALSE
IF GETLASTERROR() = 123 THEN
MESSAGE('Please specify Drive |' &|
' DiskSize')
else
MESSAGE('API Error '&GetLastError())
end
END
RETURN(DISK)
!--------------------------------------------------------------------------
DISKLEFT FUNCTION()
ROOTPATH LPCSTR(4)
SECTSPERCLUSTER DWORD(0)
BYTESPERSECTOR DWORD(0)
FREECLUSTERS DWORD(0)
TOTALCLUSTERS DWORD(0)
DRIVENAME CSTRING(4)
DISKLEFT REAL
CODE
ROOTPATH = GLOBALDRIVE &':'
CASE
GetDiskFreeSpaceA(ROOTPATH,SECTSPERCLUSTER,BYTESPERSECTOR,FREECLUSTERS,TOTALCLUSTERS)
OF TRUE
DISKLEFT = SECTSPERCLUSTER * BYTESPERSECTOR * FREECLUSTERS / 1024
OF FALSE
IF GETLASTERROR() = 123 THEN
MESSAGE('Please specify Drive |' &|
' DiskLeft')
else
MESSAGE('API Error '&GetLastError())
end
END
RETURN(DISKLEFT &' Kbytes')
!-------------------------------------------------------------------------
DRIVETYPE FUNCTION()
DRIVETYPE STRING(15)
DRIVENAME CSTRING(4)
Drive_Unknown EQUATE(0)
Drive_No_Root_Dir EQUATE(1)
Drive_Removable EQUATE(2)
Drive_Fixed EQUATE(3)
Drive_Remote EQUATE(4)
Drive_CDROM EQUATE(5)
Drive_RamDisk EQUATE(6)
CODE
DRIVENAME = GLOBALDRIVE &':'
CASE GetDriveType(DRIVENAME)
OF Drive_Unknown
DRIVETYPE = 'Not Known'
OF Drive_No_Root_Dir
DRIVETYPE = 'Not Know'
OF Drive_Removable
DRIVETYPE = 'Removable'
OF Drive_Fixed
DRIVETYPE = 'Fixed'
OF Drive_Remote
DRIVETYPE = 'Network'
OF Drive_CDROM
DRIVETYPE = 'CDROM'
OF Drive_RamDisk
DRIVETYPE = 'Ramdisk'
END
RETURN(DRIVETYPE)
!--------------------------------------------------------------------------
INFO FUNCTION(xINFO)
ENDPRO CSTRING(15)
SYSTEM_INFO GROUP,TYPE
dwOemId DWORD
dwPageSize DWORD
pMinimumApplicationAddress LPVOID
lpMaximumApplicationAddress LPVOID
dwActiveProcessorMask DWORD
dwNumberOfProcessors DWORD
dwProcessorType DWORD
dwAllocationGranularity DWORD
dwReserved DWORD
END
SystemInfo LIKE(SYSTEM_INFO),AUTO
CODE
CLEAR(SystemInfo)
GetSystemInfo(SystemInfo)
CASE xINFO
OF dwOEMID
RETURN(SystemInfo.dwOEMID)
OF dwNumberOfProcessors
RETURN(SystemInfo.dwNumberOfProcessors)
OF dwProcessorType
RETURN(SystemInfo.dwProcessorType)
OF dwProcessorRevision
RETURN(SystemInfo.dwAllocationGranularity)
END
!-------------------------------------------------------------------------
WINDIR FUNCTION()
WDIR EQUATE(256)
WWDIR CSTRING(WDIR)
WRDIR STRING(255)
CODE
WDIR# = GetWindowsDirectory(WWDIR,WDIR)
WRDIR = CLIP(WWDIR) & '\'
RETURN(WRDIR)
!-------------------------------------------------------------------------
SYSDIR FUNCTION()
WSYS EQUATE(256)
SSDIR CSTRING(WSYS)
SYDIR STRING(255)
CODE
WSYS# = GetSystemDirectory(SSDIR,WSYS)
SYDIR = CLIP(SSDIR) & '\'
RETURN(SYDIR)
!-------------------------------------------------------------------------
#ENDAT
Printed May 3, 2024, 6:08 am This article has been viewed/printed 35128 times. Google search has resulted in 589 hits on this article since January 25, 2004. |