modethernetaddress.bas

Ping,扫描,Whois IP

Attribute VB_Name = "modEthernetAddress"
Option Explicit

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 Const EM_SETPASSWORDCHAR = &HCC

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
    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 Type OPENFILENAME
    lStructSize         As Long
    hwndOwner           As Long
    hInstance           As Long
    lpstrFilter         As String
    lpstrCustomFilter   As String
    nMaxCustFilter      As Long
    nFilterIndex        As Long
    lpstrFile           As String
    nMaxFile            As Long
    lpstrFileTitle      As String
    nMaxFileTitle       As Long
    lpstrInitialDir     As String
    lpstrTitle          As String
    Flags               As Long
    nFileOffset         As Integer
    nFileExtension      As Integer
    lpstrDefExt         As String
    lCustData           As Long
    lpfnHook            As Long
    lpTemplateName      As String
End Type

Private Type POINTAPI
    X As Long
    Y As Long
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 Declare Function GetTickCount Lib "kernel32" () As Long

Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
        
Private Declare Function GetCursorPos Lib "user32" _
        (lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "user32" _
        (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias _
        "GetClassNameA" (ByVal hwnd As Long, ByVal _
        lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias _
        "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
        ByVal wParam As Long, lParam As Any) As Long

Dim process         As Boolean

Public 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