form1.frm

C# 小工具：替代微软的超级终端

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4875
   ClientLeft      =   60
   ClientTop       =   375
   ClientWidth     =   6210
   LinkMode        =   1  'Source
   LinkTopic       =   "FormTopic"
   ScaleHeight     =   4875
   ScaleWidth      =   6210
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdTestLog 
      Caption         =   "log 测试"
      Height          =   375
      Left            =   2520
      TabIndex        =   8
      Top             =   4200
      Width           =   1095
   End
   Begin VB.CommandButton cmdTest 
      Caption         =   "测试"
      Height          =   375
      Left            =   1440
      TabIndex        =   7
      Top             =   4200
      Width           =   975
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      ItemData        =   "Form1.frx":0000
      Left            =   1440
      List            =   "Form1.frx":0013
      TabIndex        =   5
      Text            =   "5"
      Top             =   360
      Width           =   1215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   3000
      Top             =   120
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton cmdConvertor 
      Caption         =   "开始接收"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   4200
      Width           =   855
   End
   Begin VB.TextBox txtResult 
      Height          =   1335
      Left            =   360
      TabIndex        =   1
      Text            =   "Text2"
      Top             =   2640
      Width           =   5535
   End
   Begin VB.TextBox txtOriginal 
      Height          =   1215
      Left            =   360
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   1080
      Width           =   5535
   End
   Begin VB.Label Label3 
      Caption         =   "COM 口："
      Height          =   375
      Left            =   360
      TabIndex        =   6
      Top             =   360
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "接收的文本："
      Height          =   495
      Left            =   360
      TabIndex        =   4
      Top             =   2400
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "接收数据："
      Height          =   375
      Left            =   360
      TabIndex        =   3
      Top             =   840
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim bStart As Boolean




Private Sub cmdTestLog_Click()
    
    tracLog "cmdTestLog_Click", "this is a test"
    
End Sub

Private Sub Form_Load()
    bStart = False
    cmdConvertor.Caption = "开始接收"
End Sub

Private Function DecToHex(dd As Byte) As String

'----------------------------code auto generated-------------------------
Dim sMethod As String
sMethod = "DecToHex"
On Error GoTo errHandle
'------------------------------------------------------------------------


    DecToHex = IIf(dd > &HF, Hex(dd), "0" & Hex(dd)) '这行代码是eastunfail提供的。
    
    
'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    Exit Function
End If
'------------------------------------------------------------------------
    
End Function


Private Sub cmdConvertor_Click()
'----------------------------code auto generated------------------------
Dim sMethod As String
sMethod = "cmdConvertor_Click"
On Error GoTo errHandle
'------------------------------------------------------------------------

   If bStart = False Then
    
    MSComm1.CommPort = Combo1.Text '设置串行端口(com1)
    MSComm1.Settings = "9600,n,8,1" '设置波特率及数据帧格式
    MSComm1.InputMode = 1 '数据接受按字节(binary)方式
    MSComm1.RThreshold = 1       '"控件收到数据时将触发OnComm事件
    MSComm1.InBufferCount = 0       '"清除发送缓冲区数据
    MSComm1.OutBufferCount = 0       '"清除接收缓冲区数据

    MSComm1.PortOpen = True
    
    
    bStart = True
    cmdConvertor.Caption = "停止接收"
    
   Else
   
    MSComm1.PortOpen = False
    bStart = False
    cmdConvertor.Caption = "开始接收"
   
   End If
    
'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    MsgBox "端口不存在或已经被其他设备所占用,请选择其它端口!"
    Exit Sub
End If
'------------------------------------------------------------------------
    
End Sub

'获取原始报文内容
Private Function getOriString(Buffer() As Byte) As String
'----------------------------code auto generated-----------------------
Dim sMethod As String
sMethod = "getOriString"
On Error GoTo errHandle
'----------------------------------------------------------------------

    Dim inputStr As String
        
    Rev_num = UBound(Buffer)
    
    For i = 0 To Rev_num
        
      inputStr = inputStr + DecToHex(Buffer(i))
        
    Next i
    
    getOriString = inputStr
    
'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    Exit Function
End If
'------------------------------------------------------------------------
End Function


'获取报文内容，转化为Unicode
Private Function getConvertString(Buffer() As Byte) As String
'----------------------------code auto generated------------------------
Dim sMethod As String
sMethod = "getConvertString"
On Error GoTo errHandle
'------------------------------------------------------------------------

    Dim rstBuffer() As Byte
    
    rstBuffer = Left$(Buffer, UBound(Buffer) - 2) ' 去掉后面的回车
    
    rstBuffer = Right$(Buffer, UBound(rstBuffer) - 2) ' 去掉开始的回车
    
    getConvertString = StrConv(rstBuffer, vbUnicode) '转化为Unicode
    

'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    Exit Function
End If
'------------------------------------------------------------------------
        
End Function



Private Sub cmdTest_Click()
'----------------------------code auto generated------------------------
Dim sMethod As String
sMethod = "cmdTest_Click"
On Error GoTo errHandle
'------------------------------------------------------------------------

    Dim Buffer() As Byte
    Buffer = Space$(8)
    Buffer(0) = Val("&H" & "0D")
    Buffer(1) = Val("&H" & "0A")
    Buffer(2) = Val("&H" & "2D")
    Buffer(3) = Val("&H" & "B2")
    Buffer(4) = Val("&H" & "D9")
    Buffer(5) = Val("&H" & "D7")
    Buffer(6) = Val("&H" & "F7")
    Buffer(7) = Val("&H" & "C3")
    Buffer(8) = Val("&H" & "FC")
    Buffer(9) = Val("&H" & "C1")
    Buffer(10) = Val("&H" & "EE")
    Buffer(11) = Val("&H" & "2D")
    Buffer(12) = Val("&H" & "20")
    Buffer(13) = Val("&H" & "20")
    Buffer(14) = Val("&H" & "0D")
    Buffer(15) = Val("&H" & "0A")
    
    txtOriginal.Text = getOriString(Buffer)
    
    txtResult.Text = getConvertString(Buffer)
    
'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    Exit Sub
End If
'------------------------------------------------------------------------

End Sub



Private Sub Form_Unload(Cancel As Integer)
    
'    If True = MSComm1.PortOpen Then
'        MSComm1.c.CommPort = False
'    End If
'
End Sub

Private Sub MSComm1_OnComm()
'----------------------------code auto generated------------------------
Dim sMethod As String
sMethod = "MSComm1_OnComm"
On Error GoTo errHandle
'------------------------------------------------------------------------

  DelayTime '用来延续时间
  
  Dim inbuf() As Byte
  
  With MSComm1
    Select Case .CommEvent '判断通信事件
    Case comEvReceive: '收到Rthreshold个字节产生的接收事件
      
      inbuf = MSComm1.Input
      
      txtOriginal.Text = getOriString(inbuf)
      txtResult.Text = getConvertString(inbuf)

    End Select
   End With
   
'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    Exit Sub
End If
'------------------------------------------------------------------------

      
'      SwichVar 1
'      If Out(1) = 2 Then '判断是否为数据的开始标志
'        .RThreshold = 0 '关闭OnComm事件接收
'      End If
'      Do
'        DoEvents
'      Loop Until .InBufferCount >= 3 '循环等待接收缓冲区>=3个字节
'      ' nRece = nRece + 1
'      For i = 2 To 12
'        SwichVar i
'        Text1.Text = Text1.Text & Chr(Out(i))
'      Next
'      Text1.Text = LTrim(Text1.Text)
'      Text2.Text = Text2.Text & CStr(nRece)
'      .RThreshold = 1 '打开MSComm事件接收
'    Case Else
'      ' .PortOpen = False
'    End Select
End Sub

'****************************************************************************

Private Sub DelayTime()
'----------------------------code auto generated------------------------
Dim sMethod As String
sMethod = "DelayTime"
On Error GoTo errHandle
'------------------------------------------------------------------------

  Dim bDT As Boolean
  Dim sPrevious As Single, sLast As Single

  bDT = True

  sPrevious = Timer '(Timer可以计算从子夜到现在所经过的秒数，在Microsoft Windows中，Timer函数可以返回一秒的小数部分)

  Do While bDT
    If Timer - sPrevious >= 0.3 Then bDT = False
  Loop
  bDT = True
  
'----------------------------err handle----------------------------------
If False Then
errHandle:
    errLog sMethod, Err.Description, CStr(Err.Number)
    Exit Sub
End If
'------------------------------------------------------------------------

End Sub

'Private Sub SwichVar(ByVal nNum As Integer)
'
'  DelayTime
'  Var = Null
'  Var = MSC.Input
'  Out(nNum) = Var(0)
'
'End Sub