|
Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags As Integer) As Long
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 GetWinFlags& Lib "Kernel" () Declare Function GetHeapSpaces& Lib "Kernel" (ByVal hModule As Integer) Declare Function GetFileVersionInfo% Lib "VER.DLL" (ByVal lpszFileName$, ByVal handle As Any, ByVal cbBuf&, ByVal lpvData$) Declare Function getversion Lib "kernel" () As Long Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer Dim DOSVer$, winver$, windir$, sysdir$, wmode$, mchip$, defdir$ Sub Form_Load () 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" defdir$ = app.Path If Right$(defdir$, 1) "\" Then defdir$ = defdir$ + "\" End Sub Sub Form_Paint () CurrentY = 100 Print " Windows Dir"; Tab(18); windir$ Print " System Dir "; Tab(18); sysdir$ Print " EXE Name"; Tab(18); defdir$ + app.EXEName + ".EXE" Print " Memory "; Tab(18); Format$(GetFreeSpace(0) \ 1024); " KB Free" Print " GDI rsrc"; Tab(18); Format$(GetFreeResources("GDI"), "##"); "% Free" Print " User rsrc "; Tab(18); Format$(GetFreeResources("USER"), "##"); "% Free" Print " Win ver"; Tab(18); winver$ Print " DOS ver"; Tab(18); DOSVer$ Print " Mode"; Tab(18); wmode$ Print " Math Chip "; Tab(18); mchip$ End Sub Function GetFreeResources (ModuleName$) rInfo& = GetHeapSpaces&(GetModuleHandle(ModuleName$)) 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 GetFreeResources = FreeR& * 100 \ Totalr& End Function Sub Command1_Click () Unload Me End Sub |