|
Okienko typu - System Info |
|
|
|
Napisał Administrator
|
|
sobota, 21 styczeń 2006 |
'utworz forme z etykieta na niej
'Dodaj kod do odpowiednich miejsc
'form1 Sekcja General
Option Explicit
Dim dosver$, winver$, windir$, sysdir$
Dim sdir$, wmode$, mchip$, defdir$
Dim MemTotaal$, MemBeschikbaar$, MemVirtueelTotaal$, MemVirtueelBeschikbaar$
Dim vTekst$
Private Sub Form_Load()
Dim msg As String
Dim ret%, buffer$
Dim ver_major$, ver_minor$, build$
vTekst$ = "System Information" & vbCrLf & vbCrLf
' Get windowsdirectory
buffer$ = Space(255)
ret% = GetWindowsDirectory(buffer, 255)
windir$ = Left$(buffer$, ret%)
vTekst$ = vTekst$ & "windowsdirectory: " & windir$ & vbCrLf
buffer$ = Space(255)
ret% = GetSystemDirectory(buffer, 255)
sysdir$ = Left$(buffer$, ret%)
vTekst$ = vTekst$ & "windows-systemdirectory: " & sysdir$ & vbCrLf
buffer$ = Environ("temp")
vTekst$ = vTekst$ & "tempory-directory: " & buffer$ & vbCrLf
' 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
vTekst$ = vTekst$ & "operating system: " & winver$ & vbCrLf
ver_major$ = verinfo.dwMajorVersion
ver_minor$ = verinfo.dwMinorVersion
build$ = verinfo.dwBuildNumber
dosver$ = ver_major$ + "." + ver_minor$
dosver$ = dosver$ + " (Build " + build$ + ")"
vTekst$ = vTekst$ & "windows-version: " & dosver$ & vbCrLf
' 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
vTekst$ = vTekst$ & "processor: " & mchip$ & vbCrLf
' Get free memory.
Dim memsts As MEMORYSTATUS
Dim memory&
GlobalMemoryStatus memsts
memory& = memsts.dwTotalPhys
MemTotaal = Format$(memory& \ 1024, "###,###,###") + "K"
vTekst$ = vTekst$ & "Total Memory: " & MemTotaal$ & vbCrLf
memory& = memsts.dwAvailPhys
MemBeschikbaar = Format$(memory& \ 1024, "###,###,###") + "K"
vTekst$ = vTekst$ & "Free Memory: " & MemBeschikbaar$ & vbCrLf
memory& = memsts.dwTotalVirtual
MemVirtueelTotaal = Format$(memory& \ 1024, "###,###,###") + "K"
vTekst$ = vTekst$ & "Virtual Memory: " & MemVirtueelTotaal$ & vbCrLf
memory& = memsts.dwAvailVirtual
MemVirtueelBeschikbaar = Format$(memory& \ 1024, "###,###,###") + "K"
vTekst$ = vTekst$ & "Free Virtual Memory:" & MemVirtueelBeschikbaar$ & vbCrLf & vbCrLf
vTekst$ = vTekst$ & "application: " & App.EXEName & vbCrLf
vTekst$ = vTekst$ & "location: " & App.Path & vbCrLf
vTekst$ = vTekst$ & "version: " & App.Major & "." &
App.Minor & " (" & App.Revision & ")" & vbCrLf
vTekst$ = vTekst$ & App.CompanyName & vbCrLf
vTekst$ = vTekst$ & App.LegalCopyright & vbCrLf
vTekst$ = vTekst$ & App.LegalTrademarks & vbCrLf
'also App.Title, App.Comments, App.Produktname... just see the helpfile on App
MousePointer = vbNormal
Label1.Caption = vTekst$
End Sub
'w module kodu
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
Aby dodać komentarz zaloguj się. Jeśli nie masz konta, załóż je sobie.
Tylko zarejestrowani użytkownicy mogą pisać komentarze. Powered by AkoComment 2.0! |
