InfoSystem (2)

'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

'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