'Getting system information
'on a Module
Option Explicit
#If Win32 Then
type
SYSTEM_INFO
dwOemID as
Long
dwPageSize as
Long
lpMinimumApplicationAddress as
Long
lpMaximumApplicationAddress as
Long
dwActiveProcessorMask as
Long
dwNumberOrfProcessors as
Long
dwProcessorType as
Long
dwAllocationGranularity as
Long
dwReserved as
Long
end
Type
type
OSVERSIONINFO
dwOSVersionInfoSize as
Long
dwMajorVersion as
Long
dwMinorVersion as
Long
dwBuildNumber as
Long
dwPlatformId as
Long
szCSDVersion as
String * 128
end
Type
type
MEMORYSTATUS
dwLength as
Long
dwMemoryLoad as
Long
dwTotalPhys as
Long
dwAvailPhys as
Long
dwTotalPageFile as
Long
dwAvailPageFile as
Long
dwTotalVirtual as
Long
dwAvailVirtual as
Long
end
Type
Declare Function GetSystemDirectory Lib "kernel32" alias
"GetSystemDirectoryA" (ByVal lpBuffer as
String, ByVal nSize as
Long) as
Long
Declare Function GetWindowsDirectory Lib "kernel32" alias
"GetWindowsDirectoryA" (ByVal lpBuffer as
String, ByVal nSize as
Long) as
Long
Declare Function GetFileVersionInfo Lib "version.dll" alias
"GetFileVersionInfoA" (ByVal lptstrFilename as
String, ByVal dwHandle as
Long, ByVal dwLen as
Long, lpData as
Any) as
Long
Declare Function GetVersion Lib "kernel32" () as
Long
Declare Function GetModuleHandle Lib "kernel32" alias
"GetModuleHandleA" (ByVal lpModuleName as
String) as
Long
Declare Function GetVersionEx Lib "kernel32" alias
"GetVersionExA" (LpVersionInformation as
OSVERSIONINFO) as
Long
Declare sub
GlobalMemoryStatus Lib "kernel32" (lpBuffer as
MEMORYSTATUS)
Declare sub
GetSystemInfo Lib "kernel32" (lpSystemInfo as
SYSTEM_INFO)
Public Const PROCESSOR_INTEL_386 = 386
Public Const PROCESSOR_INTEL_486 = 486
Public Const PROCESSOR_INTEL_PENTIUM = 586
Public Const PROCESSOR_MIPS_R4000 = 4000
Public Const PROCESSOR_ALPHA_21064 = 21064
#Else
' Constants for GetWinFlags.
Global Const WF_CPU286 = &H2
Global Const WF_CPU386 = &H4
Global Const WF_CPU486 = &H8
Global Const WF_80x87 = &H400
Global Const WF_STANDARD = &H10
Global Const WF_ENHANCED = &H20
Global Const WF_WINNT = &H4000
' type
for SystemHeapInfo.
type
SYSHEAPINFO
dwSize as
Long
wUserFreePercent as
Integer
wGDIFreePercent as
Integer
hUserSegment as
Integer
hGDISegment as
Integer
end
Type
Declare Function GetVersion Lib "Kernel" () as
Long
Declare Function GetWinFlags Lib "Kernel" () as
Long
Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags as
Integer) as
Long
Declare Function GlobalCompact Lib "Kernel" (ByVal dwMinFree as
Long) as
Long
Declare Function SystemHeapInfo Lib "toolhelp.dll" (shi as
SYSHEAPINFO) as
Integer
Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer as
String, ByVal nSize as
Integer) as
Integer
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer as
String, ByVal nSize as
Integer) as
Integer
Declare Function GetFileVersionInfo% Lib "VER.DLL" (ByVal lpszFileName$, ByVal handle as
Any, ByVal cbBuf&, ByVal lpvData$)
Declare Function GetVersion Lib "Kernel" alias
"getversion" () as
Long
Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName as
String) as
Integer
Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags as
Integer) as
Long
#End If
'on a form
Option Explicit
Dim dosver$, winver$, windir$, sysdir$
Dim sdir$, wmode$, mchip$, defdir$
Dim MemTotaal$, MemBeschikbaar$, MemVirtueelTotaal$, MemVirtueelBeschikbaar$
Private sub
Form_Paint()
CurrentY = 100
Const TabStop = 26
#If Win32 Then
Print " Windows Dir"; Tab(TabStop); windir$
Print " System Dir"; Tab(TabStop); sysdir$
Print " Totaal Geheugen:"; Tab(TabStop); MemTotaal$
Print " Beschikbaar Geheugen:"; Tab(TabStop); MemBeschikbaar$
Print " Virtueel Geheugen:"; Tab(TabStop); MemVirtueelTotaal$
Print " Beschikbaar Virtueel:"; Tab(TabStop); MemVirtueelBeschikbaar$
Print " Operating System"; Tab(TabStop); winver$
Print " Windows versie"; Tab(TabStop); dosver$
Print " CPU Chip"; Tab(TabStop); mchip$
#Else
Print " Windows Dir"; Tab(TabStop); windir$
Print " System Dir "; Tab(TabStop); sysdir$
Print " Memory "; Tab(TabStop); Format$(GetFreeSpace(0) \ 1024); " KB Free"
Print " GDI rsrc "; Tab(TabStop); Format$(GetFreeResources("GDI"), "##"); "% Free"
Print " User rsrc "; Tab(TabStop); Format$(GetFreeResources("USER"), "##"); "% Free"
Print " Win ver "; Tab(TabStop); winver$
Print " DOS ver "; Tab(TabStop); dosver$
Print " Mode "; Tab(TabStop); wmode$
Print " Math Chip "; Tab(TabStop); mchip$
#End If
End Sub
Private sub
Form_Load()
dim
msg as
String ' Status information.
dim
nl as
String ' New-line.
dim
ret%, buffer$
dim
ver_major$, ver_minor$, build$
#If Win32 Then
' Get windowsdirectory
buffer$ = Space(255)
ret% = GetWindowsDirectory(buffer, 255)
windir$ = Left$(buffer$, ret%)
buffer$ = Space(255)
ret% = GetSystemDirectory(buffer, 255)
sysdir$ = Left$(buffer$, ret%)
' Get operating system and version.
dim
verinfo as
OSVERSIONINFO
verinfo.dwOSVersionInfoSize = Len(verinfo)
ret% = GetVersionEx(verinfo)
If ret% = 0 Then
MsgBox "Error Getting Version Information"
Exit Sub
end
If
select
case
verinfo.dwPlatformId
case
0
winver$ = "Windows 32s "
case
1
winver$ = "Windows 95 "
case
2
winver$ = "Windows NT "
end
Select
ver_major$ = verinfo.dwMajorVersion
ver_minor$ = verinfo.dwMinorVersion
build$ = verinfo.dwBuildNumber
dosver$ = ver_major$ + "." + ver_minor$
dosver$ = dosver$ + " (Build " + build$ + ")"
' Get CPU type
and operating mode.
dim
sysinfo as
SYSTEM_INFO
GetSystemInfo sysinfo
select
case
sysinfo.dwProcessorType
case
PROCESSOR_INTEL_386
mchip$ = "Intel 386"
case
PROCESSOR_INTEL_486
mchip$ = "Intel 486"
case
PROCESSOR_INTEL_PENTIUM
mchip$ = "Intel Pentium"
case
PROCESSOR_MIPS_R4000
mchip$ = "MIPS R4000"
case
PROCESSOR_ALPHA_21064
mchip$ = "DEC Alpha 21064"
case
Else
mchip$ = "(unknown)"
end
Select
' Get free memory.
dim
memsts as
MEMORYSTATUS
dim
memory&
GlobalMemoryStatus memsts
memory& = memsts.dwTotalPhys
MemTotaal = Format$(memory& \ 1024, "###,###,###") + "K"
memory& = memsts.dwAvailPhys
MemBeschikbaar = Format$(memory& \ 1024, "###,###,###") + "K"
memory& = memsts.dwTotalVirtual
MemVirtueelTotaal = Format$(memory& \ 1024, "###,###,###") + "K"
memory& = memsts.dwAvailVirtual
MemVirtueelBeschikbaar = Format$(memory& \ 1024, "###,###,###") + "K"
' Get free system resources.
' Not applicable to 32-bit operating system (Windows NT).
#Else
dim
buff$, TChars%, ver&, dosver1!
dim
ret%, pos%, flag&
buff$ = Space$(255)
TChars% = GetWindowsDirectory(buff$, 255)
windir$ = Left$(buff$, TChars%)
buff$ = Space$(255)
TChars% = GetSystemDirectory(buff$, 255)
sysdir$ = Left$(buff$, TChars%)
ver& = GetVersion() / 65536
dosver1! = ver& / 256
dosver1! = dosver1! + (ver& Mod 256) / 100
dosver$ = Format$(Trim$(Str$(dosver1!)), "#.00")
dim
version as
String * 255
version = Space$(255)
ret% = GetFileVersionInfo%("user.exe", 0&, 254, version)
pos% = InStr(1, version, "FileVersion")
winver$ = Format$(Mid$(version, pos% + 12, 4), "##.00")
flag& = GetWinFlags&()
If flag& And &H20 Then wmode$ = "Enhanced" Else wmode$ = "Standard"
If flag& And &H400 Then mchip$ = "Yes" Else mchip$ = "No"
#End If
MousePointer = 0
End Sub
Private Function GetFreeResources(ModuleName$)
dim
rInfo&, Totalr&, FreeR&
Totalr& = rInfo& \ &H10000 'hi word
If Totalr& < 0 Then Totalr& = Totalr& + &H10000
FreeR& = rInfo& Mod &H10000 'lo word
If FreeR& < 0 Then FreeR& = FreeR& + &H10000
End Function
Return