form1.frm

远志网络还原大师算号器的源码

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "远志网络还原大师算号器"
   ClientHeight    =   1875
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5625
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1875
   ScaleWidth      =   5625
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command3 
      Caption         =   "获取MAC"
      Height          =   255
      Left            =   4560
      TabIndex        =   13
      Top             =   360
      Width           =   855
   End
   Begin VB.Frame Frame2 
      Caption         =   "计算结果"
      Height          =   615
      Left            =   120
      TabIndex        =   10
      Top             =   1200
      Width           =   5415
      Begin VB.TextBox Text8 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   120
         Locked          =   -1  'True
         MaxLength       =   20
         TabIndex        =   14
         Top             =   240
         Width           =   5175
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "网卡MAC定义（请输入16进制01-FF）"
      Height          =   975
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5415
      Begin VB.CommandButton Command2 
         Caption         =   "退出"
         Height          =   255
         Left            =   4440
         TabIndex        =   12
         Top             =   600
         Width           =   855
      End
      Begin VB.CommandButton Command1 
         Caption         =   "生成"
         Height          =   255
         Left            =   3480
         TabIndex        =   11
         Top             =   600
         Width           =   855
      End
      Begin VB.TextBox Text7 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   840
         MaxLength       =   2
         TabIndex        =   9
         Top             =   600
         Width           =   615
      End
      Begin VB.TextBox Text5 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   3000
         MaxLength       =   2
         TabIndex        =   7
         Top             =   240
         Width           =   615
      End
      Begin VB.TextBox Text4 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   2280
         MaxLength       =   2
         TabIndex        =   6
         Top             =   240
         Width           =   615
      End
      Begin VB.TextBox Text6 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   3720
         MaxLength       =   2
         TabIndex        =   4
         Top             =   240
         Width           =   615
      End
      Begin VB.TextBox Text3 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   1560
         MaxLength       =   2
         TabIndex        =   3
         Top             =   240
         Width           =   615
      End
      Begin VB.TextBox Text2 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   840
         MaxLength       =   2
         TabIndex        =   2
         Top             =   240
         Width           =   615
      End
      Begin VB.TextBox Text1 
         Alignment       =   2  'Center
         Height          =   270
         Left            =   120
         MaxLength       =   2
         TabIndex        =   1
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label2 
         Caption         =   "请输入16进制01—FF"
         Height          =   255
         Left            =   1560
         TabIndex        =   8
         Top             =   645
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "校验码"
         Height          =   255
         Left            =   120
         TabIndex        =   5
         Top             =   650
         Width           =   615
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 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


Private Sub Command1_Click()
Dim a1, a2, a3, a4, a5, a6, a7, x1, x2, x3, x4, x5, x6, x7, xx
a1 = Casb(Text1.Text)
If a1 = "错误" Then xx = "网卡MAC编号1错误，请输入数字或字母！": GoTo ovst
a2 = Casb(Text2.Text)
If a2 = "错误" Then xx = "网卡MAC编号2错误，请输入数字或字母！": GoTo ovst
a3 = Casb(Text3.Text)
If a3 = "错误" Then xx = "网卡MAC编号3错误，请输入数字或字母！": GoTo ovst
a4 = Casb(Text4.Text)
If a4 = "错误" Then xx = "网卡MAC编号4错误，请输入数字或字母！": GoTo ovst
a5 = Casb(Text5.Text)
If a5 = "错误" Then xx = "网卡MAC编号5错误，请输入数字或字母！": GoTo ovst
a6 = Casb(Text6.Text)
If a6 = "错误" Then xx = "网卡MAC编号6错误，请输入数字或字母！": GoTo ovst
a7 = Casb(Text7.Text)
If a7 = "错误" Then xx = "校验码错误，请输入数字或字母！": GoTo ovst
If Len(Text1.Text) = 1 Then xx = "网卡MAC编号1单位数错误，请输入2位数MAC地址！": GoTo ovst
If Len(Text2.Text) = 1 Then xx = "网卡MAC编号2单位数错误，请输入2位数MAC地址！": GoTo ovst
If Len(Text3.Text) = 1 Then xx = "网卡MAC编号3单位数错误，请输入2位数MAC地址！": GoTo ovst
If Len(Text4.Text) = 1 Then xx = "网卡MAC编号4单位数错误，请输入2位数MAC地址！": GoTo ovst
If Len(Text5.Text) = 1 Then xx = "网卡MAC编号5单位数错误，请输入2位数MAC地址！": GoTo ovst
If Len(Text6.Text) = 1 Then xx = "网卡MAC编号6单位数错误，请输入2位数MAC地址！": GoTo ovst
If Len(Text7.Text) = 1 Then xx = "校验码单位数错误，请输入2位数校验码！": GoTo ovst

x1 = Hex(a1 Xor a7)
x2 = Hex(a2 Xor a7)
x3 = Hex(a3 Xor a7)
x4 = Hex(a4 Xor a7)
x5 = Hex(a5 Xor a7)
x6 = Hex(a6 Xor a7)
x7 = Hex(a7)
If Len(x1) = 1 Then x1 = "0" & x1
If Len(x2) = 1 Then x2 = "0" & x2
If Len(x3) = 1 Then x3 = "0" & x3
If Len(x4) = 1 Then x4 = "0" & x4
If Len(x5) = 1 Then x5 = "0" & x5
If Len(x6) = 1 Then x6 = "0" & x6
If Len(x7) = 1 Then x7 = "0" & x7
xx = x1 & " " & x2 & " " & x3 & " " & x4 & " " & x5 & " " & x6 & " " & x7
ovst:
Text8.Text = xx

End Sub

Function Casb(ca As String) As String
Dim t1, t2, tt
On Error GoTo ecasb
t1 = UCase(Left(ca, 1))
t2 = UCase(Right(ca, 1))
If t1 = "0" Then tt = 0 * 16
If t1 = "1" Then tt = 1 * 16
If t1 = "2" Then tt = 2 * 16
If t1 = "3" Then tt = 3 * 16
If t1 = "4" Then tt = 4 * 16
If t1 = "5" Then tt = 5 * 16
If t1 = "6" Then tt = 6 * 16
If t1 = "7" Then tt = 7 * 16
If t1 = "8" Then tt = 8 * 16
If t1 = "9" Then tt = 9 * 16
If t1 = "A" Then tt = 10 * 16
If t1 = "B" Then tt = 11 * 16
If t1 = "C" Then tt = 12 * 16
If t1 = "D" Then tt = 13 * 16
If t1 = "E" Then tt = 14 * 16
If t1 = "F" Then tt = 15 * 16
If tt = "" Then GoTo ecasb
If t2 = "0" Then tt = tt + 0: GoTo ost
If t2 = "1" Then tt = tt + 1: GoTo ost
If t2 = "2" Then tt = tt + 2: GoTo ost
If t2 = "3" Then tt = tt + 3: GoTo ost
If t2 = "4" Then tt = tt + 4: GoTo ost
If t2 = "5" Then tt = tt + 5: GoTo ost
If t2 = "6" Then tt = tt + 6: GoTo ost
If t2 = "7" Then tt = tt + 7: GoTo ost
If t2 = "8" Then tt = tt + 8: GoTo ost
If t2 = "9" Then tt = tt + 9: GoTo ost
If t2 = "A" Then tt = tt + 10: GoTo ost
If t2 = "B" Then tt = tt + 11: GoTo ost
If t2 = "C" Then tt = tt + 12: GoTo ost
If t2 = "D" Then tt = tt + 13: GoTo ost
If t2 = "E" Then tt = tt + 14: GoTo ost
If t2 = "F" Then tt = tt + 15: GoTo ost
GoTo ecasb
ost:
Casb = tt
GoTo ov
ecasb:
Casb = "错误"
ov:
End Function

Private Sub Command2_Click()
End
End Sub

Private Sub Text1_Change()
If Len(Text1.Text) = 2 Then Text2.SetFocus
End Sub

Private Sub Text2_Change()
If Len(Text2.Text) = 2 Then Text3.SetFocus
End Sub
Private Sub Text3_Change()
If Len(Text3.Text) = 2 Then Text4.SetFocus
End Sub
Private Sub Text4_Change()
If Len(Text4.Text) = 2 Then Text5.SetFocus
End Sub
Private Sub Text5_Change()
If Len(Text5.Text) = 2 Then Text6.SetFocus
End Sub
Private Sub Text6_Change()
If Len(Text6.Text) = 2 Then Text7.SetFocus
End Sub
     
    Private Sub Command3_Click()
        Dim myNcb As NCB
        Dim bRet As Byte
        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 Sub
        End If
        myNcb.ncb_buffer = pASTAT
        bRet = Netbios(myNcb)
        Debug.Print Err.LastDllError
        CopyMemory myASTAT, myNcb.ncb_buffer, Len(myASTAT)
        If Len(Hex(myASTAT.adapt.adapter_address(0))) = 1 Then
        Text1.Text = "0" & Hex(myASTAT.adapt.adapter_address(0))
        Else
        Text1.Text = Hex(myASTAT.adapt.adapter_address(0))
        End If
        If Len(Hex(myASTAT.adapt.adapter_address(1))) = 1 Then
        Text2.Text = "0" & Hex(myASTAT.adapt.adapter_address(1))
        Else
        Text2.Text = Hex(myASTAT.adapt.adapter_address(1))
        End If
        If Len(Hex(myASTAT.adapt.adapter_address(2))) = 1 Then
        Text3.Text = "0" & Hex(myASTAT.adapt.adapter_address(2))
        Else
        Text3.Text = Hex(myASTAT.adapt.adapter_address(2))
        End If
        If Len(Hex(myASTAT.adapt.adapter_address(3))) = 1 Then
        Text4.Text = "0" & Hex(myASTAT.adapt.adapter_address(3))
        Else
        Text4.Text = Hex(myASTAT.adapt.adapter_address(3))
        End If
        If Len(Hex(myASTAT.adapt.adapter_address(4))) = 1 Then
        Text5.Text = "0" & Hex(myASTAT.adapt.adapter_address(4))
        Else
        Text5.Text = Hex(myASTAT.adapt.adapter_address(4))
        End If
        If Len(Hex(myASTAT.adapt.adapter_address(5))) = 1 Then
        Text6.Text = "0" & Hex(myASTAT.adapt.adapter_address(5))
        Else
        Text6.Text = Hex(myASTAT.adapt.adapter_address(5))
        End If
        HeapFree GetProcessHeap(), 0, pASTAT
    End Sub