?? form1.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -