TCP/IP协议栈

开发平台：
Visual Basic

frmMain.frm：源码内容
							VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmMain 
   Caption         =   "IpModen"
   ClientHeight    =   6450
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   10935
   LinkTopic       =   "Form1"
   ScaleHeight     =   6450
   ScaleWidth      =   10935
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "CRC"
      Height          =   375
      Left            =   8100
      TabIndex        =   4
      Top             =   -45
      Width           =   915
   End
   Begin VB.CommandButton Command1 
      Caption         =   "send"
      Height          =   375
      Left            =   7065
      TabIndex        =   3
      Top             =   -45
      Width           =   915
   End
   Begin VB.TextBox Text1 
      Height          =   330
      Left            =   90
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   0
      Width           =   6855
   End
   Begin RichTextLib.RichTextBox RTB1 
      CausesValidation=   0   'False
      Height          =   1695
      Left            =   45
      TabIndex        =   1
      Top             =   360
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   2990
      _Version        =   393217
      BackColor       =   -2147483633
      Enabled         =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"frmMain.frx":0000
   End
   Begin VB.Timer t1 
      Enabled         =   0   'False
      Interval        =   200
      Left            =   3480
      Top             =   360
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   9630
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin MSComctlLib.StatusBar sbStatusBar 
      Align           =   2  'Align Bottom
      Height          =   390
      Left            =   0
      TabIndex        =   0
      Top             =   6060
      Width           =   10935
      _ExtentX        =   19288
      _ExtentY        =   688
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   4
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   6685
            MinWidth        =   2293
            Text            =   "状态"
            TextSave        =   "状态"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   6932
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            AutoSize        =   2
            TextSave        =   "2005-12-12"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            AutoSize        =   2
            TextSave        =   "11:51"
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog dlgCommonDialog 
      Left            =   9000
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu comEdit 
      Caption         =   "端口属性"
      Begin VB.Menu opencom 
         Caption         =   "打开"
      End
      Begin VB.Menu closecom 
         Caption         =   "关闭"
      End
      Begin VB.Menu vvv 
         Caption         =   "-"
      End
      Begin VB.Menu procom 
         Caption         =   "属性"
      End
   End
   Begin VB.Menu cmnet 
      Caption         =   "网络设置"
      Begin VB.Menu connet 
         Caption         =   "开始连接"
      End
      Begin VB.Menu closecmnet 
         Caption         =   "断开连接"
      End
   End
   Begin VB.Menu set 
      Caption         =   "参数设置"
      Begin VB.Menu ipset 
         Caption         =   "IP设置"
      End
   End
   Begin VB.Menu sendcode 
      Caption         =   "发送命令"
      Begin VB.Menu GeneralPhoneInformation 
         Caption         =   "General/Phone Information"
         Begin VB.Menu IFLGetPhoneInfo 
            Caption         =   "IFLGetPhoneInfo"
         End
         Begin VB.Menu IFLGetPhoneSoftVersions 
            Caption         =   "IFLGetPhoneSoftVersions"
         End
         Begin VB.Menu IFLGetBatteryLevel 
            Caption         =   "IFLGetBatteryLevel"
         End
         Begin VB.Menu IFLGetSignalStrength 
            Caption         =   "IFLGetSignalStrength"
         End
         Begin VB.Menu IFLGetOwnPhoneNumber 
            Caption         =   "IFLGetOwnPhoneNumber"
         End
         Begin VB.Menu IFLGetOwnPrivateID 
            Caption         =   "IFLGetOwnPrivateID"
         End
         Begin VB.Menu IFLFeatureSupport 
            Caption         =   "IFLFeatureSupport"
         End
      End
      Begin VB.Menu SMSManagement 
         Caption         =   "SMS Management"
         Begin VB.Menu IFLGetMailCount 
            Caption         =   "IFLGetMailCount"
         End
         Begin VB.Menu IFLRetrieveSMSMessage 
            Caption         =   "IFLRetrieveSMSMessage"
         End
         Begin VB.Menu IFLDeleteSMSMessage 
            Caption         =   "IFLDeleteSMSMessage"
         End
         Begin VB.Menu IFLMarkSMSMessageAsRead 
            Caption         =   "IFLMarkSMSMessageAsRead"
         End
      End
      Begin VB.Menu InternalDataManagement 
         Caption         =   "Internal Data Management"
         Begin VB.Menu IFLGetCallListSize 
            Caption         =   "IFLGetCallListSize"
         End
         Begin VB.Menu IFLGetNumCallListEntries 
            Caption         =   "IFLGetNumCallListEntries"
         End
         Begin VB.Menu IFLReadCallListEntry 
            Caption         =   "IFLReadCallListEntry"
         End
         Begin VB.Menu IFLWriteCallListEntry 
            Caption         =   "IFLWriteCallListEntry"
         End
         Begin VB.Menu IFLDeleteCallListEntry 
            Caption         =   "IFLDeleteCallListEntry"
         End
         Begin VB.Menu IFLReadUserFields 
            Caption         =   "IFLReadUserFields"
         End
         Begin VB.Menu IFLSetUserFields 
            Caption         =   "IFLSetUserFields"
         End
         Begin VB.Menu IFLResetRadio 
            Caption         =   "IFLResetRadio"
         End
         Begin VB.Menu IFLGetCallListSizeEx 
            Caption         =   "IFLGetCallListSizeEx"
         End
         Begin VB.Menu IFLReadCallListEntryEx 
            Caption         =   "IFLReadCallListEntryEx"
         End
         Begin VB.Menu IFLWriteCallListEntryEx 
            Caption         =   "IFLWriteCallListEntryEx"
         End
      End
      Begin VB.Menu VoiceCallControl 
         Caption         =   "Voice Call Control"
         Begin VB.Menu IFLSendAlert 
            Caption         =   "IFLSendAlert"
         End
         Begin VB.Menu IFLStartPhoneCall 
            Caption         =   "IFLStartPhoneCall"
         End
         Begin VB.Menu IFLAnswerPhoneCall 
            Caption         =   "IFLAnswerPhoneCall"
         End
         Begin VB.Menu IFLEndPhoneCall 
            Caption         =   "IFLEndPhoneCall"
         End
         Begin VB.Menu IFLGetCallLength 
            Caption         =   "IFLGetCallLength"
         End
         Begin VB.Menu IFLStartPrivateCall 
            Caption         =   "IFLStartPrivateCall"
         End
         Begin VB.Menu IFLStartGroupCall 
            Caption         =   "IFLStartGroupCall"
         End
         Begin VB.Menu IFLPressPttKey 
            Caption         =   "IFLPressPttKey"
         End
         Begin VB.Menu IFLReleasePttKey 
            Caption         =   "IFLReleasePttKey"
         End
         Begin VB.Menu IFLSendDTMFTone 
            Caption         =   "IFLSendDTMFTone"
         End
         Begin VB.Menu IFLEnableSpeakerPhone 
            Caption         =   "IFLEnableSpeakerPhone"
         End
      End
   End
   Begin VB.Menu clean 
      Caption         =   "清除文本"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rxdarr() As Byte
Dim str1$, str2$, str3$, str4$, str5$, str6$, str7$, str8$
Dim ATHBIT As Boolean, GBt1 As Boolean, CLOSEBIT As Boolean
Private Sub clean_Click()
  RTB1.Text = ""
End Sub
Private Sub closecmnet_Click()
    Dim Mstr As String
    CLOSEBIT = True
    RESSEND = 0
'    Mstr = "7E FF 7D 23 C0 21 7D 25 7D 24 7D 20 7D 30 6C A3 5D D1 7D 20 3C CD 74 7D 20 7D 20 7D 20 7D 20 E7 71 7E"
'    Mstr = sendbyte(Mstr)
'    RTB1.SelColor = vbBlue
'    RTB1.SelText = Mstr & vbCrLf & vbCrLf
'    RTB1.SelLength = Len(RTB1.Text)
    'ATHBIT = True
    sendcom ("7E FF 7D 23 C0 21 7D 25 7D 22 7D 20 7D 24 59 28 7E")
    RTB1.SelColor = vbBlue
    RTB1.SelText = "7E FF 7D 23 C0 21 7D 25 7D 22 7D 20 7D 24 59 28 7E" & vbCrLf & vbCrLf
    RTB1.SelLength = Len(RTB1.Text)
End Sub
Private Sub closecom_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
    sbStatusBar.Panels(1).Text = "COM" & mycom.comm & " close"
End Sub
Private Sub Command1_Click()
Call sendcom(Text1)
End Sub
Private Sub Command2_Click()
'7E FF 7D 23 C0 21 7D 22 7D 24 7D 20 7D 34 7D 22 7D 26 7D 20 7D 20 7D 20 7D 20 7D 23 7D 24 C0 23 7D 25 7D 26 56 C7 D7 7D A7 75 07 47 7E
   gg = strtovar(Text1)
   SR = del7d(gg)
   RTB1.SelColor = vbBlue
   RTB1.SelText = SR & vbCrLf & vbCrLf
   RTB1.SelLength = Len(RTB1.Text)
End Sub
Private Sub connet_Click()
    Dim Buffer(54) As Byte
    MSComm1.RThreshold = 0
    MSComm1.InputLen = 0
    MSComm1.Handshaking = 2
    MSComm1.InputMode = comInputModeText
'    Buffer = ""
'    MSComm1.Output = "ATE0" & Chr$(13) ' 确保
'    Do
'      DoEvents
'      If MSComm1.PortOpen = False Then GoTo yyy:
'      Buffer$ = Buffer$ & MSComm1.Input
'    Loop Until InStr(Buffer$, "OK" & vbCrLf)
'   RTB1.SelColor = vbBlue
'   RTB1.SelText = Buffer$ & vbCrLf
'   RTB1.SelLength = Len(RTB1.Text)
'  Buffer = ""
'  MSComm1.Output = "ATZ2" & Chr$(13) ' 确保
'
'   Do
'      DoEvents
'      If MSComm1.PortOpen = False Then GoTo yyy:
'   Buffer$ = Buffer$ & MSComm1.Input
'   Loop Until InStr(Buffer$, "OK" & vbCrLf)
'   RTB1.SelColor = vbBlue
'   RTB1.SelText = Buffer$ & vbCrLf
'   RTB1.SelLength = Len(RTB1.Text)
'   Buffer = ""
'   MSComm1.Output = "ATS0 = 0" & Chr$(13) ' 确保
'
'   Do
'      DoEvents
'      If MSComm1.PortOpen = False Then GoTo yyy:
'   Buffer$ = Buffer$ & MSComm1.Input
'   Loop Until InStr(Buffer$, "OK" & vbCrLf)
'   RTB1.SelColor = vbBlue
'   RTB1.SelText = Buffer$ & vbCrLf
'   RTB1.SelLength = Len(RTB1.Text)
'   Buffer = ""
'      MSComm1.Output = "AT&F&D2&C1X4S0=0S7=120Q0E1V1" & Chr$(13) ' 确保
'
'   Do
'      DoEvents
'      If MSComm1.PortOpen = False Then GoTo yyy:
'   Buffer$ = Buffer$ & MSComm1.Input
'   Loop Until InStr(Buffer$, "OK" & vbCrLf)
'   RTB1.SelColor = vbBlue
'   RTB1.SelText = Buffer$ & vbCrLf
'   RTB1.SelLength = Len(RTB1.Text)
'   Buffer = ""
'      MSComm1.Output = "ATS7=60&k3" & Chr$(13) ' 确保
'
'   Do
'      DoEvents
'      If MSComm1.PortOpen = False Then GoTo yyy:
'   Buffer$ = Buffer$ & MSComm1.Input
'   Loop Until InStr(Buffer$, "OK" & vbCrLf)
'   RTB1.SelColor = vbBlue
'   RTB1.SelText = Buffer$ & vbCrLf
'   RTB1.SelLength = Len(RTB1.Text)
'   Buffer = ""
'   MSComm1.Output = "ATZ2" & Chr$(13) ' 确保
'
'   Do
'      DoEvents
'      If MSComm1.PortOpen = False Then GoTo yyy:
'   Buffer$ = Buffer$ & MSComm1.Input
'   Loop Until InStr(Buffer$, "OK" & vbCrLf)
'   RTB1.SelColor = vbBlue
'   RTB1.SelText = Buffer$ & vbCrLf
'   RTB1.SelLength = Len(RTB1.Text)
'   Buffer = ""
'
   Dim ss
   ss = ""
   MSComm1.Output = "ATDT#777" & Chr$(13) ' 确保
   Do
      DoEvents
      If MSComm1.PortOpen = False Then GoTo yyy:
   ss = ss & MSComm1.Input
   Loop Until InStr(ss, "CONNECT" & vbCrLf)
   RTB1.SelColor = vbBlue
   RTB1.SelText = ss & vbCrLf
   RTB1.SelLength = Len(RTB1.Text)
 '  Buffer = ""
   Buffer(0) = &H7E
   Buffer(1) = &HFF
   Buffer(2) = &H7D
   Buffer(3) = &H23
   Buffer(4) = &HC0
   Buffer(5) = &H21
   Buffer(6) = &H7D
   Buffer(7) = &H21
   Buffer(8) = &H7D
   Buffer(9) = &H21
   Buffer(10) = &H7D
   Buffer(11) = &H20
   Buffer(12) = &H7D
   Buffer(13) = &H37
   Buffer(14) = &H7D
   Buffer(15) = &H22
   Buffer(16) = &H7D
   Buffer(17) = &H26
   Buffer(18) = &H7D
   Buffer(19) = &H20
   Buffer(20) = &H7D
   Buffer(21) = &H2A
   Buffer(22) = &H7D
   Buffer(23) = &H20
   Buffer(24) = &H7D
   Buffer(25) = &H20
   Buffer(26) = &H7D
   Buffer(27) = &H25
   Buffer(28) = &H7D
   Buffer(29) = &H26
   Buffer(30) = &H7D
   Buffer(31) = &H20
   Buffer(32) = &H4E
   Buffer(33) = &H9B
   Buffer(34) = &H7D
   Buffer(35) = &H31
   Buffer(36) = &H7D
   Buffer(37) = &H27
   Buffer(38) = &H7D
   Buffer(39) = &H22
   Buffer(40) = &H7D
   Buffer(41) = &H28
   Buffer(42) = &H7D
   Buffer(43) = &H22
   Buffer(44) = &H7D
   Buffer(45) = &H2D
   Buffer(46) = &H7D
   Buffer(47) = &H23
   Buffer(48) = &H7D
   Buffer(49) = &H26
   Buffer(50) = &H8F
   Buffer(51) = &H7D
   Buffer(52) = &H26
   Buffer(53) = &H7E
   Dim gg
  gg = strtovar("7E FF 7D 23 C0 21 7D 21 7D 21 7D 20 7D 37 7D 22 7D 26 7D 20 7D 2A 7D 20 7D 20 7D 25 7D 26 7D 20 58 DB 7D 29 7D 27 7D 22 7D 28 7D 22 7D 2D 7D 23 7D 26 A8 AC 7E")
'gg = strtovar("7E FF 03 00 21 45 00 00 29 0C E2 00 00 80 11 BE A3 DC CF 32 8E DB 86 84 5D 22 bb 22 B9 00 15 00 00 29 29 84 00 08 8C 22 38 4E B5 C4 25 0D 46 55 7E")
   SR = del7d(gg)
   RTB1.SelColor = vbBlue
   RTB1.SelText = SR & vbCrLf & vbCrLf
   RTB1.SelLength = Len(RTB1.Text)
   MSComm1.Output = globalarr
yyy:
   With MSComm1
            .RThreshold = 1
            .InputMode = comInputModeBinary
            .InputLen = 1
   End With
  
   MSComm1.Output = gg ' 确保
   
   sendcom ("7E FF 7D 23 C0 21 7D 21 7D 22 7D 20 7D 2E 7D 22 7D 26 7D 20 7D 2A 7D 20 7D 20 7D 27 7D 22 7D 28 7D 22 D0 D3 7E")
   gsendcount = True
   gindex = 0
End Sub
Private Function strtovar(str As String) As Variant
   Dim i As Long, ss As String, l As Long
   Dim bb() As Byte
   ss = ""
   For i = 1 To Len(str)
       If Mid(str, i, 1) <> " " Then ss = ss & Mid(str, i, 1)
   Next i
   l = 0
   ReDim bb(Len(ss) / 2 - 1) As Byte
   For i = 1 To Len(ss)
      bb(l) = "&h" & Mid(ss, i, 2)
      i = i + 1
      l = l + 1
   Next i
   strtovar = bb
End Function
Private Sub Form_Initialize()
 
    With mycom
       .comm = 2
       .seting = "9600,N,8,1"
       .hands = 0
       .RTbyte = 1
       .INmode = 1
       .INlen = 1
       .INsize = 40
     
    End With
    ATHBIT = False
    Qaddr2(0) = &H7E
    Qaddr2(1) = &H80
    Qaddr2(2) = &H21
    Qaddr2(3) = &H1
    Qaddr2(4) = &H3
    Qaddr2(5) = &H0
    Qaddr2(6) = &H10
    Qaddr2(7) = &H2
    Qaddr2(8) = &H6
    Qaddr2(9) = &H0
    Qaddr2(10) = &H2D
    Qaddr2(11) = &HF
    Qaddr2(12) = &H1
    Qaddr2(13) = &H3
    Qaddr2(14) = &H6
    RESSEND = 0
    str1$ = "7E FF 7D 23 C0 21 7D 21 7D 20 7D 20 7D 34 7D 22 7D 26 7D 20 7D 20 7D 20 7D 20 7D 25 7D 26 45 31 2E 7D 3C 7D 27 7D 22 7D 28 7D 22 DB 46 7E"
    str2$ = " 7E FF 7D 23 C0 21 7D 21 7D 21 7D 20 7D 38 7D 27 7D 22 7D 28 7D 22 7D 21 7D 24 7D 25 DC 7D 25 7D 26 7D 24 75 7D 30 2D 7D 22 7D 26 7D 20 7D 20 7D 20 7D 20 2F D7 7E"
    str3$ = "7E 80 21 01 02 00 10 02 06 00 2D 0F 01 03 06 00 00 00 00 AE F7 7E"
    sbStatusBar.Panels(1).Text = "COM" & mycom.comm & " close"
    
    'RTB1.Enabled = False
    
End Sub
Private Sub Form_Load()
'    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
'    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
'    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
'    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
    
   
    
'
'Text4 = "7E FF 03 80 21 01 01 00 10 02 06 00 2D 0F 01 03 06 0A 17 06 01 4A 09 7E"
'Text5 = "7E 80 21 01 03 00 10 02 06 00 2D 0F 01 03 06 AC 13 06 01 25 A5 7E"
'Text6 = "7E 80 21 02 01 00 10 02 06 00 2D 0F 01 03 06 0A 17 06 01 96 25 7E"
    
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
RTB1.Height = Me.ScaleHeight - sbStatusBar.Height - 500
RTB1.Width = Me.ScaleWidth - (2 * RTB1.Left)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub
Private Sub IFLGetBatteryLevel_Click()
    Call send7e("030b00")
End Sub
Private Sub IFLGetOwnPhoneNumber_Click()
    Call send7e("040302")
End Sub
Private Sub IFLGetPhoneInfo_Click()
    Call send7e("29 29 84 00 08 8C 22 38 4e B5 C4 25 0D")
End Sub
Private Sub IFLGetPhoneSoftVersions_Click()
  ' SendString = "06020101"
  ' Call send7e(SendString)
   Dim SR
   SR = del7d(strtovar("7E FF 03 00 21 45 00 00 38 2E 9A 00 00 80 01 E8 F3 DC C0 39 1E DB 85 31 D3 03 03 85 A5 00 00 00 00 45 00 00 3E 00 00 40 00 2F 11 28 78 DB 85 31 D3 DC C0 39 1E 1F 40 06 EC 00 2A 51 01 AB 69 7E"))
                                        RTB1.SelColor = vbBlue
                                        RTB1.SelText = SR & vbCrLf & vbCrLf
                                        RTB1.SelLength = Len(RTB1.Text)
                                        MSComm1.Output = globalarr
End Sub
Private Sub IFLGetSignalStrength_Click()
   Call send7e("030b00")
End Sub
Private Sub ipset_Click()
   ipfrm.Show
End Sub
Private Sub sendcom(str As String)
     MSComm1.Output = strtovar(str)
                                   RTB1.SelColor = vbBlue
                                      RTB1.SelText = str & vbCrLf & vbCrLf
                                      RTB1.SelLength = Len(RTB1.Text)
End Sub
Private Function arrchr(arr As Variant, bb As Byte, gg1 As Boolean) As Variant
'7E 80 21 01 01 00 0A 03 06 DC C0 38 11 D1 DA 7E
                            ' If rxdarr(1) = &H80 And rxdarr(2) = &H21 And rxdarr(3) = &H1 Then
                            '7E FF 03 80 21 02 01 00 0A 03 06 DC C0 38 11 C6 40 7E
      Dim i As Long, l As Long
      l = UBound(arr)
      ReDim ddff(l + 2) As Byte
      ddff(0) = &H7E
      ddff(1) = &HFF
      ddff(2) = &H3
      arr(3) = bb
      If gg1 = True Then
        arr(4) = arr(4) + 1
      End If
      For i = 1 To l
        ddff(2 + i) = arr(i)
      Next i
      arrchr = ddff
End Function
Private Function arrchr1(arr As Variant) As Variant
 '7E 80 21 03 0A 00 16 03 06 DC CF 31 23 81 06 DC C0 20 67 83 06 DC C0 00 82 81 EE 7E
 Dim i As Long
'7E FF 03 80 21 01 0B 00 16 03 06 DC CF 31 23 81 06 DC C0 20 67 83 06 DC C0 00 82 26 13 7E
                             
End Function
Private Sub doppp()
    Dim arr
    Dim SR
    Dim l As Long, gtype As Long
    l = 0: SR = "": gtype = 0
    With MSComm1
         Select Case .CommEvent
                Case comEvReceive
                    arr = .Input '读取一个接收字节
                    .RThreshold = 0
                    If arr(0) = &H7E Then
                      SR = SR & CStr(Hex(arr(0))) & " "
                      ReDim Preserve rxdarr(l) As Byte
                      rxdarr(l) = arr(0)
w:
                      Do
                        DoEvents
                      Loop Until .InBufferCount > 0
                      arr = .Input
                      l = l + 1
                      ReDim Preserve rxdarr(l) As Byte
                      rxdarr(l) = arr(0)
                      If arr(0) = &H7E Then
                          SR = SR & CStr(Hex(arr(0)))
                          RTB1.SelColor = vbRed
                          RTB1.SelText = SR & vbCrLf & vbCrLf
                          RTB1.SelLength = Len(RTB1.Text)
                          If rxdarr(4) = &HC0 And rxdarr(5) = &H21 And rxdarr(6) = &H7D Then
                                If rxdarr(7) = &H21 Then
                                   If gindex = 0 Then
                                      gindex = 1
                                      sendcom ("7E FF 7D 23 C0 21 7D 23 7D 21 7D 20 7D 28 7D 23 7D 24 C0 23 22 48 7E")
                                   Else
                                        rxdarr(7) = &H22
                                        SR = del7d(rxdarr)
                                        RTB1.SelColor = vbBlue
                                        RTB1.SelText = SR & vbCrLf & vbCrLf
                                        RTB1.SelLength = Len(RTB1.Text)
                                        MSComm1.Output = globalarr
                                        If gsendcount1 = True Then
                                           sendcom ("7E FF 03 C0 23 01 00 00 0E 04 43 41 52 44 04 43 41 52 44 8B C7 7E")
                                        End If
                                   End If
                                Else
                                   
                                   If rxdarr(7) = &H24 Then
                                      If gindex = 1 Then
                                        'gindex = 2: sendcom ("7E FF 7D 23 C0 21 7D 21 7D 25 7D 20 2B 7D 22 7D 26 7D 20 7D 20 7D 20 7D 20 7D 25 7D 26 34 D9 7D 32 FC 7D 27 7D 22 7D 28 7D 22 7D 33 7D 37 7D 21 A6 D1 CD 9E 82 E3 4C F9 9C D1 89 7D 3E 5B B1 8E 99 7D 20 7D 20 7D 20 7D 20 85 54 7E")
                                        gindex = 2: sendcom ("7E FF 7D 23 C0 21 7D 21 7D 22 7D 20 7D 2E 7D 22 7D 26 7D 20 7D 2A 7D 20 7D 20 7D 27 7D 22 7D 28 7D 22 D0 D3 7E")
                                      End If
                                   Else
                                    '7E FF 03 C0 23 01 00 00 0E 04 43 41 52 44 04 43 41 52 44 8B C7 7E
                                     If rxdarr(7) = &H22 Then
                                        If gindex = 2 Then
                                         gsendcount1 = True: sendcom ("7E FF 03 C0 23 01 00 00 0E 04 43 41 52 44 04 43 41 52 44 8B C7 7E")
                                       End If
                                     End If
                                   End If
                                End If
                               
                          Else
                            If rxdarr(1) = &H80 And rxdarr(2) = &H21 And rxdarr(3) = &H1 Then
                              SR = del7d(arrchr(rxdarr, 2, 0))
                              RTB1.SelColor = vbBlue
                              RTB1.SelText = SR & vbCrLf & vbCrLf
                              RTB1.SelLength = Len(RTB1.Text)
                              MSComm1.Output = globalarr
                              
                              sendcom ("7E FF 03 80 21 01 0A 00 16 03 06 00 00 00 00 81 06 00 00 00 00 83 06 00 00 00 00 AB 31 7E")
                            Else
                             If rxdarr(1) = &H80 And rxdarr(2) = &H21 And rxdarr(3) = &H3 Then
                               SR = del7d(arrchr(rxdarr, 1, 0))
                              RTB1.SelColor = vbBlue
                              RTB1.SelText = SR & vbCrLf & vbCrLf
                              RTB1.SelLength = Len(RTB1.Text)
                              MSComm1.Output = globalarr
                             '7E 80 21 03 0A 00 16 03 06 DC CF 31 23 81 06 DC C0 20 67 83 06 DC C0 00 82 81 EE 7E
                             
                             '7E FF 03 80 21 01 0B 00 16 03 06 DC CF 31 23 81 06 DC C0 20 67 83 06 DC C0 00 82 26 13 7E
                             Else
                               If rxdarr(3) = &HC0 And rxdarr(4) = &H23 And rxdarr(5) = &H2 Then
                               '7E FF 03 C0 23 02 00 00 05 00 30 27 7E
                                sendcom ("7E FF 03 80 21 01 09 00 28 02 06 00 2D 0F 01 03 06 00 00 00 00 81 06 00 00 00 00 82 06 00 00 00 00 83 06 00 00 00 00 84 06 00 00 00 00 2C 63 7E")
                               Else
                                  If rxdarr(1) = &H80 And rxdarr(2) = &H21 And rxdarr(3) = &H2 Then
'7E  80  21  02  04  00  16  03  06  [0A  5F][10 37] 81  06  [D3  88  21  6B]  83  06  [D3  88  12  AB]  DE  E3  7E
'                                    9  10    11 12           15  16  17  18            21  22  23  24
                                        mycom.addr2(0) = rxdarr(9)
                                        mycom.addr2(1) = rxdarr(10)
                                        mycom.addr2(2) = rxdarr(11)
                                        mycom.addr2(3) = rxdarr(12)
                                        '
                                        '
                                        mycom.IPcom(2) = &H22 'rxdarr(9)
                                        mycom.IPcom(3) = &HBB 'rxdarr(10)
                                        '
'sendcom ("7E FF 03 00 21 45 00 01 48 2E 94 00 00 80 11 F5 32 DC C0 39 1E FF FF FF FF 00 44 00 43 01 34 C8 0B 01 08 06 00 D2 00 A2 57 06 00 00 00 DC C0 39 1E 00 00 00 00 00 00 00 00 00 00 00 00 00 53 45 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 63 82 53 63 35 01 08 3D 07 08 00 53 45 00 00 00 0C 08 6C 68 2D 63 68 65 6E 74 3C 08 4D 53 46 54 20 35 2E 30 37 04 06 2C 2B 0F FF 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 19 4F 7E")
                                  End If
                               End If
                             End If
                             
                            End If
                          End If
                      Else
                          If Len(CStr(Hex(arr(0)))) = 1 Then
                            SR = SR & "0" & CStr(Hex(arr(0))) & " "
                          Else
                            SR = SR & CStr(Hex(arr(0))) & " "
                          End If
                          GoTo w:
                      End If
                    Else
                        SR = Chr(arr(0))
                        RTB1.SelColor = vbRed
                        RTB1.SelText = SR
                        RTB1.SelLength = Len(RTB1.Text)
                    End If
                    MSComm1.RThreshold = 1
                Case Else
         End Select
    End With
End Sub
Private Sub MSComm1_OnComm()
   doppp
'
'   With MSComm1
'     Dim arr
'     Dim crclong As Long
'     Dim l As Long, SR As String, i As Long
'     l = 0
'       Select Case .CommEvent '判断MSComm1通信事件
'             Case comEvReceive '收到Rthreshold个字节产生的接收事件
'                  arr = .Input '读取一个接收字节
'                        .RThreshold = 0
'                  SR = ""
'
'                 If arr(0) = &H7E Then
'                  SR = SR & CStr(Hex(arr(0))) & " "
'                  ReDim Preserve rxdarr(l) As Byte
'                  rxdarr(l) = arr(0)
'w:
'                     Do
'                        DoEvents
'                     Loop Until .InBufferCount > 0
'                     arr = .Input
'                     l = l + 1
'                     ReDim Preserve rxdarr(l) As Byte
'                     rxdarr(l) = arr(0)
'                     If arr(0) = &H7E Then
'                          SR = SR & CStr(Hex(arr(0)))
'
'                          RTB1.SelColor = vbRed
'                          RTB1.SelText = SR & vbCrLf & vbCrLf
'                          RTB1.SelLength = Len(RTB1.Text)
'                          '***************************************7E FF 7D 23 C0 21 7D 26 7D 24 7D 20 7D 24 4D DB 7E
'
'                          If rxdarr(6) = &H7D Then
'                                If rxdarr(7) = &H21 Then
'                                    If RESSEND >= 3 Then
'                                       rxdarr(7) = &H24
'                                       RESSEND = 0
'                                    Else
'                                       rxdarr(7) = &H22
'                                       RESSEND = RESSEND + 1
'                                       GBt1 = True
'                                    End If
'                                    SR = del7d(rxdarr)
'                                    RTB1.SelColor = vbBlue
'                                    RTB1.SelText = SR & vbCrLf & vbCrLf
'                                    RTB1.SelLength = Len(RTB1.Text)
'
'                                Else
'                                  If rxdarr(7) = &H22 Then
'                                     ' Call ip_Click
'                                  Else
'                                     If rxdarr(4) = &HC0 And rxdarr(5) = &H21 And CLOSEBIT = True Then
'                                        ATHBIT = True
'                                        CLOSEBIT = False
'                                        RESSEND = 0
'                                        If t1.Enabled = False Then t1.Enabled = True
'                                     End If
'                                  End If
'                                End If
'                          Else
'
'                            If rxdarr(2) = &H80 And rxdarr(3) = &H21 And rxdarr(4) = 1 Then
'                                 rxdarr(5) = 2
'                                 addr1(0) = rxdarr(l - 6)
'                                 addr1(1) = rxdarr(l - 5)
'                                 addr1(2) = rxdarr(l - 4)
'                                 addr1(3) = rxdarr(l - 3)
'
'                                 crclong = crc.ArrToCRC(rxdarr, 1, l - 3)
'                                 If crclong <> -1 Then
'                                          rxdarr(l - 2) = crclong And 255
'                                          rxdarr(l - 1) = Fix(crclong / 256) And 255
'                                          MSComm1.Output = rxdarr
'                                          SR = ""
'                                          For i = 0 To l
'                                              If Len(CStr(Hex(rxdarr(i)))) = 1 Then
'                                              SR = SR & "0" & CStr(Hex(rxdarr(i))) & " "
'                                              Else
'                                              SR = SR & CStr(Hex(rxdarr(i))) & " "
'                                              End If
'                                          Next
'                                          RTB1.SelColor = vbBlue
'                                          RTB1.SelText = SR & vbCrLf & vbCrLf
'                                          RTB1.SelLength = Len(RTB1.Text)
'
'                                   End If
'
'                             Else
'                                If rxdarr(3) = &H80 And rxdarr(4) = &H21 And rxdarr(5) = 3 Then
'                                    mycom.addr2(0) = rxdarr(l - 6)
'                                    mycom.addr2(1) = rxdarr(l - 5)
'                                    mycom.addr2(2) = rxdarr(l - 4)
'                                    mycom.addr2(3) = rxdarr(l - 3)
'                                    Qaddr2(15) = mycom.addr2(0)
'                                    Qaddr2(16) = mycom.addr2(1)
'                                    Qaddr2(17) = mycom.addr2(2)
'                                    Qaddr2(18) = mycom.addr2(3)
'                                    crclong = crc.ArrToCRC(Qaddr2, 1, 18)
'                                    Qaddr2(19) = crclong And 255
'                                    Qaddr2(20) = Fix(crclong / 256) And 255
'                                    Qaddr2(21) = &H7E
'                                    MSComm1.Output = Qaddr2
'                                          SR = ""
'                                          For i = 0 To 21
'                                              If Len(CStr(Hex(Qaddr2(i)))) = 1 Then
'                                              SR = SR & "0" & CStr(Hex(Qaddr2(i))) & " "
'                                              Else
'                                              SR = SR & CStr(Hex(Qaddr2(i))) & " "
'                                              End If
'                                          Next
'
'                                          RTB1.SelColor = vbBlue
'                                          RTB1.SelText = SR & vbCrLf & vbCrLf
'                                          RTB1.SelLength = Len(RTB1.Text)
'                                Else
'                                    If rxdarr(3) = &H80 And rxdarr(4) = &H21 And rxdarr(5) = 2 Then
'                                          'LBip = addr1(0) & "." & addr1(1) & "." & addr1(2) & "." & addr1(3)
'                                         ' LBip1 = addr2(0) & "." & addr2(1) & "." & addr2(2) & "." & addr2(3)
'                                          't2.Enabled = True
''                                          Command8.Enabled = True
''                                          Command14.Enabled = True
''                                          Command15.Enabled = True
''                                        '  sb.Panels(1).Text = "连接成功! 远端IP:" & addr1(0) & "." & addr1(1) & "." & addr1(2) & "." & addr1(3) & "  本地IP:" & addr2(0) & "." & addr2(1) & "." & addr2(2) & "." & addr2(3)
''                                          GLngl = 0
'                                           RESSEND = 0
'                                           sbStatusBar.Panels(2).Text = "连接成功!"
'                                    End If
'                                End If
'
'                             End If
'
'                         End If
'                     Else
'                          If Len(CStr(Hex(arr(0)))) = 1 Then
'                            SR = SR & "0" & CStr(Hex(arr(0))) & " "
'                          Else
'                            SR = SR & CStr(Hex(arr(0))) & " "
'                          End If
'
'                         GoTo w:
'                     End If
'
'                 Else
'                    SR = Chr(arr(0))
'
'                    RTB1.SelColor = vbRed
'                    RTB1.SelText = SR
'                    RTB1.SelLength = Len(RTB1.Text)
'                 End If
'
'
're1:
'                MSComm1.RThreshold = 1
'
'
'
'
'
'        Case Else
'
'    End Select
'
'End With
'MSComm1.RThreshold = 1
End Sub
Private Sub opencom_Click()
           
     
       
            With MSComm1
                              
                 .CommPort = mycom.comm
                 .Settings = mycom.seting
                 .RThreshold = mycom.RTbyte
                 .InputMode = mycom.INmode
                 .InputLen = mycom.INlen
                 .InBufferSize = mycom.INsize
                 .Handshaking = mycom.hands
                 .PortOpen = True
                 sbStatusBar.Panels(1).Text = "COM" & mycom.comm & " open," & mycom.seting
            End With
        
End Sub
Private Sub procom_Click()
          comfrom.Show
End Sub
Private Sub t1_Timer()
 Dim SRY As String
 t1.Enabled = False
 If ATHBIT = True Then
    ATHBIT = False
    Dim B2B() As Byte
    ReDim B2B(5) As Byte
    B2B(0) = &H2B
    B2B(1) = &H2B
    B2B(2) = &H2B
    B2B(3) = &H2B
    B2B(4) = &H2B
    B2B(5) = &H2B
    MSComm1.Output = B2B
    RTB1.SelColor = vbBlue
    RTB1.SelText = "+++" & vbCrLf & vbCrLf
    RTB1.SelLength = Len(RTB1.Text)
    
    ReDim B2B(3) As Byte
    Mstr = "41 54 48 13"
    B2B(0) = &H41
    B2B(1) = &H54
    B2B(2) = &H48
    B2B(3) = &HD
    MSComm1.Output = B2B
    RTB1.SelColor = vbBlue
    RTB1.SelText = "ATH" & vbCrLf & vbCrLf
    RTB1.SelLength = Len(RTB1.Text)
    
    
    SRY = ""
    MSComm1.RThreshold = 0
    MSComm1.InputLen = 0
    MSComm1.Handshaking = 2
    MSComm1.InputMode = comInputModeText
    MSComm1.Output = "ATH" & Chr$(13) ' 确保
    Do
      DoEvents
      If MSComm1.PortOpen = False Then Exit Sub
      SRY = SRY & MSComm1.Input
    Loop Until InStr(SRY, "OK" & vbCrLf) Or InStr(SRY, "ERROR" & vbCrLf)
    RTB1.SelColor = vbBlue
    RTB1.SelText = "OK" & vbCrLf & vbCrLf
    RTB1.SelLength = Len(RTB1.Text)
    
    sbStatusBar.Panels(2).Text = "断开连接!"
 Else
 
 
 
'        If MSComm1.PortOpen = True Then
'           MSComm1.Output = globalarr
'        End If
'        If GBt1 = True Then
'           GBt1 = False
'           SRY = sendbyte(str1$)
'           RTB1.SelColor = vbBlue
'           RTB1.SelText = SRY & vbCrLf & vbCrLf
'           RTB1.SelLength = Len(RTB1.Text)
'
'        End If
 
 End If
End Sub
Private Sub ip_Click()
   Dim af As String
   SR = sendbyte(str3$)
   RTB1.SelColor = vbBlue
   RTB1.SelText = SR & vbCrLf & vbCrLf
   RTB1.SelLength = Len(RTB1.Text)
End Sub
Public Function del7d(bu) As String
           ' On Error GoTo cc:
            Dim i As Long, l As Long, SR As String, er As Long
            Dim temparr() As Byte
            
            l = 0
            er = 1
            For i = 0 To UBound(bu)
               If bu(i) = &H7D Then
                   i = i + 1
                   ReDim Preserve temparr(l) As Byte
                   temparr(l) = bu(i) - 32
                   l = l + 1
               Else
               
                  ReDim Preserve temparr(l) As Byte
                  temparr(l) = bu(i)
                  l = l + 1
               End If
            Next
            er = 2
            i = crc.ArrToCRC(temparr, 1, l - 4)
            If i <> -1 Then
               er = 3
               bu(UBound(bu) - 2) = i And 255
              ' bu(UBound(bu) - 2) = CByte("&h" & Hex(crc.ReCRC1))
               er = 4
               bu(UBound(bu) - 1) = Fix(i / 256) And 255
              ' bu(UBound(bu) - 1) = CByte("&h" & Hex(crc.ReCRC2))
               globalarr = bu
               If t1.Enabled = False Then t1.Enabled = True
               SR = ""
               er = 5
               For i = 0 To UBound(bu)
                  If Len(CStr(Hex(bu(i)))) = 1 Then
                  SR = SR & "0" & CStr(Hex(bu(i))) & " "
                  Else
                  SR = SR & CStr(Hex(bu(i))) & " "
                  End If
               Next
              
               del7d = SR
            End If
            
cc:
            '   rtb1.SelColor = vbBlue
            '   rtb1.SelText = "del7d() error " & CStr(UBound(bu)) & " " & er & Hex(crc.ReCRC1) & Hex(crc.ReCRC2) & " " & l & vbCrLf & vbCrLf
            '   rtb1.SelLength = Len(rtb1.Text)
End Function
Public Function sendbyte(st As String) As String
Dim i As Long
Dim a As String, b As String
Dim arrout
a = ""
For i = 1 To Len(st)
    b = Mid(st, i, 1)
    b = Asc(b)
    If b > 47 Then
          a = a & Mid(st, i, 1)
    End If
   
Next
    arrout = crc.StringToHex(a)
    a = del7d(arrout)
    sendbyte = a
  
End Function
Public Sub send7e(st As String)
Dim i As Long
Dim a As String, b As String
Dim arrout
Dim lll
a = ""
For i = 1 To Len(st)
    b = Mid(st, i, 1)
    b = Asc(b)
    If b > 47 Then
          a = a & Mid(st, i, 1)
    End If
   
Next
ReDim a7e(32) As Byte
'w::7E FF 03 00 21 45 [00 00 26] 0C E2 [00 00 80 11] [8C 73] [DC CF 33 60] [D3 8B BD B6] [22 B9 C2 BB 00 12 3E E9] [24 24 21 00 05 CB 8C 00 63 0A] EF D3 7E
'   0  1  2  3  4  5   6  7  8   9  10  11 12 13 14   15 16   17 18 19 20   21 22 23 24   25 26 27 28 29 30 31 32   33 34 35 36 37 38 39 40 41 42  43 44 45
a7e(0) = &H7E
a7e(1) = &HFF
a7e(2) = &H3
a7e(3) = &H0
a7e(4) = &H21
a7e(5) = &H45
a7e(6) = &H0
a7e(7) = &H0
a7e(8) = 27
a7e(9) = &HC
a7e(10) = &HE2
a7e(11) = &H0
a7e(12) = &H0
a7e(13) = &H80
a7e(14) = &H11
a7e(15) = &H0
a7e(16) = &H0
a7e(17) = mycom.addr2(0)
a7e(18) = mycom.addr2(1)
a7e(19) = mycom.addr2(2)
a7e(20) = mycom.addr2(3)
'219.134.132.93  db 86 84 5d   22 b9
a7e(21) = 219
a7e(22) = 134
a7e(23) = 132
a7e(24) = 93
a7e(25) = mycom.IPcom(2)
a7e(26) = mycom.IPcom(3)
'8889
a7e(27) = &H22
a7e(28) = &HB9
a7e(29) = 0
a7e(31) = 0
a7e(32) = 0
'w::7E FF 03 00 21 45 [00 00 26] 0C E2 [00 00 80 11] [8C 73] [DC CF 33 60] [D3 8B BD B6] [22 B9 C2 BB 00 12 3E E9] [24 24 21 00 05 CB 8C 00 63 0A] EF D3 7E
'   0  1  2  3  4  5   6  7  8   9  10  11 12 13 14   15 16   17 18 19 20   21 22 23 24   25 26 27 28 29 30 31 32   33 34 35 36 37 38 39 40 41 42  43 44 45
arrout = crc.StringToHex(a)
    
    ReDim Preserve a7e(35 + UBound(arrout) + 1) As Byte
    i = a7e(8) + UBound(arrout) + 2
    If i > 255 Then
      a7e(7) = Fix(i / 256)
      a7e(8) = i And 255
    Else
      a7e(8) = i
    End If
    i = UBound(arrout) + 1 + 8
    
    If i > 255 Then
      a7e(29) = Fix(i / 256)
      a7e(30) = i And 255
    Else
      a7e(30) = i
    End If
    For i = 0 To UBound(arrout)
       a7e(i + 33) = arrout(i)
    Next
    a7e(UBound(a7e)) = &H7E
    
 '0  1  2   3  4  5    6  7  8  9  10 11   12 13   14 15 16 17 18 19 20 21
'7E 21 45 [00 00 20] [67 39 00 00 80 11] [6B 11] [AC 13 06 01 AC 13 0A 5B]
'[0C E4 0D 05 00 0C   59 3C]  [24 24 00 0A] A1 79 7E
' 22 23 24 25 26 27   28 29   30  31 32 33  34  35 36
'219.134.132.93  db 86 84 5d   22 b9
    ReDim cra(17) As Byte
    For i = 0 To 9
       cra(i) = a7e(i + 5)
    Next
    For i = 10 To 17
      cra(i) = a7e(i + 7)
    Next
    Dim craa
    craa = crc.IpUDPCR(cra)
    a7e(15) = craa(0)
    a7e(16) = craa(1)
    
 '   Call del7d(a7e)
    
             i = crc.ArrToCRC(a7e, 1, UBound(a7e) - 3)
            If i <> -1 Then
              
               a7e(UBound(a7e) - 2) = i And 255
          
               a7e(UBound(a7e) - 1) = Fix(i / 256) And 255
            
               'globalarr = a7e
              a = ""
               For i = 0 To UBound(a7e)
                  If Len(CStr(Hex(a7e(i)))) = 1 Then
                     a = a & "0" & CStr(Hex(a7e(i))) & " "
                  Else
                    a = a & CStr(Hex(a7e(i))) & " "
                  End If
               Next
              
               'del7d = SR
            End If
            
    
    
    
    MSComm1.Output = a7e
    
   RTB1.SelColor = vbBlue
   RTB1.SelText = a & vbCrLf
   RTB1.SelLength = Len(RTB1.Text)
Exit Sub
pr:
   RTB1.SelColor = vbRed
   RTB1.SelText = "Error SendData()"
   RTB1.SelLength = Len(RTB1.Text)
End Sub

						