说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

如何在vb中通过程序获取计算机一系列硬件信息?

编辑:说三道四文库 发布时间:2017-12-15 09:04
HTML文档下载 WORD文档下载 PDF文档下载
如何在vb中通过程序获取计算机一系列硬件信息?(硬盘出厂序列号、系统时间、本地时间、计算机名、BIOS系统信息、WINDOWS序列号、网卡地址、本机IP地址……)

如果不行,怎样得到本机IP和计算机名
关注中~
关于硬盘序列号这有:
http://expert.csdn.net/Expert/topic/1526/1526713.xml?temp=.9151728

系统时间和本地时间有什么区别? 用VB的 Now() 函数就可以了,连日期都有。
计算机名:
GetComputerName 

VB声明 
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long 
说明 
取得这台计算机的名称 
返回值 
Long,TRUE(非零)表示成功,否则返回零。会设置GetLastError 
参数表 
参数 类型及说明 
lpBuffer String,随同计算机名载入的字串缓冲区 
nSize Long,缓冲区的长度。这个变量随同返回计算机名的实际长度载入 
注解 
注意nSize参数并不是按值传递的。参考api32.txt,了解MAX_COMPUTER_NAME常数的值
 
示例 
Dim s$
s$ = String$(MAX_COMPUTERNAME_LENGTH+1,0)
Dim dl&
Dim sz&
sz& = MAX_COMPUTERNAME_LENGTH+1
dl& = GetComputerName(s$, sz) 

其他的可以看看有没有相应的API实现,有的也在注册表中可以找到,读一下注册表就OK了。
本机IP,名:
Option Explicit


Private Const WS_VERSION_REQD = &H101
     Private Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF&
     Private Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF&
     Private Const MIN_SOCKETS_REQD = 1
     Private Const SOCKET_ERROR = -1
     Private Const WSADescription_Len = 256
     Private Const WSASYS_Status_Len = 128
     
     Private Type HOSTENT
     hName As Long
     hAliases As Long
     hAddrType As Integer
     hLength As Integer
     hAddrList As Long
     End Type
     
     Private Type WSADATA
     wversion As Integer
     wHighVersion As Integer
     szDescription(0 To WSADescription_Len) As Byte
     szSystemStatus(0 To WSASYS_Status_Len) As Byte
     iMaxSockets As Integer
     iMaxUdpDg As Integer
     lpszVendorInfo As Long
     End Type
     
     Private Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long
     Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
     wVersionRequired&, lpWSAData As WSADATA) As Long
     Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
     
     Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal hostname$, ByVal HostLen As Long) As Long
     Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal _
     hostname$) As Long
     Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)
     
     Function hibyte(ByVal wParam As Integer)
     
     hibyte = wParam \ &H100 And &HFF&
     
     End Function
     
     Function lobyte(ByVal wParam As Integer)
     
     lobyte = wParam And &HFF&
     
     End Function
     
     Sub SocketsInitialize()
     Dim WSAD As WSADATA
     Dim iReturn As Integer
     Dim sLowByte As String, sHighByte As String, sMsg As String
     
     iReturn = WSAStartup(WS_VERSION_REQD, WSAD)
     
     If iReturn <> 0 Then
     MsgBox "Winsock.dll is not responding."
     End
     End If
     
     If lobyte(WSAD.wversion) < WS_VERSION_MAJOR Or (lobyte(WSAD.wversion) = _
     WS_VERSION_MAJOR And hibyte(WSAD.wversion) < WS_VERSION_MINOR) Then
     
     sHighByte = Trim$(Str$(hibyte(WSAD.wversion)))
     sLowByte = Trim$(Str$(lobyte(WSAD.wversion)))
     sMsg = "Windows Sockets version " & sLowByte & "." & sHighByte
     sMsg = sMsg & " is not supported by winsock.dll "
     MsgBox sMsg
     End
     End If
     
     'iMaxSockets is not used in winsock 2. So the following check is only
     'necessary for winsock 1. If winsock 2 is requested,
     'the following check can be skipped.
     
     If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then
     sMsg = "This application requires a minimum of "
     sMsg = sMsg & Trim$(Str$(MIN_SOCKETS_REQD)) & " supported sockets."
     MsgBox sMsg
     End
     End If
     
     End Sub
     
     Sub SocketsCleanup()
     Dim lReturn As Long
     
     lReturn = WSACleanup()
     
     If lReturn <> 0 Then
     MsgBox "Socket error " & Trim$(Str$(lReturn)) & " occurred in Cleanup "
     End
     End If
     
     End Sub
     

     Sub Form_Load()
     
     SocketsInitialize
     
     End Sub
     
     Private Sub Form_Unload(Cancel As Integer)
     
     SocketsCleanup
     
     End Sub
     
     Private Sub Command1_Click()
     Dim hostname As String * 256
     Dim hostent_addr As Long
     Dim host As HOSTENT
     Dim hostip_addr As Long
     Dim temp_ip_address() As Byte
     Dim i As Integer
     Dim ip_address As String
     
     If gethostname(hostname, 256) = SOCKET_ERROR Then
     MsgBox "Windows Sockets error " & Str(WSAGetLastError())
     Exit Sub
     Else
     hostname = Trim$(hostname)
     End If
     
     hostent_addr = gethostbyname(hostname)
     
     If hostent_addr = 0 Then
     MsgBox "Winsock.dll is not responding."
     Exit Sub
     End If
     
     RtlMoveMemory host, hostent_addr, LenB(host)
     RtlMoveMemory hostip_addr, host.hAddrList, 4
     
     Text1.Text = hostname   '计算机名
     
     'get all of the IP address if machine is multi-homed
     
     Do
     ReDim temp_ip_address(1 To host.hLength)
     RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
     
     For i = 1 To host.hLength
     ip_address = ip_address & temp_ip_address(i) & "."
     Next
     ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
     
     Text2.Text = ip_address   'IP
     
     ip_address = ""
     host.hAddrList = host.hAddrList + LenB(host.hAddrList)
     RtlMoveMemory hostip_addr, host.hAddrList, 4
     Loop While (hostip_addr <> 0)
     
     End Sub
HD序列号:
Option Explicit

'http://vip.6to23.com/NowCan1/tech/vb_hd_info.htm
'--------------------------------------------------------------------------
'   类模块: CDiskInfo.cls
'   功能说明:获取硬盘序列号、生产厂家/型号
'   注意事项:支持Windows 95 OSR2, Windows 98, Windows NT, Windows 2000
'             XP没有测试,估计没问题,在Win9X下必须保证存在smartvsd.vxd
'             放在System\Iosubsys目录下,smartvsd.VXD在98第二版安装盘的
'             WIN98_62.CAB文件中
'--------------------------------------------------------------------------
'################################################################################
'窗体中的调用方法:
'Option Explicit

'Private hdi As CDiskInfo

'Private Sub Form_Load()
    'Set hdi = New CDiskInfo
    'hdi.GetDiskInfo 0
    '硬盘序列号: hdi.pSerialNumber
    '生产厂家/型号: hdi.pModelNumber
'End Sub
'################################################################################

Private Const MAX_IDE_DRIVES As Long = 4
Private Const READ_ATTRIBUTE_BUFFER_SIZE As Long = 512
Private Const IDENTIFY_BUFFER_SIZE As Long = 512
Private Const READ_THRESHOLD_BUFFER_SIZE As Long = 512
Private Const DFP_GET_VERSION As Long = &H74080
Private Const DFP_SEND_DRIVE_COMMAND As Long = &H7C084
Private Const DFP_RECEIVE_DRIVE_DATA As Long = &H7C088

Private Type GETVERSIONOUTPARAMS
    bVersion As Byte
    bRevision As Byte
    bReserved As Byte
    bIDEDeviceMap As Byte
    fCapabilities As Long
    dwReserved(3) As Long
End Type

Private Const CAP_IDE_ID_FUNCTION As Long = 1
Private Const CAP_IDE_ATAPI_ID As Long = 2
Private Const CAP_IDE_EXECUTE_SMART_FUNCTION As Long = 4

Private Type IDEREGS
    bFeaturesReg As Byte
    bSectorCountReg As Byte
    bSectorNumberReg As Byte
    bCylLowReg As Byte
    bCylHighReg As Byte
    bDriveHeadReg As Byte
    bCommandReg As Byte
    bReserved As Byte
End Type

Private Type SENDCMDINPARAMS
    cBufferSize As Long
    irDriveRegs As IDEREGS
    bDriveNumber As Byte
    bReserved(2) As Byte
    dwReserved(3) As Long
    bBuffer(0) As Byte
End Type

Private Const IDE_ATAPI_ID As Long = &HA1
Private Const IDE_ID_FUNCTION As Long = &HEC
Private Const IDE_EXECUTE_SMART_FUNCTION As Long = &HB0
Private Const SMART_CYL_LOW As Long = &H4F
Private Const SMART_CYL_HI As Long = &HC2

Private Type DRIVERSTATUS
    bDriverError As Byte
    bIDEStatus As Byte
    bReserved(1) As Byte
    dwReserved(1) As Long
End Type

Private Const SMART_NO_ERROR As Long = 0
Private Const SMART_IDE_ERROR As Long = 1
Private Const SMART_INVALID_FLAG As Long = 2
Private Const SMART_INVALID_COMMAND As Long = 3
Private Const SMART_INVALID_BUFFER As Long = 4
Private Const SMART_INVALID_DRIVE As Long = 5
Private Const SMART_INVALID_IOCTL As Long = 6
Private Const SMART_ERROR_NO_MEM As Long = 7
Private Const SMART_INVALID_REGISTER As Long = 8
Private Const SMART_NOT_SUPPORTED As Long = 9
Private Const SMART_NO_IDE_DEVICE As Long = 10

Private Type SENDCMDOUTPARAMS
    cBufferSize As Long
    drvStatus As DRIVERSTATUS
    bBuffer(0) As Byte
End Type

Private Const SMART_READ_ATTRIBUTE_VALUES As Long = &HD0
Private Const SMART_READ_ATTRIBUTE_THRESHOLDS As Long = &HD1
Private Const SMART_ENABLE_DISABLE_ATTRIBUTE_AUTOSAVE As Long = &HD2
Private Const SMART_SAVE_ATTRIBUTE_VALUES As Long = &HD3
Private Const SMART_EXECUTE_OFFLINE_IMMEDIATE As Long = &HD4
Private Const SMART_ENABLE_SMART_OPERATIONS As Long = &HD8
Private Const SMART_DISABLE_SMART_OPERATIONS As Long = &HD9
Private Const SMART_RETURN_SMART_STATUS As Long = &HDA

Private Type DRIVEATTRIBUTE
    bAttrID As Byte
    wStatusFlags As Integer
    bAttrValue As Byte
    bWorstValue As Byte
    bRawValue(5) As Byte
    bReserved As Byte
End Type

Private Type ATTRTHRESHOLD
    bAttrID As Byte
    bWarrantyThreshold As Byte
    bReserved(9) As Byte
End Type

Private Type IDSECTOR
    wGenConfig As Integer
    wNumCyls As Integer
    wReserved As Integer
    wNumHeads As Integer
    wBytesPerTrack As Integer
    wBytesPerSector As Integer
    wSectorsPerTrack As Integer
    wVendorUnique(2) As Integer
    sSerialNumber(19) As Byte
    wBufferType As Integer
    wBufferSize As Integer
    wECCSize As Integer
    sFirmwareRev(7) As Byte
    sModelNumber(39) As Byte
    wMoreVendorUnique As Integer
    wDoubleWordIO As Integer
    wCapabilities As Integer
    wReserved1 As Integer
    wPIOTiming As Integer
    wDMATiming As Integer
    wBS As Integer
    wNumCurrentCyls As Integer
    wNumCurrentHeads As Integer
    wNumCurrentSectorsPerTrack As Integer
    ulCurrentSectorCapacity(3) As Byte
    wMultSectorStuff As Integer
    ulTotalAddressableSectors(3) As Byte
    wSingleWordDMA As Integer
    wMultiWordDMA As Integer
    bReserved(127) As Byte
End Type

Private Const ATTR_INVALID As Long = 0
Private Const ATTR_READ_ERROR_RATE As Long = 1
Private Const ATTR_THROUGHPUT_PERF As Long = 2
Private Const ATTR_SPIN_UP_TIME As Long = 3
Private Const ATTR_START_STOP_COUNT As Long = 4
Private Const ATTR_REALLOC_SECTOR_COUNT As Long = 5
Private Const ATTR_READ_CHANNEL_MARGIN As Long = 6
Private Const ATTR_SEEK_ERROR_RATE As Long = 7
Private Const ATTR_SEEK_TIME_PERF As Long = 8
Private Const ATTR_POWER_ON_HRS_COUNT As Long = 9
Private Const ATTR_SPIN_RETRY_COUNT As Long = 10
Private Const ATTR_CALIBRATION_RETRY_COUNT As Long = 11
Private Const ATTR_POWER_CYCLE_COUNT As Long = 12
Private Const PRE_FAILURE_WARRANTY As Long = &H1
Private Const ON_LINE_COLLECTION As Long = &H2
Private Const PERFORMANCE_ATTRIBUTE As Long = &H4
Private Const ERROR_RATE_ATTRIBUTE As Long = &H8
Private Const EVENT_COUNT_ATTRIBUTE As Long = &H10
Private Const SELF_PRESERVING_ATTRIBUTE As Long = &H20
Private Const NUM_ATTRIBUTE_STRUCTS As Long = 30
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVERSIONINFO) As Long
Private Const CREATE_NEW As Long = 1
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING  As Long = 3
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" _
    (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, _
    ByVal nInBufferSize As Long, lpOutBuffer As Any, _
    ByVal nOutBufferSize As Long, lpBytesReturned As Long, _
    ByVal lpOverlapped As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
Private m_DiskInfo As IDSECTOR

Private Function OpenSMART(ByVal nDrive As Byte) As Long

    Dim hSMARTIOCTL As Long
    Dim hd As String
    Dim VersionInfo As OSVERSIONINFO

    hSMARTIOCTL = INVALID_HANDLE_VALUE
    VersionInfo.dwOSVersionInfoSize = Len(VersionInfo)
    GetVersionEx VersionInfo
    Select Case VersionInfo.dwPlatformId
        Case VER_PLATFORM_WIN32s
            OpenSMART = hSMARTIOCTL
        Case VER_PLATFORM_WIN32_WINDOWS
            'Version Windows 95 OSR2, Windows 98
            hSMARTIOCTL = CreateFile("\\.\SMARTVSD", 0, 0, 0, CREATE_NEW, 0, 0)
        Case VER_PLATFORM_WIN32_NT
            'Windows NT, Windows 2000
            If nDrive < MAX_IDE_DRIVES Then
                hd = "\\.\PhysicalDrive" & nDrive
                hSMARTIOCTL = CreateFile(hd, GENERIC_READ Or GENERIC_WRITE, _
                FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
            End If
    End Select
    OpenSMART = hSMARTIOCTL

End Function

Private Function DoIDENTIFY(ByVal hSMARTIOCTL As Long, _
    pSCIP As SENDCMDINPARAMS, pSCOP() As Byte, ByVal bIDCmd As Byte, _
    ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
    '-------------------------------------------------------------------
    pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE

    pSCIP.irDriveRegs.bFeaturesReg = 0
    pSCIP.irDriveRegs.bSectorCountReg = 1
    pSCIP.irDriveRegs.bSectorNumberReg = 1
    pSCIP.irDriveRegs.bCylLowReg = 0
    pSCIP.irDriveRegs.bCylHighReg = 0

    pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)

    pSCIP.irDriveRegs.bCommandReg = bIDCmd
    pSCIP.bDriveNumber = bDriveNum
    pSCIP.cBufferSize = IDENTIFY_BUFFER_SIZE
    DoIDENTIFY = CBool(DeviceIoControl(hSMARTIOCTL, DFP_RECEIVE_DRIVE_DATA, _
        pSCIP, 32, pSCOP(0), 528, lpcbBytesReturned, 0))

End Function

Private Function DoEnableSMART(ByVal hSMARTIOCTL As Long, _
    pSCIP As SENDCMDINPARAMS, pSCOP As SENDCMDOUTPARAMS, _
    ByVal bDriveNum As Byte, lpcbBytesReturned As Long) As Boolean
    '---------------------------------------------------------------------
    pSCIP.cBufferSize = 0
    pSCIP.irDriveRegs.bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
    pSCIP.irDriveRegs.bSectorCountReg = 1
    pSCIP.irDriveRegs.bSectorNumberReg = 1
    pSCIP.irDriveRegs.bCylLowReg = SMART_CYL_LOW
    pSCIP.irDriveRegs.bCylHighReg = SMART_CYL_HI
    pSCIP.irDriveRegs.bDriveHeadReg = &HA0 Or ((bDriveNum And 1) * 2 ^ 4)
    pSCIP.irDriveRegs.bCommandReg = IDE_EXECUTE_SMART_FUNCTION
    pSCIP.bDriveNumber = bDriveNum

    DoEnableSMART = CBool(DeviceIoControl(hSMARTIOCTL, DFP_SEND_DRIVE_COMMAND, _
        pSCIP, LenB(pSCIP) - 1, pSCOP, LenB(pSCOP) - 1, lpcbBytesReturned, 0))

End Function

Private Sub ChangeByteOrder(szString() As Byte, ByVal uscStrSize As Integer)
    Dim i As Integer
    Dim bTemp As Byte

    For i = 0 To uscStrSize - 1 Step 2
        bTemp = szString(i)
        szString(i) = szString(i + 1)
        szString(i + 1) = bTemp
    Next i
End Sub

Private Sub DisplayIdInfo(pids As IDSECTOR, pSCIP As SENDCMDINPARAMS, _
    ByVal bIDCmd As Byte, ByVal bDfpDriveMap As Byte, ByVal bDriveNum As Byte)
    '--------------------------------------------------------------------------
    ChangeByteOrder pids.sModelNumber, UBound(pids.sModelNumber) + 1
    ChangeByteOrder pids.sFirmwareRev, UBound(pids.sFirmwareRev) + 1
    ChangeByteOrder pids.sSerialNumber, UBound(pids.sSerialNumber) + 1
End Sub

'调用过程
Public Function GetDiskInfo(ByVal nDrive As Byte) As Long
    Dim hSMARTIOCTL As Long
    Dim cbBytesReturned As Long
    Dim VersionParams As GETVERSIONOUTPARAMS
    Dim scip As SENDCMDINPARAMS
    Dim scop() As Byte
    Dim OutCmd As SENDCMDOUTPARAMS
    Dim bDfpDriveMap As Byte
    Dim bIDCmd As Byte
    Dim uDisk As IDSECTOR

    m_DiskInfo = uDisk
    
    hSMARTIOCTL = OpenSMART(nDrive)
    If hSMARTIOCTL <> INVALID_HANDLE_VALUE Then
        Call DeviceIoControl(hSMARTIOCTL, DFP_GET_VERSION, ByVal 0, 0, _
            VersionParams, Len(VersionParams), cbBytesReturned, 0)

        If Not (VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10) Then
            If DoEnableSMART(hSMARTIOCTL, scip, OutCmd, nDrive, cbBytesReturned) Then
                bDfpDriveMap = bDfpDriveMap Or 2 ^ nDrive
            End If
        End If
        bIDCmd = IIf((VersionParams.bIDEDeviceMap \ 2 ^ nDrive And &H10), _
            IDE_ATAPI_ID, IDE_ID_FUNCTION)

        ReDim scop(LenB(OutCmd) + IDENTIFY_BUFFER_SIZE - 1) As Byte
        If DoIDENTIFY(hSMARTIOCTL, scip, scop, bIDCmd, nDrive, cbBytesReturned) Then
            CopyMemory m_DiskInfo, scop(LenB(OutCmd) - 4), LenB(m_DiskInfo)
            Call DisplayIdInfo(m_DiskInfo, scip, bIDCmd, bDfpDriveMap, nDrive)
            CloseHandle hSMARTIOCTL
            GetDiskInfo = 1
            Exit Function
        End If
        CloseHandle hSMARTIOCTL
        GetDiskInfo = 0
      Else
        GetDiskInfo = -1
    End If
End Function

'硬盘生产厂/型号
Public Property Get pSerialNumber() As String
    pSerialNumber = Trim(StrConv(m_DiskInfo.sSerialNumber, vbUnicode))
End Property

'硬盘序列号
Public Property Get pModelNumber() As String
    pModelNumber = Trim(StrConv(m_DiskInfo.sModelNumber, vbUnicode))
End Property
用WMI
http://www.applevb.com/sourcecode/wmi.rar

通过VB直接从RING3获取硬盘序列号
http://www.easthot.net/article_read.asp?id=92
能否获得局域网内一台电脑的硬盘序列号???
得到机器名

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Form_Load()
    Dim dwLen As Long
    Dim strString As String
    'Create a buffer
    dwLen = MAX_COMPUTERNAME_LENGTH + 1
    strString = String(dwLen, "X")
    'Get the computer name
    GetComputerName strString, dwLen
    'get only the actual data
    strString = Left(strString, dwLen)
    'Show the computer name
    MsgBox strString
End Sub

    取得网卡序列号 
 
 


  很多软件以取得网卡地址作为License验证,这不失为一个验证合法用户的好办法,不过要付出回复用户电话、传真的代价哦 ^_^ 
  将下面这段代码拷贝到程序中,然后在你的程序需要的时候调用EthernetAddress(0),该函数返回的字符串就是您机器上网卡的以太序列号。 

Private Const NCBASTAT = &H33 
Private Const NCBNAMSZ = 16 
Private Const HEAP_ZERO_MEMORY = &H8 
Private Const HEAP_GENERATE_EXCEPTIONS = &H4 
Private Const NCBRESET = &H32 

Private Type NCB 
 ncb_command As Byte 
 ncb_retcode As Byte 
 ncb_lsn As Byte 
 ncb_num As Byte 
 ncb_buffer As Long 
 ncb_length As Integer 
 ncb_callname As String * NCBNAMSZ 
 ncb_name As String * NCBNAMSZ 
 ncb_rto As Byte 
 ncb_sto As Byte 
 ncb_post As Long 
 ncb_lana_num As Byte 
 ncb_cmd_cplt As Byte 
 ncb_reserve(9) As Byte ' Reserved, must be 0 
 ncb_event As Long 
End Type 

Private Type ADAPTER_STATUS 
 adapter_address(5) As Byte 
 rev_major As Byte 
 reserved0 As Byte 
 adapter_type As Byte 
 rev_minor As Byte 
 duration As Integer 
 frmr_recv As Integer 
 frmr_xmit As Integer 
 iframe_recv_err As Integer 
 xmit_aborts As Integer 
 xmit_success As Long 
 recv_success As Long 
 iframe_xmit_err As Integer 
 recv_buff_unavail As Integer 
 t1_timeouts As Integer 
 ti_timeouts As Integer 
 Reserved1 As Long 
 free_ncbs As Integer 
 max_cfg_ncbs As Integer 
 max_ncbs As Integer 
 xmit_buf_unavail As Integer 
 max_dgram_size As Integer 
 pending_sess As Integer 
 max_cfg_sess As Integer 
 max_sess As Integer 
 max_sess_pkt_size As Integer 
 name_count As Integer 
End Type 

Private Type NAME_BUFFER 
 name As String * NCBNAMSZ 
 name_num As Integer 
 name_flags As Integer 
End Type 

Private Type ASTAT 
 adapt As ADAPTER_STATUS 
 NameBuff(30) As NAME_BUFFER 
End Type 

Private Declare Function Netbios Lib "netapi32.dll" _
(pncb As NCB) As Byte 

Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, _
ByVal cbCopy As Long) 

Private Declare Function GetProcessHeap Lib "kernel32" () _
As Long 

Private Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, _
ByVal dwBytes As Long) As Long 

Private Declare Function HeapFree Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) _
As Long 

Private Function EthernetAddress(LanaNumber As Long) _
As String 

 Dim udtNCB    As NCB 
 Dim bytResponse As Byte 
 Dim udtASTAT   As ASTAT 
 Dim udtTempASTAT As ASTAT 
 Dim lngASTAT   As Long 
 Dim strOut    As String 
 Dim x      As Integer 

 udtNCB.ncb_command = NCBRESET 
 bytResponse = Netbios(udtNCB) 
 udtNCB.ncb_command = NCBASTAT 
 udtNCB.ncb_lana_num = LanaNumber 
 udtNCB.ncb_callname = "* " 
 udtNCB.ncb_length = Len(udtASTAT) 
 lngASTAT = HeapAlloc(GetProcessHeap(), _
HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, udtNCB.ncb_length) 

 strOut = "" 
 If lngASTAT Then 
  udtNCB.ncb_buffer = lngASTAT 
  bytResponse = Netbios(udtNCB) 
  CopyMemory udtASTAT, udtNCB.ncb_buffer, Len(udtASTAT) 
   With udtASTAT.adapt 
   For x = 0 To 5 
    strOut = strOut & Right$("00" & Hex$(.adapter_address(x)), 2) 
   Next x 
  End With 
  HeapFree GetProcessHeap(), 0, lngASTAT 
 End If 
 EthernetAddress = strOut 
End Function  

 
   
 
  
 
WMI的应用

作  者:maqiaos_cn
发表于:2003-1-16
    WMI(Windows Management Instrumentation)技术是微软提供的Windows下的系统管理工具。
通过该工具可以在本地或者管理客户端系统中几乎一切的信息。很多专业的网络管理工具都是
基于WMI开发的。该工具在Win2000以及WinNT下是标准工具,在Win9X下是扩展安装选项。本文
将介绍如何通过VB编程来访问WMI对象的编程。

   首先来看一个简单的通过WMI获取系统信息的范例,这个范例通过WMI对象获得系统中运行
的的进程:

Function Enum1() As String
    Dim WMI

    Set WMI = GetObject("WinMgmts:")
    Set objs = WMI.InstancesOf("Win32_Process")

    For Each obj In objs
        Enum1 = Enum1 + obj.Description + Chr(13) + Chr(10)
    Next
End Function

    在上面的代码中,首先通过  GetObject("WinMgmts:")获得WMI对象,在WMI对象下有很多的
子项,在这里我们通过WMI.InstancesOf("Win32_Process")获得系统中所有的进程列表子项。

    下面看一个完整的访问WMI对象的范例,这个范例获得计算机的信息。
    建立一个新工程,在Form1中添加一个TextBox控件以及一个CommandButton控件,在
CommandButton的Click事件中写入以下的代码:


Private Sub Command1_Click()
    Dim s, System, item
    Dim i As Integer

    Set System = GetObject("winmgmts:").InstancesOf("Win32_ComputerSystem")
    For Each item In System
        ‘List1.AddItem item.cputype
        s = "Computer Info" & vbCrLf
        s = s & "***********************" & vbCrLf
        s = s & "计算机名称: " & item.name & vbCrLf
        s = s & "状态: " & item.Status & vbCrLf
        s = s & "类型: " & item.SystemType & vbCrLf
        s = s & "生产厂家: " & item.Manufacturer & vbCrLf
        s = s & "型号: " & item.Model & vbCrLf
        s = s & "内存: ~" & item.totalPhysicalMemory \ 1024000 & "mb" & vbCrLf
        s = s & "域: " & item.domain & vbCrLf
        ‘s = s & "工作组" & item.Workgroup & vbCrLf ‘获得工作组和域的选项不能同时用

        s = s & "当前用户: " & item.username & vbCrLf
        s = s & "启动状态" & item.BootupState & vbCrLf
        s = s & "该计算机属于" & item.PrimaryOwnerName & vbCrLf
        s = s & "系统类型" & item.CreationClassName & vbCrLf
        s = s & "计算机类类型" & item.Description & vbCrLf

        For i = 0 To 1  ‘这里假设安装了两个系统 
            s = s & Chr(5) & "启动选项" & i & " :" & item.SystemStartupOptions(i) _ 
                & vbCrLf 
        Next i 
    Next

    Text1.Text = s 
End Sub

    运行程序,点击Command1,在textBox中就可以显示计算机的信息。

    在上面的代码中,程序通过GetObject("winmgmts:")获得WMI对象,然后获得下面的
Win32_ComputerSystem子项并通过访问Win32_ComputerSystem对象中的分项获得系统中的信息。
需要说明的是,并不是所有的系统都支持WMI,在有些系统中无法显示生产厂家等信息。

    现在的计算机以及网络组成十分复杂。例如系统硬件方面就有主板、硬盘、网卡... 。
软件方面有操作系统、系统中安装的软件、正在运行的进程等等。网络方面有域、工作组
等等。利用WMI可以访问上面的全部信息,但是如果向上面一样的利用分项来访问的话会很
麻烦。为此,WMI提供了一种类似SQL语句的查询语句,可以通过查询语句获得WMI对象下的子项。

    下面是一个遍历系统中安装的网卡并返回网卡MAC地址的代码:

Private Function MACAddress() As String

   Set objs = GetObject("winmgmts:").ExecQuery( _
      "SELECT MACAddress " & _
      "FROM Win32_NetworkAdapter " & _
      "WHERE " & _
      "((MACAddress Is Not NULL) " & _
      "AND (Manufacturer <> " & _
      "‘Microsoft‘))")

   For Each obj In objs
      MACAddress = obj.MACAddress
      Exit For
   Next obj
End Function

    上面的代码获得WMI对象,然后运行ExecQuery执行一个WMI查询语句获得安装的网卡并返回
网卡的MAC地址。

    WMI还支持事件处理,让程序可以处理系统事件,例如程序运行、关闭,可移动驱动器的插入、
取出等。下面是一个可以对系统中运行程序进行监控的程序。
    首先建立一个新工程,然后点击菜单的 project | references 项,在references列表中选中
Microsoft WMI Scripting Library将WMI对象库加入工程中。然后在Form1中加入一个ListBox控件,
然后在Form1中加入以下代码:


Option Explicit


Dim Locator As SWbemLocator
Dim Services As SWbemServices
Dim WithEvents StatusSink As SWbemSink

Private Sub KillEvents()
    StatusSink.Cancel
    Set StatusSink = Nothing
End Sub

Private Sub Form_Load()
    Dim Query As String

    Set StatusSink = New SWbemSink
    Set Locator = CreateObject("WbemScripting.SWbemLocator")
    Set Services = Locator.ConnectServer()

    Query = "SELECT * FROM __InstanceCreationEvent "
    Query = Query + "WITHIN 1 "
    Query = Query + "WHERE TargetInstance ISA ‘Win32_Process‘"

    Services.ExecNotificationQueryAsync StatusSink, Query
End Sub


Private Sub StatusSink_OnObjectReady(ByVal StatusEvent As SWbemObject, _
                                     ByVal EventContext As SWbemNamedValueSet)

    Dim arr
    Dim strQue As String
    Dim i As Integer

    List1.Clear
    arr = Split(StatusEvent.GetObjectText_, Chr(10))
    For i = LBound(arr) To UBound(arr)
        List1.AddItem arr(i)
    Next i
End Sub


Private Sub StatusSink_OnCompleted(ByVal HResult As WbemErrorEnum, _
                                   ByVal ErrorObject As SWbemObject, _
                                   ByVal EventContext As SWbemNamedValueSet)

    If HResult <> wbemErrCallCancelled Then
        ‘错误处理
    End If
End Sub



    在上面的程序中定义了一个SWbemSink对象StatusSink,然后建立一个SWbemServices对象Server,
并将StatusSink连接到Server对象上。这样就可以通过StatusSink监控程序的运行。
    运行程序,然后任意运行一个程序,在Form1的ListBox中就可以列出运行的程序的信息。

    WMI应用最强大的一面是可以通过WEB页面来实现远程管理。下面我们来建立一个HTML页面,该页面
可以实现向上面的VB程序一样动态监控系统中运行的程序。监控系统中程序运行的HTML代码如下:


<html>
<head>
<object ID="mysink" CLASSID=
"CLSID:75718C9A-F029-11d1-A1AC-00C04FB6C223"></object>
</head>
<SCRIPT>
function window.onload()
{
  var locator = new ActiveXObject ("WbemScripting.SWbemLocator");
  var service = locator.ConnectServer();
  szQuery = "SELECT * FROM __InstanceCreationEvent ";
  szQuery += "WITHIN 1 ";
  szQuery += "WHERE TargetInstance ISA ‘Win32_Process‘";
  service.ExecNotificationQueryAsync(mysink,szQuery);
}
</SCRIPT>
<script FOR="mysink" EVENT="OnObjectReady(obj, objAsyncContext)">
  document.all.info.innerHTML += obj.TargetInstance.Name + "<br>";
</script>
<body>
<span ID="info"></span>
</body>
</html>


    保存代码为Htm后缀的页面文件。双击打开网页,然后运行一个程序,在网页上就可以列出
运行的程序的文件名。

    以上简要的介绍了一下WMI的应用,实际上WMI对象的操作是十分复杂,功能也是很强大的,例如
你可以通过WMI在服务器上监控整个局域网上的计算机、向局域网上的计算机批量安装软件(例如杀
毒软件)。通过页面远程访问服务器,控件服务器运行程序,添加用户等。关于更多的WMI的应用,
读者可以访问MSDN上WMI开发的主页:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmistart_5kth.asp

获取更多信息。



    以上程序在Win2000专业版下编写。

 
Windows 8之父Steven Sinofsky:跨平台开发会为什么越来越难? 一些达成共识的JavaScript编码风格约定 语义技术——微软、谷歌和Facebook的必争之地 初创公司PlumGrid:前思科工程师的“逆袭之战” Firefox OS智能手机继续扩张 德国市场今日开售 如果让莎士比亚、海明威编写JavaScript代码 开源的数据可视化JavaScript图表库:ECharts 已迭代1.3亿年的分布式系统——Anternet 软硬整合:14个可改变世界的Kickstarter项目 是时候放弃MySQL的五大理由 比特币钱包Coinbase推出即时交易功能,无需银行转账手续 回收不活跃邮箱续:雅虎高管称能保证前用户信息和数据安全 移动周报:IT民工携娇妻转战传统行业,黄太吉的移动互联网营销 独立游戏开发的传奇!LIMBO开发商Playdead公司CEO专访 Firefox OS模拟器4.0正式发布 支持模拟触摸事件 莫轻言已成功部署大数据,也许你离达标还相去甚远! 基于Java的四大开源测试工具 Firefox OS:称霸移动市场?我们的计划更长远! 支撑5亿用户、1.5亿活跃用户的Twitter最新架构详解及相关实现 传苹果为iWatch招兵买马 以确保明年发布新产品 降价高达1200元的Surface RT,并不值得你购买 Daux.io:开源的项目文档生成器 避免代码注释的五大理由 安徽农信:30人,13轮测试,完成日均270万笔交易的综合业务系统架构调整 研究员带来5D光存储技术:容量达360TB,寿命高于百万年 LSI闪存加速或助力互联网IDC自我设计与建设 怎样让用户从100涨到200万?硅谷创业教父如是说 大作修炼之道:就算是手游,也要搞点剧情吧! Java EE 8愿望清单:缺少这些,Java EE将不会完美 Surface Watch?传微软正测试搭载Win 8的智能手表 又一美国造?联想在美设厂制造产品 win2000下如何给程序指定program ID 急,急,在VC中如何.sql文件(ORACLE) 我的DW不能启动了,问题解决马上给分100! 高手请进,在线等待! 下了一个手机游戏(JAR、JAD),想在计算机上模拟运行一下,该怎么做? 使用 应用程序组装工具 创建.ear,创建.war 在WAS中安装出现错误 !!! 立即给分 怎样改变由 javaw 打开的*.jar文件的图标? 纯粹好奇~水园、昨天晚上发生了什么? 为什么修改httpd.conf后,APACHE服务不能启动? 想买两本书,请看过该书的朋友评价一下,特别是书里的代码是C#的还是VB.NET的? win2000注册表问题 什么时候需要定义过程??? 兄弟们,替我出口气 800*600分辨率下,toolbar显示不完整,请问该如何解决?(100分) 我想在数据窗口中显示年龄信息,但是出错了!! 各位大侠,兄弟很急得问题,80分奉送 [ 新手 ] 请问几个关于时间的SQL语句 用ROUND函数,需要包含哪个头文件? 高手请进,在线等待!!! 怎么样用HTML代码实现在一个.htm文件中加载另一个.htm文件 ??? 哪位大哥有能解析ANS.1语言的东西? 比较大小的简单问题? 用Ras拨号过程中,如何取消拨号? 大家看看合适否? 怎样以逗号为标记分段读取内容? 求救:本地计算机无法启动 oracleserviceoradb 服务! java和.net你们好吗?保重VC。 如何把XML文件导到oracle数据库中? 变量初值问题,高手请进 求通过手机号码判断出手机入网地址(如上海,江苏等)的java接口 如何把htm文件移植到VB.NET中. 妈的找了几天广告交换的网站,怎么全是色情的,正常的网站就没有吗?你们的网站放不放这些东西 。 键盘错乱 高人指点 从.net想到php(欢迎大家讨论) WebService 连接问题????????????????????????????? 如何判断用户是否安装pdf格式阅读器 有什么好办法破解论坛的密码? 一个高难度的问题。100分求教!!! 构建EXCEL后,写入数据为何报错,请邦我看看 DELPHI与ORACLE9I中的BLOB字段存取的问题 怎么关闭窗口? 关于读取图片的问题! 打印口的传输时序是如何定义的 我要在数据窗口中实现出货日期在20天之内的记录的字体颜色为红色,font.color的expression该怎么写?在线等待!!! 请问怎么安装statspack? 如何从整形数字字符串得到相应的整形数字? 关于SQL语句的问题,请各位高手指点,在线等待,对了即给分! 请教关于浮点数的问题 哪里有IDL的资源?提供重要消息者高分相送! WebService 连接问题????????????????????????????? 用jsp怎么实现文件目录的上传? 一起来看流星雨好看还是一起又看流星雨好看 高数等式问题 一道高数题,这个等式为什么是错的 眉飞色舞 神采奕奕 人山人海 鹤发童颜 哪个不属于一类 请问 statutory disclosue lim(x+e^x)^1/x在x趋向于0时的值等多少啊?希望能给出详细的解法好像答案是e^2呀 lim{1+x/1-x}^(1/x)要解法 X→0 高数计算,这两个等式是怎么转化过来的 求极限,下图等式成立的理由 自然规律先于人类意识存在吗诸如光合作用万有引力之类的科学规律 唐家璇:中日关系深层次原因在于彼此认赵启正:中日关系令人担忧 面临政冷经中国古代绘画展在伦敦举行各部门各地迅速行动 浙江多管齐下帮扶外侨办牵线搭桥舟山与香港小学开展校交浙江为宗馥莉等73名浙商冠冕 宗庆后第十四个全国“男性健康日”浙江多名医国航增加三条国际航线伊朗边境发生武装冲突 14名边防人员哥伦比亚妇女售卖12个女儿“初夜权”漏洞百出的“全球奴役指数”民间收藏的法律尴尬两市大盘上下两难北京家居网掌上社区正式上线女主编没事 男主编有罪双榆树中心小学 “北京云南手拉手”第二胜 还是“娜”么脆苏牙下嘴有定律展会看板我们距离世界有多远为何微博容得下 微信容不下雷雨收敛 炎热重袭行夜人金仙闯官场超级搜索引擎大道长生重生平淡人生臂力无限不会仙术的上古金仙足球神话不死冥神兼职丹医魔机汤口旅游义县旅游昌化旅游砚山旅游孔城旅游东浦旅游大武口旅游板梁旅游富锦旅游乐安旅游泗水旅游
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘