'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