سورس تشخيص نوع ويندوز و تشخيص چند بيتي بودن ويندوز با ويژوال بيسيک VB

          Mohammad 
            بازدید : 405
          چهارشنبه 04 بهمن 1391
           نظرات (2)
        

کدهاي زير را در يک ماجول قرار دهيد...

						'userinfo

						Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long

						'resolutieinfo

						'is er een netwerk geïnstalleerd?

						Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long

						Public Const SM_CXSCREEN = 0

						Public Const SM_CYSCREEN = 1

						'zoek aanwezige drives

						Public Declare Function GetLogicalDrives Lib "kernel32" () As Long

						Public Const A = 1, B = 2, C = 4, d = 8, E = 16, F = 32, G = 64, H = 128

						Public Const i = 256, j = 512, K = 1024, L = 2048, M = 4096, N = 8192

						Public Const O = 16384, P = 32768, Q = 65536, r = 131072, S = 262144

						Public Const T = 524288, U = 1048576, V = 2097152, W = 4194304

						Public Const x = 8388608, y = 16777216, Z = 33554432

						'soundcard?

						Public Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long

						'# kleuren

						Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

						Public Const HORZRES = 8  ' X axis  in pixels

						Public Const VERTRES = 10 ' Y axis in pixels

						Public Const BITSPIXEL = 12   '  Number of bits per pixel

						'vrij memory

						Public 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

						Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpbuffer As MEMORYSTATUS)

						'schijf gegevens

						Public Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

						'processor gegevens

						Public Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

						Public 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

						'computernaam

						Public Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long

						'type drive

						Public Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

						Public Const DRIVE_UNKNOWN = 0

						Public Const DRIVE_DOES_NOT_EXIST = 1

						Public Const DRIVE_REMOVABLE = 2

						Public Const DRIVE_FIXED = 3

						Public Const DRIVE_REMOTE = 4

						Public Const DRIVE_CDROM = 5

						Public Const DRIVE_RAMDISK = 6

						'get computername

						Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpbuffer As String, nSize As Long) As Long

						'schijfruimte

						Public Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long

سپس يک کامند باتن و دو تا تکست باکس بزاريد روي فرم و کدهاي زير را در بخش کد نويسي برنامه کپي کنيد،بعدش برنامه رو اجرا کنيد و روي کامند کليک کنيد،در تکست باکس اول نوع ويندوز رو مشخص ميکنه و در تکست باکس دوم نوع چند بيتي بودنش رو.

						Option Explicit

						Private rval As Long

						Private buff As String

						Private xx As Long

						Private ndevice As Integer

						Private bp As Long

						Private ncol As Variant

						Private strDriveNaam As String

						Private strPcNaam As String

						Private UserName As String

						Private strGetPcNaam As String

						Private Sub Command1_Click()

						Dim drvserialno As Long

						Dim mydrvlabel As String * 256

						Dim myfilesys As String * 256

						Dim i As Long

						Dim j As Long

						Dim x As Long

						x = GetVolumeInformation(strDriveNaam, mydrvlabel, 256, drvserialno, i, j, myfilesys, 256)

						Text1.Text = mydrvlabel

						Dim ii As Integer

						Dim strWaarde As String

						bp = GetDeviceCaps(Me.hdc, BITSPIXEL)

						ncol = 1

						For ii = 1 To bp

						ncol = ncol * 2

						Next

						If ncol = 4294967296# Then

						    strWaarde = "32 bits kleuren"

						ElseIf ncol = 65536 Then

						    strWaarde = "16 bits kleuren"

						Else

						    strWaarde = ncol & " kleuren"

						End If

						Text2.Text = strWaarde

						End Sub