Login
Templates, Tools and Utilities
for Clarion Developers
Templates, Tools and Utilities
|
||
|
|
|
Add a comment to an Icetips ArticlePlease add your comments to this article.
Please note that you must provide both a name and a valid email address in order
for us to publish your comment. Comments are moderated and are not visible until they have been approved. Spam is never approved!
Back to article list Search Articles Add Comment Printer friendly Direct link 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
Today is November 23, 2024, 3:33 am This article has been viewed 35272 times. Google search has resulted in 589 hits on this article since January 25, 2004.
|
|