netapi.bas

此文档为VB公共模块

Attribute VB_Name = "NetApi"
Option Explicit
'*************************关于网络***************************
'*作者：谢建军                                              *
'*创建日期：2002年11月18日  20：47                          *
'************************************************************
'*  1.GetCptName                                            *
'*  2.GetNIC                                                *
'*  3.MapDrive(ByVal DrvName As String,                     *
'*             ByVal NetPath As String)                     *
'*  4.DisMapDrive(ByVal DrvName As String)                  *
'*  5.GetCptIP                                              *
'************************************************************
'注意：需要用到RegAPI模块====================================
'通知系统IP地址已经更改,应用于在不重新启动系统的情况下修改IP信息
Declare Function DhcpNotifyConfigChange Lib "dhcpcsvc.dll" ( _
    ByVal ServerName As String, _
    ByVal AdapterName As Long, _
    ByVal bNewIPAddress As Long, _
    ByVal dwIPIndex As Long, _
    ByVal dwIPAddress As Long, _
    ByVal dwSubNetMask As Long, _
    ByVal nDHCPAction As Long) As Long
'Get local computer's name
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Set the computer's name
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long
'Get NIC
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 'Integer
    ncb_retcode As Byte 'Integer
    ncb_lsn As Byte 'Integer
    ncb_num As Byte ' Integer
    ncb_buffer As Long 'String
    ncb_length As Integer
    ncb_callname As String * NCBNAMSZ
    ncb_name As String * NCBNAMSZ
    ncb_rto As Byte 'Integer
    ncb_sto As Byte ' Integer
    ncb_post As Long
    ncb_lana_num As Byte 'Integer
    ncb_cmd_cplt As Byte 'Integer
    ncb_reserve(9) As Byte 'Reserved, must be 0
    ncb_event As Long
End Type
Private Type ADAPTER_STATUS
    adapter_address(5) As Byte 'As String * 6
    rev_major As Byte 'Integer
    reserved0 As Byte 'Integer
    adapter_type As Byte 'Integer
    rev_minor As Byte 'Integer
    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
'*********MapDrive
Private Type NETRESOURCE1
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String
    lpRemoteName As String
    lpComment As String
    lpProvider As String
End Type
Private Const NO_ERROR = 0
Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Const RESOURCE_REMEMBERED = &H3
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Private Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Private Const RESOURCEDISPLAYTYPE_SERVER = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3
Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Const RESOURCEUSAGE_CONTAINER = &H2
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias _
"WNetAddConnection2A" _
(lpNetResource As NETRESOURCE1, _
ByVal lpPassword As String, _
ByVal lpUserName As String, _
ByVal dwFlags As Long) As Long
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias _
"WNetCancelConnection2A" _
(ByVal lpName As String, _
ByVal dwFlags As Long, _
ByVal fForce As Long) As Long
'GetIP
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 gethostbyname Lib "WSOCK32.DLL" (ByVal hostname$) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (hpvDest As Any, ByVal hpvSource&, ByVal cbCopy&)

Public Enum NetInfoTypeX
    IP = 0
    NetGateway = 1
    SubNetMask = 2
    DHCPServer = 3
    NameServer = 4
    EnDhcp = 5
    Name = 6
    WorkGroup = 7
End Enum

'************
'得到本机的主机名
'************
Public Function GetCptName() As String
  Dim T_Str As String * 255
  Dim T_Len As Integer
  T_Str = Space(255)
  T_Len = GetComputerName(T_Str, Len(T_Str) - 1)
  GetCptName = Left(T_Str, InStr(T_Str, Chr(0)) - 1)
End Function
'*****************
'返回网卡的序列号
'*****************
Public Function GetNICNumber() As String
    
    Dim myNcb As NCB
    Dim bRet As Byte
    Dim T_NICNumber As String: T_NICNumber = ""
    myNcb.ncb_command = NCBRESET
    bRet = Netbios(myNcb)
    myNcb.ncb_command = NCBASTAT
    myNcb.ncb_lana_num = 0
    myNcb.ncb_callname = "*　　　　　　 "
    Dim myASTAT As ASTAT, tempASTAT As ASTAT
    Dim pASTAT As Long
    myNcb.ncb_length = Len(myASTAT)
    Debug.Print Err.LastDllError
    pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS _
        Or HEAP_ZERO_MEMORY, myNcb.ncb_length)
    If pASTAT = 0 Then
        Debug.Print "memory allcoation failed!"
    Exit Function
    End If
    myNcb.ncb_buffer = pASTAT
    bRet = Netbios(myNcb)
    Debug.Print Err.LastDllError
    CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
    T_NICNumber = T_NICNumber + IIf(Len(Trim$(Hex(myASTAT.adapt.adapter_address(0)))) < 2, "0" + Trim$(Hex(myASTAT.adapt.adapter_address(0))), Trim$(Hex(myASTAT.adapt.adapter_address(0))))
    T_NICNumber = T_NICNumber + IIf(Len(Trim$(Hex(myASTAT.adapt.adapter_address(1)))) < 2, "0" + Trim$(Hex(myASTAT.adapt.adapter_address(1))), Trim$(Hex(myASTAT.adapt.adapter_address(1))))
    T_NICNumber = T_NICNumber + IIf(Len(Trim$(Hex(myASTAT.adapt.adapter_address(2)))) < 2, "0" + Trim$(Hex(myASTAT.adapt.adapter_address(2))), Trim$(Hex(myASTAT.adapt.adapter_address(2))))
    T_NICNumber = T_NICNumber + IIf(Len(Trim$(Hex(myASTAT.adapt.adapter_address(3)))) < 2, "0" + Trim$(Hex(myASTAT.adapt.adapter_address(3))), Trim$(Hex(myASTAT.adapt.adapter_address(3))))
    T_NICNumber = T_NICNumber + IIf(Len(Trim$(Hex(myASTAT.adapt.adapter_address(4)))) < 2, "0" + Trim$(Hex(myASTAT.adapt.adapter_address(4))), Trim$(Hex(myASTAT.adapt.adapter_address(4))))
    T_NICNumber = T_NICNumber + IIf(Len(Trim$(Hex(myASTAT.adapt.adapter_address(5)))) < 2, "0" + Trim$(Hex(myASTAT.adapt.adapter_address(5))), Trim$(Hex(myASTAT.adapt.adapter_address(5))))
    HeapFree GetProcessHeap(), 0, pASTAT
    GetNICNumber = T_NICNumber
End Function
'******************
'映射网络驱动器
'******************
Public Function MapDrive(ByVal DrvName As String, ByVal NetPath As String) As Boolean
    
    Dim NetR As NETRESOURCE1
    Dim ErrInfo As Long
    
    NetR.dwScope = RESOURCE_GLOBALNET
    NetR.dwType = RESOURCETYPE_DISK
    NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
    NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
    NetR.lpLocalName = Left(Trim$(DrvName), 1) + ":"
    NetR.lpRemoteName = NetPath