Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
我这有个串口通讯程序（vb)，谁能帮我翻译成delphi,调试通过，
奉上600分。请留下email;
我的EMAIL:zhaohai9@163.net
奉上600分。请留下email;
我的EMAIL:zhaohai9@163.net
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
其实你贴出来大家就可以给你解决了。
一般VB底串口程序是使用mscomm控件底，在Delphi里面直接使用也可以，输入Activex控件，选择Mscomm就行了。
一般VB底串口程序是使用mscomm控件底，在Delphi里面直接使用也可以，输入Activex控件，选择Mscomm就行了。
卷
卷起千堆雪tyn
Unregistered / Unconfirmed
GUEST, unregistred user!
forevertyn@263.net
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
翻译二：
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form IMS
Caption = "IMS Emluator"
ClientHeight = 3585
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
Icon = "IMSTest.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3585
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtOut
Height = 315
Left = 60
Locked = -1 'True
TabIndex = 19
Top = 3240
Width = 4545
End
Begin MSCommLib.MSComm comIMS
Left = 3600
Top = -30
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = -1 'True
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
Height = 375
Left = 3540
TabIndex = 18
Top = 2700
Width = 1035
End
Begin VB.Timer timIMS
Enabled = 0 'False
Interval = 1000
Left = 4320
Top = 30
End
Begin VB.CommandButton cmdStop
Caption = "停 止"
Height = 375
Left = 3540
TabIndex = 2
Top = 780
Width = 1035
End
Begin VB.CommandButton cmdBegin
Caption = "开 始"
Height = 375
Left = 3540
TabIndex = 1
Top = 270
Width = 1035
End
Begin VB.Frame IMSCtr
Caption = "IMS : "
ForeColor = &H00FF00FF&
Height = 2925
Left = 120
TabIndex = 0
Top = 150
Width = 3255
Begin VB.CommandButton cmdIMS
Caption = "Enter"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 990
TabIndex = 6
Top = 2430
Width = 1275
End
Begin VB.TextBox txt820
Alignment = 1 'Right Justify
BeginProperty Font
Name = "Times New Roman"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 270
MultiLine = -1 'True
TabIndex = 5
Top = 360
Width = 1365
End
Begin VB.CommandButton cmdLast
Caption = "<"
Height = 285
Left = 60
TabIndex = 4
Top = 2550
Width = 315
End
Begin VB.CommandButton cmdNext
Caption = ">"
Height = 285
Left = 2880
TabIndex = 3
Top = 2580
Width = 315
End
Begin VB.Label lbl827
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 17
Top = 2160
Width = 1275
End
Begin VB.Label lbl826
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 16
Top = 1980
Width = 1275
End
Begin VB.Label lbl825
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 15
Top = 1800
Width = 1275
End
Begin VB.Label lbl824
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 14
Top = 1620
Width = 1275
End
Begin VB.Label lbl823
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 285
Left = 390
TabIndex = 13
Top = 1380
Width = 1215
End
Begin VB.Label lbl822
Alignment = 1 'Right Justify
Height = 315
Left = 330
TabIndex = 12
Top = 1170
Width = 1275
End
Begin VB.Label lbl903
Alignment = 1 'Right Justify
Caption = "er"
Height = 285
Left = 2100
TabIndex = 11
Top = 1140
Width = 885
End
Begin VB.Label lbl902
Alignment = 1 'Right Justify
Caption = "er"
Height = 285
Left = 2130
TabIndex = 10
Top = 930
Width = 855
End
Begin VB.Label lblETime
Height = 285
Left = 2100
TabIndex = 9
Top = 540
Width = 975
End
Begin VB.Label lblSTime
Height = 315
Left = 2100
TabIndex = 8
Top = 300
Width = 1065
End
Begin VB.Label lbl821
Alignment = 1 'Right Justify
BeginProperty Font
Name = "Times New Roman"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 270
TabIndex = 7
Top = 810
Width = 1305
End
End
Begin VB.Line Line1
X1 = 0
X2 = 4680
Y1 = 3150
Y2 = 3150
End
End
Attribute VB_Name = "IMS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const DeviceNumber = 11
Dim IMSData(DeviceNumber) As IMSType
Dim intCtrPoint As Integer
Dim intUnPackOK As Integer
Dim strUnPackData As String
Dim strTempData As String
Dim strUnPackedData As String
Dim strSpsAddress As String
Dim strDevAddress As String
Private SOH As String * 1
Private STX As String * 1
Private ETX As String * 1
Private ACK As String * 1
Private NAK As String * 1
Sub InitSystem()
Dim intPoint As Integer
SOH = Chr$(&H1)
STX = Chr$(&H2)
ETX = Chr$(&H3)
ACK = Chr$(&H6)
NAK = Chr$(&H15)
intCtrPoint = 0
IMSCtr.Caption = "IMS : " & Format(intCtrPoint + 1, "0#")
cmdStop.Enabled = False
For intPoint = 0 To DeviceNumber Step 1
IMSData(intPoint).C806 = 0
IMSData(intPoint).C820 = 1000
IMSData(intPoint).C821 = 0
IMSData(intPoint).C822 = 0
IMSData(intPoint).C823 = 0
IMSData(intPoint).C824 = 0
IMSData(intPoint).C825 = 25.54
IMSData(intPoint).C826 = 154.38
IMSData(intPoint).C827 = 19.56
IMSData(intPoint).C828 = Now
IMSData(intPoint).C840 = 0
IMSData(intPoint).C902 = 0
IMSData(intPoint).C903 = 0
IMSData(intPoint).C904 = Now
IMSData(intPoint).C905 = Now
IMSData(intPoint).C906 = 0
Next intPoint
txt820.Text = IMSData(intCtrPoint).C820
ViewIMS
comIMS.InputLen = 0
comIMS.PortOpen = True
intUnPackOK = 0
End Sub
Sub ViewIMS()
lbl821.Caption = Format(IMSData(intCtrPoint).C821, "######.#0")
lbl822.Caption = Format(IMSData(intCtrPoint).C822, "######.#0")
lbl823.Caption = Format(IMSData(intCtrPoint).C823, "######.#0")
lbl824.Caption = Format(IMSData(intCtrPoint).C824, "######.#0")
lbl825.Caption = Format(IMSData(intCtrPoint).C825, "######.#0")
lbl826.Caption = Format(IMSData(intCtrPoint).C826, "######.#0")
lbl827.Caption = Format(IMSData(intCtrPoint).C827, "######.#0")
lbl902.Caption = Format(IMSData(intCtrPoint).C902, "######.#0")
lbl903.Caption = Format(IMSData(intCtrPoint).C903, "######.#0")
lblSTime.Caption = Format(IMSData(intCtrPoint).C905, "hh:mm:ss")
lblETime.Caption = Format(IMSData(intCtrPoint).C904, "hh:mm:ss")
End Sub
Private Sub cmdBegin_Click()
timIMS.Enabled = True
cmdBegin.Enabled = False
cmdStop.Enabled = True
End Sub
Private Sub cmdExit_Click()
If comIMS.PortOpen = True Then
comIMS.PortOpen = False
End If
Unload Me
End Sub
Private Sub cmdIMS_Click()
If IMSData(intCtrPoint).C806 = 0 Then
If IsNumeric(txt820.Text) Then
IMSData(intCtrPoint).C820 = CLng(txt820.Text)
End If
IMSData(intCtrPoint).C821 = IMSData(intCtrPoint).C820
IMSData(intCtrPoint).C806 = 99
IMSData(intCtrPoint).C905 = Now
ViewIMS
End If
End Sub
Private Sub cmdLast_Click()
If IsNumeric(txt820.Text) Then
If IMSData(intCtrPoint).C806 = 0 Then
IMSData(intCtrPoint).C820 = CLng(txt820.Text)
End If
End If
intCtrPoint = intCtrPoint - 1
If intCtrPoint < 0 Then intCtrPoint = DeviceNumber
IMSCtr.Caption = "IMS : " & Format(intCtrPoint + 1, "0#")
txt820.Text = IMSData(intCtrPoint).C820
ViewIMS
End Sub
Private Sub cmdNext_Click()
If IsNumeric(txt820.Text) Then
If IMSData(intCtrPoint).C806 = 0 Then
IMSData(intCtrPoint).C820 = CLng(txt820.Text)
End If
End If
intCtrPoint = intCtrPoint + 1
If intCtrPoint > DeviceNumber Then intCtrPoint = 0
IMSCtr.Caption = "IMS : " & Format(intCtrPoint + 1, "0#")
txt820.Text = IMSData(intCtrPoint).C820
ViewIMS
End Sub
Private Sub cmdStop_Click()
timIMS.Enabled = False
cmdBegin.Enabled = True
cmdStop.Enabled = False
End Sub
Private Sub Form_Load()
InitSystem
End Sub
Private Sub timIMS_Timer()
Dim intPoint As Integer
For intPoint = 0 To DeviceNumber Step 1
If IMSData(intPoint).C806 > 0 Then
IMSData(intPoint).C821 = IMSData(intPoint).C821 - Rnd * 10
If IMSData(intPoint).C821 <= 0 Then
IMSData(intPoint).C902 = IMSData(intPoint).C820
IMSData(intPoint).C903 = IMSData(intPoint).C820 * 1.00024
IMSData(intPoint).C820 = 0
IMSData(intPoint).C822 = 0
IMSData(intPoint).C823 = 0
IMSData(intPoint).C824 = 0
If intPoint = intCtrPoint Then txt820.Text = 0
IMSData(intPoint).C904 = Now
IMSData(intPoint).C821 = 0
IMSData(intPoint).C806 = 0
Else
IMSData(intPoint).C822 = IMSData(intPoint).C820 - IMSData(intPoint).C821
IMSData(intPoint).C823 = IMSData(intPoint).C822 * 1.00024
IMSData(intPoint).C824 = Rnd * 10
End If
End If
IMSData(intPoint).C825 = IMSData(intPoint).C825 + Rnd - 0.5
IMSData(intPoint).C826 = IMSData(intPoint).C826 + Rnd - 0.5
IMSData(intPoint).C827 = IMSData(intPoint).C827 + Rnd - 0.5
Next intPoint
ViewIMS
PrcRequest
End Sub
Sub PrcRequest()
If comIMS.InBufferCount > 0 Then
strUnPackData = comIMS.Input
ProUnPackData
If intUnPackOK = 99 Then
intUnPackOK = 0
Answer
ElseIf intUnPackOK < 0 Then
intUnPackOK = 0
End If
End If
End Sub
Sub Answer()
Dim strTemp As String
Dim intTemp As Integer
Dim intDataBegin As Integer
Dim intDataEnd As Integer
Dim intCmdType As Integer
If Left(strUnPackedData, 1) = "R" Then
intDataBegin = 2
strTemp = SOH & strSpsAddress & strDevAddress & STX
Do
intDataEnd = InStr(intDataBegin, strUnPackedData, ";")
If intDataEnd > 0 Then
intCmdType = CInt(Mid(strUnPackedData, intDataBegin, intDataEnd - intDataBegin))
intDataBegin = intDataEnd + 1
Else
intCmdType = CInt(Right(strUnPackedData, Len(strUnPackedData) - intDataBegin + 1))
End If
If intCmdType = 806 Then
strTemp = strTemp & "806=" & Format(IMSData(CInt(strDevAddress - 1)).C806, "#0")
End If
If intCmdType = 820 Then
strTemp = strTemp & "820=" & Format(IMSData(CInt(strDevAddress - 1)).C820, "0#####")
End If
If intCmdType = 821 Then
strTemp = strTemp & "821=" & Format(IMSData(CInt(strDevAddress - 1)).C821, "0#####.#0")
End If
If intCmdType = 822 Then
strTemp = strTemp & "822=" & Format(IMSData(CInt(strDevAddress - 1)).C822, "0#####.#0")
End If
If intCmdType = 823 Then
strTemp = strTemp & "823=" & Format(IMSData(CInt(strDevAddress - 1)).C823, "0#####.#0")
End If
If intCmdType = 824 Then
strTemp = strTemp & "824=" & Format(IMSData(CInt(strDevAddress - 1)).C824, "0####")
End If
If intCmdType = 825 Then
strTemp = strTemp & "825=" & Format(IMSData(CInt(strDevAddress - 1)).C825, "0##.#0")
End If
If intCmdType = 826 Then
strTemp = strTemp & "826=" & Format(IMSData(CInt(strDevAddress - 1)).C826, "0###.#0")
End If
If intCmdType = 827 Then
strTemp = strTemp & "827=" & Format(IMSData(CInt(strDevAddress - 1)).C827, "0###.#")
End If
If intCmdType = 828 Then
strTemp = strTemp & "828=" & Format(IMSData(CInt(strDevAddress - 1)).C828, "hh:mm:ss")
End If
If intCmdType = 840 Then
strTemp = strTemp & "840=" & Format(IMSData(CInt(strDevAddress - 1)).C840, "0#######")
End If
If intCmdType = 902 Then
strTemp = strTemp & "902=" & Format(IMSData(CInt(strDevAddress - 1)).C902, "0#####.#0")
End If
If intCmdType = 903 Then
strTemp = strTemp & "903=" & Format(IMSData(CInt(strDevAddress - 1)).C903, "0#####.#0")
End If
If intCmdType = 904 Then
strTemp = strTemp & "904=" & Format(IMSData(CInt(strDevAddress - 1)).C904, "hh:mm")
End If
If intCmdType = 905 Then
strTemp = strTemp & "905=" & Format(IMSData(CInt(strDevAddress - 1)).C905, "hh:mm")
End If
If intCmdType = 906 Then
strTemp = strTemp & "906=" & Format(IMSData(CInt(strDevAddress - 1)).C906, "0#######")
End If
If intDataEnd > 0 Then
strTemp = strTemp & ";"
Else
strTemp = strTemp & ETX
End If
Loop While (intDataEnd > 0)
strTemp = strTemp & strCheckSum(strTemp)
comIMS.Output = strTemp
txtOut.Text = ""
For intTemp = 1 To Len(strTemp) Step 1
txtOut.Text = txtOut.Text & Hex(Asc(Mid(strTemp, intTemp, 1))) & ";"
Next intTemp
End If
End Sub
' ================================================
' 功能: 获取数据效验值
' ================================================
Private Function strCheckSum(strData As String) As String
Dim intTemp, intSum As Integer
intSum = 0
For intTemp = 1 To Len(strData) Step 1
intSum = intSum + Asc(Mid(strData, intTemp, 1))
Next intTemp
strCheckSum = Hex((intSum / &H10) Mod &H10) & Hex(intSum Mod &H10)
End Function
' ================================================
' 功能: 处理卸载协议数据
' ================================================
Sub ProUnPackData()
Dim intEndPoint As Integer
intEndPoint = 0
Select Case intUnPackOK
Case 0
If Left(strUnPackData, 1) = SOH Then
intEndPoint = InStr(1, strUnPackData, ETX)
If (intEndPoint < 1) Then
strTempData = strUnPackData
intUnPackOK = 1
Else
Select Case Len(strUnPackData)
Case intEndPoint
strTempData = strUnPackData
intUnPackOK = 2
Case intEndPoint + 1
strTempData = strUnPackData
intUnPackOK = 3
Case intEndPoint + 2
strTempData = strUnPackData
UnPackProcess
Case Else
'数据错误
intUnPackOK = -1
End Select
End If
Else
'数据错误
intUnPackOK = -1
End If
Case 1
intEndPoint = InStr(1, strUnPackData, ETX)
If (intEndPoint < 1) Then
strTempData = strTempData & strUnPackData
Else
Select Case Len(strUnPackData)
Case intEndPoint
strTempData = strTempData & strUnPackData
intUnPackOK = 2
Case intEndPoint + 1
strTempData = strTempData & strUnPackData
intUnPackOK = 3
Case intEndPoint + 2
strTempData = strTempData & strUnPackData
UnPackProcess
Case Else
'数据错误
intUnPackOK = -1
End Select
End If
Case 2
Select Case Len(strUnPackData)
Case 1
strTempData = strTempData & strUnPackData
intUnPackOK = 3
Case 2
strTempData = strTempData & strUnPackData
UnPackProcess
Case Else
'数据错误
intUnPackOK = -1
End Select
Case 3
strTempData = strTempData & Left(strUnPackData, 1)
UnPackProcess
Case Else
'数据错误
intUnPackOK = -2
End Select
End Sub
' ================================================
' 功能: 从一个数据包中卸载协议
' ================================================
Sub UnPackProcess()
intUnPackOK = -1
If Right(strTempData, 2) = strCheckSum(Left(strTempData, Len(strTempData) - 2)) Then
If Mid$(strTempData, 8, 1) = STX Then
strDevAddress = Mid$(strTempData, 2, 3)
strSpsAddress = Mid$(strTempData, 5, 3)
strUnPackedData = Mid$(strTempData, 9, Len(strTempData) - 11)
intUnPackOK = 99
End If
End If
End Sub
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form IMS
Caption = "IMS Emluator"
ClientHeight = 3585
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
Icon = "IMSTest.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3585
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtOut
Height = 315
Left = 60
Locked = -1 'True
TabIndex = 19
Top = 3240
Width = 4545
End
Begin MSCommLib.MSComm comIMS
Left = 3600
Top = -30
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = -1 'True
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
Height = 375
Left = 3540
TabIndex = 18
Top = 2700
Width = 1035
End
Begin VB.Timer timIMS
Enabled = 0 'False
Interval = 1000
Left = 4320
Top = 30
End
Begin VB.CommandButton cmdStop
Caption = "停 止"
Height = 375
Left = 3540
TabIndex = 2
Top = 780
Width = 1035
End
Begin VB.CommandButton cmdBegin
Caption = "开 始"
Height = 375
Left = 3540
TabIndex = 1
Top = 270
Width = 1035
End
Begin VB.Frame IMSCtr
Caption = "IMS : "
ForeColor = &H00FF00FF&
Height = 2925
Left = 120
TabIndex = 0
Top = 150
Width = 3255
Begin VB.CommandButton cmdIMS
Caption = "Enter"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 990
TabIndex = 6
Top = 2430
Width = 1275
End
Begin VB.TextBox txt820
Alignment = 1 'Right Justify
BeginProperty Font
Name = "Times New Roman"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 270
MultiLine = -1 'True
TabIndex = 5
Top = 360
Width = 1365
End
Begin VB.CommandButton cmdLast
Caption = "<"
Height = 285
Left = 60
TabIndex = 4
Top = 2550
Width = 315
End
Begin VB.CommandButton cmdNext
Caption = ">"
Height = 285
Left = 2880
TabIndex = 3
Top = 2580
Width = 315
End
Begin VB.Label lbl827
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 17
Top = 2160
Width = 1275
End
Begin VB.Label lbl826
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 16
Top = 1980
Width = 1275
End
Begin VB.Label lbl825
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 15
Top = 1800
Width = 1275
End
Begin VB.Label lbl824
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 255
Left = 330
TabIndex = 14
Top = 1620
Width = 1275
End
Begin VB.Label lbl823
Alignment = 1 'Right Justify
Caption = "Label1"
Height = 285
Left = 390
TabIndex = 13
Top = 1380
Width = 1215
End
Begin VB.Label lbl822
Alignment = 1 'Right Justify
Height = 315
Left = 330
TabIndex = 12
Top = 1170
Width = 1275
End
Begin VB.Label lbl903
Alignment = 1 'Right Justify
Caption = "er"
Height = 285
Left = 2100
TabIndex = 11
Top = 1140
Width = 885
End
Begin VB.Label lbl902
Alignment = 1 'Right Justify
Caption = "er"
Height = 285
Left = 2130
TabIndex = 10
Top = 930
Width = 855
End
Begin VB.Label lblETime
Height = 285
Left = 2100
TabIndex = 9
Top = 540
Width = 975
End
Begin VB.Label lblSTime
Height = 315
Left = 2100
TabIndex = 8
Top = 300
Width = 1065
End
Begin VB.Label lbl821
Alignment = 1 'Right Justify
BeginProperty Font
Name = "Times New Roman"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 270
TabIndex = 7
Top = 810
Width = 1305
End
End
Begin VB.Line Line1
X1 = 0
X2 = 4680
Y1 = 3150
Y2 = 3150
End
End
Attribute VB_Name = "IMS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const DeviceNumber = 11
Dim IMSData(DeviceNumber) As IMSType
Dim intCtrPoint As Integer
Dim intUnPackOK As Integer
Dim strUnPackData As String
Dim strTempData As String
Dim strUnPackedData As String
Dim strSpsAddress As String
Dim strDevAddress As String
Private SOH As String * 1
Private STX As String * 1
Private ETX As String * 1
Private ACK As String * 1
Private NAK As String * 1
Sub InitSystem()
Dim intPoint As Integer
SOH = Chr$(&H1)
STX = Chr$(&H2)
ETX = Chr$(&H3)
ACK = Chr$(&H6)
NAK = Chr$(&H15)
intCtrPoint = 0
IMSCtr.Caption = "IMS : " & Format(intCtrPoint + 1, "0#")
cmdStop.Enabled = False
For intPoint = 0 To DeviceNumber Step 1
IMSData(intPoint).C806 = 0
IMSData(intPoint).C820 = 1000
IMSData(intPoint).C821 = 0
IMSData(intPoint).C822 = 0
IMSData(intPoint).C823 = 0
IMSData(intPoint).C824 = 0
IMSData(intPoint).C825 = 25.54
IMSData(intPoint).C826 = 154.38
IMSData(intPoint).C827 = 19.56
IMSData(intPoint).C828 = Now
IMSData(intPoint).C840 = 0
IMSData(intPoint).C902 = 0
IMSData(intPoint).C903 = 0
IMSData(intPoint).C904 = Now
IMSData(intPoint).C905 = Now
IMSData(intPoint).C906 = 0
Next intPoint
txt820.Text = IMSData(intCtrPoint).C820
ViewIMS
comIMS.InputLen = 0
comIMS.PortOpen = True
intUnPackOK = 0
End Sub
Sub ViewIMS()
lbl821.Caption = Format(IMSData(intCtrPoint).C821, "######.#0")
lbl822.Caption = Format(IMSData(intCtrPoint).C822, "######.#0")
lbl823.Caption = Format(IMSData(intCtrPoint).C823, "######.#0")
lbl824.Caption = Format(IMSData(intCtrPoint).C824, "######.#0")
lbl825.Caption = Format(IMSData(intCtrPoint).C825, "######.#0")
lbl826.Caption = Format(IMSData(intCtrPoint).C826, "######.#0")
lbl827.Caption = Format(IMSData(intCtrPoint).C827, "######.#0")
lbl902.Caption = Format(IMSData(intCtrPoint).C902, "######.#0")
lbl903.Caption = Format(IMSData(intCtrPoint).C903, "######.#0")
lblSTime.Caption = Format(IMSData(intCtrPoint).C905, "hh:mm:ss")
lblETime.Caption = Format(IMSData(intCtrPoint).C904, "hh:mm:ss")
End Sub
Private Sub cmdBegin_Click()
timIMS.Enabled = True
cmdBegin.Enabled = False
cmdStop.Enabled = True
End Sub
Private Sub cmdExit_Click()
If comIMS.PortOpen = True Then
comIMS.PortOpen = False
End If
Unload Me
End Sub
Private Sub cmdIMS_Click()
If IMSData(intCtrPoint).C806 = 0 Then
If IsNumeric(txt820.Text) Then
IMSData(intCtrPoint).C820 = CLng(txt820.Text)
End If
IMSData(intCtrPoint).C821 = IMSData(intCtrPoint).C820
IMSData(intCtrPoint).C806 = 99
IMSData(intCtrPoint).C905 = Now
ViewIMS
End If
End Sub
Private Sub cmdLast_Click()
If IsNumeric(txt820.Text) Then
If IMSData(intCtrPoint).C806 = 0 Then
IMSData(intCtrPoint).C820 = CLng(txt820.Text)
End If
End If
intCtrPoint = intCtrPoint - 1
If intCtrPoint < 0 Then intCtrPoint = DeviceNumber
IMSCtr.Caption = "IMS : " & Format(intCtrPoint + 1, "0#")
txt820.Text = IMSData(intCtrPoint).C820
ViewIMS
End Sub
Private Sub cmdNext_Click()
If IsNumeric(txt820.Text) Then
If IMSData(intCtrPoint).C806 = 0 Then
IMSData(intCtrPoint).C820 = CLng(txt820.Text)
End If
End If
intCtrPoint = intCtrPoint + 1
If intCtrPoint > DeviceNumber Then intCtrPoint = 0
IMSCtr.Caption = "IMS : " & Format(intCtrPoint + 1, "0#")
txt820.Text = IMSData(intCtrPoint).C820
ViewIMS
End Sub
Private Sub cmdStop_Click()
timIMS.Enabled = False
cmdBegin.Enabled = True
cmdStop.Enabled = False
End Sub
Private Sub Form_Load()
InitSystem
End Sub
Private Sub timIMS_Timer()
Dim intPoint As Integer
For intPoint = 0 To DeviceNumber Step 1
If IMSData(intPoint).C806 > 0 Then
IMSData(intPoint).C821 = IMSData(intPoint).C821 - Rnd * 10
If IMSData(intPoint).C821 <= 0 Then
IMSData(intPoint).C902 = IMSData(intPoint).C820
IMSData(intPoint).C903 = IMSData(intPoint).C820 * 1.00024
IMSData(intPoint).C820 = 0
IMSData(intPoint).C822 = 0
IMSData(intPoint).C823 = 0
IMSData(intPoint).C824 = 0
If intPoint = intCtrPoint Then txt820.Text = 0
IMSData(intPoint).C904 = Now
IMSData(intPoint).C821 = 0
IMSData(intPoint).C806 = 0
Else
IMSData(intPoint).C822 = IMSData(intPoint).C820 - IMSData(intPoint).C821
IMSData(intPoint).C823 = IMSData(intPoint).C822 * 1.00024
IMSData(intPoint).C824 = Rnd * 10
End If
End If
IMSData(intPoint).C825 = IMSData(intPoint).C825 + Rnd - 0.5
IMSData(intPoint).C826 = IMSData(intPoint).C826 + Rnd - 0.5
IMSData(intPoint).C827 = IMSData(intPoint).C827 + Rnd - 0.5
Next intPoint
ViewIMS
PrcRequest
End Sub
Sub PrcRequest()
If comIMS.InBufferCount > 0 Then
strUnPackData = comIMS.Input
ProUnPackData
If intUnPackOK = 99 Then
intUnPackOK = 0
Answer
ElseIf intUnPackOK < 0 Then
intUnPackOK = 0
End If
End If
End Sub
Sub Answer()
Dim strTemp As String
Dim intTemp As Integer
Dim intDataBegin As Integer
Dim intDataEnd As Integer
Dim intCmdType As Integer
If Left(strUnPackedData, 1) = "R" Then
intDataBegin = 2
strTemp = SOH & strSpsAddress & strDevAddress & STX
Do
intDataEnd = InStr(intDataBegin, strUnPackedData, ";")
If intDataEnd > 0 Then
intCmdType = CInt(Mid(strUnPackedData, intDataBegin, intDataEnd - intDataBegin))
intDataBegin = intDataEnd + 1
Else
intCmdType = CInt(Right(strUnPackedData, Len(strUnPackedData) - intDataBegin + 1))
End If
If intCmdType = 806 Then
strTemp = strTemp & "806=" & Format(IMSData(CInt(strDevAddress - 1)).C806, "#0")
End If
If intCmdType = 820 Then
strTemp = strTemp & "820=" & Format(IMSData(CInt(strDevAddress - 1)).C820, "0#####")
End If
If intCmdType = 821 Then
strTemp = strTemp & "821=" & Format(IMSData(CInt(strDevAddress - 1)).C821, "0#####.#0")
End If
If intCmdType = 822 Then
strTemp = strTemp & "822=" & Format(IMSData(CInt(strDevAddress - 1)).C822, "0#####.#0")
End If
If intCmdType = 823 Then
strTemp = strTemp & "823=" & Format(IMSData(CInt(strDevAddress - 1)).C823, "0#####.#0")
End If
If intCmdType = 824 Then
strTemp = strTemp & "824=" & Format(IMSData(CInt(strDevAddress - 1)).C824, "0####")
End If
If intCmdType = 825 Then
strTemp = strTemp & "825=" & Format(IMSData(CInt(strDevAddress - 1)).C825, "0##.#0")
End If
If intCmdType = 826 Then
strTemp = strTemp & "826=" & Format(IMSData(CInt(strDevAddress - 1)).C826, "0###.#0")
End If
If intCmdType = 827 Then
strTemp = strTemp & "827=" & Format(IMSData(CInt(strDevAddress - 1)).C827, "0###.#")
End If
If intCmdType = 828 Then
strTemp = strTemp & "828=" & Format(IMSData(CInt(strDevAddress - 1)).C828, "hh:mm:ss")
End If
If intCmdType = 840 Then
strTemp = strTemp & "840=" & Format(IMSData(CInt(strDevAddress - 1)).C840, "0#######")
End If
If intCmdType = 902 Then
strTemp = strTemp & "902=" & Format(IMSData(CInt(strDevAddress - 1)).C902, "0#####.#0")
End If
If intCmdType = 903 Then
strTemp = strTemp & "903=" & Format(IMSData(CInt(strDevAddress - 1)).C903, "0#####.#0")
End If
If intCmdType = 904 Then
strTemp = strTemp & "904=" & Format(IMSData(CInt(strDevAddress - 1)).C904, "hh:mm")
End If
If intCmdType = 905 Then
strTemp = strTemp & "905=" & Format(IMSData(CInt(strDevAddress - 1)).C905, "hh:mm")
End If
If intCmdType = 906 Then
strTemp = strTemp & "906=" & Format(IMSData(CInt(strDevAddress - 1)).C906, "0#######")
End If
If intDataEnd > 0 Then
strTemp = strTemp & ";"
Else
strTemp = strTemp & ETX
End If
Loop While (intDataEnd > 0)
strTemp = strTemp & strCheckSum(strTemp)
comIMS.Output = strTemp
txtOut.Text = ""
For intTemp = 1 To Len(strTemp) Step 1
txtOut.Text = txtOut.Text & Hex(Asc(Mid(strTemp, intTemp, 1))) & ";"
Next intTemp
End If
End Sub
' ================================================
' 功能: 获取数据效验值
' ================================================
Private Function strCheckSum(strData As String) As String
Dim intTemp, intSum As Integer
intSum = 0
For intTemp = 1 To Len(strData) Step 1
intSum = intSum + Asc(Mid(strData, intTemp, 1))
Next intTemp
strCheckSum = Hex((intSum / &H10) Mod &H10) & Hex(intSum Mod &H10)
End Function
' ================================================
' 功能: 处理卸载协议数据
' ================================================
Sub ProUnPackData()
Dim intEndPoint As Integer
intEndPoint = 0
Select Case intUnPackOK
Case 0
If Left(strUnPackData, 1) = SOH Then
intEndPoint = InStr(1, strUnPackData, ETX)
If (intEndPoint < 1) Then
strTempData = strUnPackData
intUnPackOK = 1
Else
Select Case Len(strUnPackData)
Case intEndPoint
strTempData = strUnPackData
intUnPackOK = 2
Case intEndPoint + 1
strTempData = strUnPackData
intUnPackOK = 3
Case intEndPoint + 2
strTempData = strUnPackData
UnPackProcess
Case Else
'数据错误
intUnPackOK = -1
End Select
End If
Else
'数据错误
intUnPackOK = -1
End If
Case 1
intEndPoint = InStr(1, strUnPackData, ETX)
If (intEndPoint < 1) Then
strTempData = strTempData & strUnPackData
Else
Select Case Len(strUnPackData)
Case intEndPoint
strTempData = strTempData & strUnPackData
intUnPackOK = 2
Case intEndPoint + 1
strTempData = strTempData & strUnPackData
intUnPackOK = 3
Case intEndPoint + 2
strTempData = strTempData & strUnPackData
UnPackProcess
Case Else
'数据错误
intUnPackOK = -1
End Select
End If
Case 2
Select Case Len(strUnPackData)
Case 1
strTempData = strTempData & strUnPackData
intUnPackOK = 3
Case 2
strTempData = strTempData & strUnPackData
UnPackProcess
Case Else
'数据错误
intUnPackOK = -1
End Select
Case 3
strTempData = strTempData & Left(strUnPackData, 1)
UnPackProcess
Case Else
'数据错误
intUnPackOK = -2
End Select
End Sub
' ================================================
' 功能: 从一个数据包中卸载协议
' ================================================
Sub UnPackProcess()
intUnPackOK = -1
If Right(strTempData, 2) = strCheckSum(Left(strTempData, Len(strTempData) - 2)) Then
If Mid$(strTempData, 8, 1) = STX Then
strDevAddress = Mid$(strTempData, 2, 3)
strSpsAddress = Mid$(strTempData, 5, 3)
strUnPackedData = Mid$(strTempData, 9, Len(strTempData) - 11)
intUnPackOK = 99
End If
End If
End Sub
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
Attribute VB_Name = "mdlIMSTest"
Option Explicit
Type IMSType
C806 As Integer
C820 As Single
C821 As Single
C822 As Single
C823 As Single
C824 As Single
C825 As Single
C826 As Single
C827 As Single
C828 As Date
C840 As Single
C902 As Single
C903 As Single
C904 As Date
C905 As Date
C906 As Single
End Type
Option Explicit
Type IMSType
C806 As Integer
C820 As Single
C821 As Single
C822 As Single
C823 As Single
C824 As Single
C825 As Single
C826 As Single
C827 As Single
C828 As Date
C840 As Single
C902 As Single
C903 As Single
C904 As Date
C905 As Date
C906 As Single
End Type
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
收到,Working……
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
yzhshi:
用不用我把vb程序给你寄去？
用不用我把vb程序给你寄去？
Y
YB_unique
Unregistered / Unconfirmed
GUEST, unregistred user!
原来用的 MSComm 控件，自己写一个得了吧！
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
今天很忙，等明天中午给你写出来吧。
我不希望要分，只是帮忙，记住，我不要分。
另外希望其他朋友也写一下，不要死守我这一颗树。
OK？！
我不希望要分，只是帮忙，记住，我不要分。
另外希望其他朋友也写一下，不要死守我这一颗树。
OK？！
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
怎么没人帮忙？
我
我爱delphi
Unregistered / Unconfirmed
GUEST, unregistred user!
没什么难的吧~!
MSComm控件在Delphi中可以用.
Delphi写出来的代码和VB的差不多.[
]
MSComm控件在Delphi中可以用.
Delphi写出来的代码和VB的差不多.[
]
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
太难了，太长了。
我的计算机上没有安装VB，害的我的mscomm32.ocx无法在Delphi下运行！呵呵。
痛苦！
我已经给你翻译了一个frm文件，呵呵，现在是中西结合，半Delphi，半VB，很多函数都没有翻译。
只是简单的语法转化，呵呵。
明天吧，我累了，要回去了……
我的计算机上没有安装VB，害的我的mscomm32.ocx无法在Delphi下运行！呵呵。
痛苦！
我已经给你翻译了一个frm文件，呵呵，现在是中西结合，半Delphi，半VB，很多函数都没有翻译。
只是简单的语法转化，呵呵。
明天吧，我累了，要回去了……
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
翻译一：
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmTest
Caption = "ComTest"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtAdd
Height = 405
Left = 210
TabIndex = 4
Text = "1"
Top = 240
Width = 615
End
Begin VB.Timer timIMS
Interval = 1000
Left = 4050
Top = 1140
End
Begin MSCommLib.MSComm comIMS
Left = 3930
Top = 1770
_ExtentX = 1005
_ExtentY = 1005
_Version = 327680
DTREnable = -1 'True
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
Height = 375
Left = 3870
TabIndex = 3
Top = 2430
Width = 705
End
Begin VB.CommandButton cmdSend
Caption = "Send"
Height = 375
Left = 3900
TabIndex = 2
Top = 240
Width = 705
End
Begin VB.TextBox txtOut
Height = 405
Left = 900
TabIndex = 1
Top = 240
Width = 2805
End
Begin VB.TextBox txtIn
Height = 1935
Left = 210
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 870
Width = 3525
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private SOH As String * 1
Private STX As String * 1
Private ETX As String * 1
Private ACK As String * 1
Private NAK As String * 1
Private Sub cmdExit_Click()
If comIMS.PortOpen = True Then
comIMS.PortOpen = False
End If
Unload Me
End Sub
Private Sub cmdSend_Click()
Dim strTemp As String
strTemp = SOH & Format(txtAdd.Text, "0##") & "101" & STX & txtOut.Text & ETX
strTemp = strTemp & strCheckSum(strTemp)
comIMS.Output = strTemp
End Sub
' ================================================
' 功能: 获取数据效验值
' ================================================
Private Function strCheckSum(strData As String) As String
Dim intTemp, intSum As Integer
intSum = 0
For intTemp = 1 To Len(strData) Step 1
intSum = intSum + Asc(Mid(strData, intTemp, 1)) //这句是什么意思？
Next intTemp
strCheckSum = Hex((intSum / &H10) Mod &H10) & Hex(intSum Mod &H10) //这句是什么意思？
End Function
Private Sub Form_Load()
SOH = Chr$(&H1)
STX = Chr$(&H2)
ETX = Chr$(&H3)
ACK = Chr$(&H6)
NAK = Chr$(&H15)
comIMS.InputLen = 0
comIMS.PortOpen = True
End Sub
Private Sub timIMS_Timer()
Dim strTemp As String
Dim intTemp As Integer
If comIMS.InBufferCount > 0 Then
strTemp = comIMS.Input
For intTemp = 1 To Len(strTemp) Step 1
txtIn.Text = txtIn.Text & Hex(Asc(Mid(strTemp, intTemp, 1))) & ";" //这句是什么意思？
Next intTemp
End If
End Sub
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmTest
Caption = "ComTest"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtAdd
Height = 405
Left = 210
TabIndex = 4
Text = "1"
Top = 240
Width = 615
End
Begin VB.Timer timIMS
Interval = 1000
Left = 4050
Top = 1140
End
Begin MSCommLib.MSComm comIMS
Left = 3930
Top = 1770
_ExtentX = 1005
_ExtentY = 1005
_Version = 327680
DTREnable = -1 'True
End
Begin VB.CommandButton cmdExit
Caption = "Exit"
Height = 375
Left = 3870
TabIndex = 3
Top = 2430
Width = 705
End
Begin VB.CommandButton cmdSend
Caption = "Send"
Height = 375
Left = 3900
TabIndex = 2
Top = 240
Width = 705
End
Begin VB.TextBox txtOut
Height = 405
Left = 900
TabIndex = 1
Top = 240
Width = 2805
End
Begin VB.TextBox txtIn
Height = 1935
Left = 210
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 870
Width = 3525
End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private SOH As String * 1
Private STX As String * 1
Private ETX As String * 1
Private ACK As String * 1
Private NAK As String * 1
Private Sub cmdExit_Click()
If comIMS.PortOpen = True Then
comIMS.PortOpen = False
End If
Unload Me
End Sub
Private Sub cmdSend_Click()
Dim strTemp As String
strTemp = SOH & Format(txtAdd.Text, "0##") & "101" & STX & txtOut.Text & ETX
strTemp = strTemp & strCheckSum(strTemp)
comIMS.Output = strTemp
End Sub
' ================================================
' 功能: 获取数据效验值
' ================================================
Private Function strCheckSum(strData As String) As String
Dim intTemp, intSum As Integer
intSum = 0
For intTemp = 1 To Len(strData) Step 1
intSum = intSum + Asc(Mid(strData, intTemp, 1)) //这句是什么意思？
Next intTemp
strCheckSum = Hex((intSum / &H10) Mod &H10) & Hex(intSum Mod &H10) //这句是什么意思？
End Function
Private Sub Form_Load()
SOH = Chr$(&H1)
STX = Chr$(&H2)
ETX = Chr$(&H3)
ACK = Chr$(&H6)
NAK = Chr$(&H15)
comIMS.InputLen = 0
comIMS.PortOpen = True
End Sub
Private Sub timIMS_Timer()
Dim strTemp As String
Dim intTemp As Integer
If comIMS.InBufferCount > 0 Then
strTemp = comIMS.Input
For intTemp = 1 To Len(strTemp) Step 1
txtIn.Text = txtIn.Text & Hex(Asc(Mid(strTemp, intTemp, 1))) & ";" //这句是什么意思？
Next intTemp
End If
End Sub
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
加油
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
不难，你就帮忙吧。用spcomm吧。
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
cmdSend: TButton;
cmdExit: TButton;
txtIn: TEdit;
txtAdd: TEdit;
txtOut: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cmdSendClick(Sender: TObject);
procedure cmdExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
SOH, STX, ETX, ACK, NAK: String;
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
SOH := Chr($1);
STX := Chr($2);
ETX := Chr($3);
ACK := Chr($6);
NAK := Chr($15);
comIMS.InputLen := 0;
comIMS.PortOpen := True;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmdExitClick(Sender: TObject);
begin
If comIMS.PortOpen = True Then
comIMS.PortOpen := False;
Close;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmdSendClick(Sender: TObject);
var
strTemp: String;
strTemp2: String;
begin
//Format(txtAdd.Text, '0##')没找到对应格式的，直接使用循环来完成类似功能，不知道是否正确
case length(txtAdd.Text) of
0: strTemp2 := '000';
1: strTemp2 := '00' + txtAdd.Text;
2: strTemp2 := '0' + txtAdd.Text;
else
strTemp2 := txtAdd.Text;
end;
strTemp := SOH + strTemp2 + '101' + STX + txtOut.Text + ETX;
strTemp := strTemp + strCheckSum(strTemp);
comIMS.Output := strTemp;
end;
{------------------------------------------------------------------------------}
procedure TForm1.Timer1Timer(Sender: TObject);
var
strTemp: String;
intTemp: Integer;
StrTemp2: String;
begin
If comIMS.InBufferCount > 0 then
begin
strTemp := comIMS.Input;
for intTemp := 1 to Length(strTemp) do
begin
StrTemp2 := Copy(strTemp, intTemp, 1);
txtIn.Text := txtIn.Text + IntToHex(Ord(StrTemp2[1]), 1) + ';'; //取得串口数据，转换成Asc码增加到txtIn里面。
end;
end;
end;
{------------------------------------------------------------------------------}
{ ================================================
功能: 获取数据效验值
================================================}
function strCheckSum(strData: String): String;
var
intTemp, intSum: Integer;
strTemp: String;
begin
intSum := 0;
for intTemp := 1 to Length(strData) do
begin
strTemp := Copy(strData, intTemp, 1);
intSum := intSum + ord(strTemp[1]); //照旧添加Asc码
end;
strCheckSum := IntToHex(((intSum div $10) Mod $10), 1) + IntToHex((intSum Mod $10), 1); //可能有问题，取余和取整在VB和Delphi里面弄混了
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
cmdSend: TButton;
cmdExit: TButton;
txtIn: TEdit;
txtAdd: TEdit;
txtOut: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cmdSendClick(Sender: TObject);
procedure cmdExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
SOH, STX, ETX, ACK, NAK: String;
{------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
SOH := Chr($1);
STX := Chr($2);
ETX := Chr($3);
ACK := Chr($6);
NAK := Chr($15);
comIMS.InputLen := 0;
comIMS.PortOpen := True;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmdExitClick(Sender: TObject);
begin
If comIMS.PortOpen = True Then
comIMS.PortOpen := False;
Close;
end;
{------------------------------------------------------------------------------}
procedure TForm1.cmdSendClick(Sender: TObject);
var
strTemp: String;
strTemp2: String;
begin
//Format(txtAdd.Text, '0##')没找到对应格式的，直接使用循环来完成类似功能，不知道是否正确
case length(txtAdd.Text) of
0: strTemp2 := '000';
1: strTemp2 := '00' + txtAdd.Text;
2: strTemp2 := '0' + txtAdd.Text;
else
strTemp2 := txtAdd.Text;
end;
strTemp := SOH + strTemp2 + '101' + STX + txtOut.Text + ETX;
strTemp := strTemp + strCheckSum(strTemp);
comIMS.Output := strTemp;
end;
{------------------------------------------------------------------------------}
procedure TForm1.Timer1Timer(Sender: TObject);
var
strTemp: String;
intTemp: Integer;
StrTemp2: String;
begin
If comIMS.InBufferCount > 0 then
begin
strTemp := comIMS.Input;
for intTemp := 1 to Length(strTemp) do
begin
StrTemp2 := Copy(strTemp, intTemp, 1);
txtIn.Text := txtIn.Text + IntToHex(Ord(StrTemp2[1]), 1) + ';'; //取得串口数据，转换成Asc码增加到txtIn里面。
end;
end;
end;
{------------------------------------------------------------------------------}
{ ================================================
功能: 获取数据效验值
================================================}
function strCheckSum(strData: String): String;
var
intTemp, intSum: Integer;
strTemp: String;
begin
intSum := 0;
for intTemp := 1 to Length(strData) do
begin
strTemp := Copy(strData, intTemp, 1);
intSum := intSum + ord(strTemp[1]); //照旧添加Asc码
end;
strCheckSum := IntToHex(((intSum div $10) Mod $10), 1) + IntToHex((intSum Mod $10), 1); //可能有问题，取余和取整在VB和Delphi里面弄混了
end;
end.
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
第一部分翻译完成，基本调试通过，不过，记住，我计算机上没有安装Mscomm32控件！
也没有硬件，所以不能确认是正确的，对于心虚的地方已经加了注释。[
]
下面开始第二部分。[8D]
也没有硬件，所以不能确认是正确的，对于心虚的地方已经加了注释。[
]下面开始第二部分。[8D]
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
第三部分简单就先来吧，呵呵，软的基本都肯完了，剩下最硬的了。[][][]
Type
IMSType = record
C806: Integer;
C820: Single;
C821: Single;
C822: Single;
C823: Single;
C824: Single;
C825: Single;
C826: Single;
C827: Single;
C828: TDateTime;
C840: Single;
C902: Single;
C903: Single;
C904: TDateTime;
C905: TDateTime;
C906: Single;
end;
][][]Type
IMSType = record
C806: Integer;
C820: Single;
C821: Single;
C822: Single;
C823: Single;
C824: Single;
C825: Single;
C826: Single;
C827: Single;
C828: TDateTime;
C840: Single;
C902: Single;
C903: Single;
C904: TDateTime;
C905: TDateTime;
C906: Single;
end;
Z
zhaohai9
Unregistered / Unconfirmed
GUEST, unregistred user!
校验处，它是怎么校验的？没有mscom32,可以用spcomm啊？我已经把vb代码给你寄去了。
Y
yzhshi
Unregistered / Unconfirmed
GUEST, unregistred user!
unit unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
cmdStop: TButton;
cmd_Next: TButton;
cmd_Last: TButton;
cmd_IMS: TButton;
cmd_Exit: TButton;
cmdBegin: TButton;
IMSCtr: TLabel;
txt820: TEdit;
lbl821: TLabel;
lbl822: TLabel;
lbl823: TLabel;
lbl824: TLabel;
lbl825: TLabel;
lbl826: TLabel;
lbl827: TLabel;
lbl902: TLabel;
lbl903: TLabel;
lblSTime: TLabel;
lblETime: TLabel;
timIMS: TTimer;
txtOut: TEdit;
procedure FormCreate(Sender: TObject);
procedure cmdStopClick(Sender: TObject);
procedure cmd_NextClick(Sender: TObject);
procedure cmd_LastClick(Sender: TObject);
procedure cmd_IMSClick(Sender: TObject);
procedure cmd_ExitClick(Sender: TObject);
procedure cmdBeginClick(Sender: TObject);
procedure timIMSTimer(Sender: TObject);
private
{ Private declarations }
procedure InitSystem;
procedure ViewIMS;
procedure PrcRequest;
procedure ProUnPackData;
procedure Answer;
procedure UnPackProcess;
public
{ Public declarations }
end;
type
IMSType = record
C806: Integer;
C820: Single;
C821: Single;
C822: Single;
C823: Single;
C824: Single;
C825: Single;
C826: Single;
C827: Single;
C828: TDateTime;
C840: Single;
C902: Single;
C903: Single;
C904: TDateTime;
C905: TDateTime;
C906: Single;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
DeviceNumber = 11;
var
IMSData: array[0..DeviceNumber] of IMSType;
intCtrPoint: Integer;
intUnPackOK: Integer;
strUnPackData: string;
strTempData: string;
strUnPackedData: string;
strSpsAddress: string;
strDevAddress: string;
SOH, STX, ETX, ACK, NAK: string;
procedure TForm1.InitSystem;
var
intPoint: Integer;
StrTemp: string;
begin
SOH := Chr($1);
STX := Chr($2);
ETX := Chr($3);
ACK := Chr($6);
NAK := Chr($15);
intCtrPoint := 0;
//格式化这句话不会翻译，代替Format(intCtrPoint + 1, "0#")
case length(IntToStr(intCtrPoint + 1)) of
0: StrTemp := '0' + IntToStr(intCtrPoint + 1);
else
StrTemp := IntToStr(intCtrPoint + 1);
end;
IMSCtr.Caption := 'IMS: ' + StrTemp;
cmdStop.Enabled := False;
for intPoint := 0 to DeviceNumber do
begin
IMSData[intPoint].C806 := 0;
IMSData[intPoint].C820 := 1000;
IMSData[intPoint].C821 := 0;
IMSData[intPoint].C822 := 0;
IMSData[intPoint].C823 := 0;
IMSData[intPoint].C824 := 0;
IMSData[intPoint].C825 := 25.54;
IMSData[intPoint].C826 := 154.38;
IMSData[intPoint].C827 := 19.56;
IMSData[intPoint].C828 := Now;
IMSData[intPoint].C840 := 0;
IMSData[intPoint].C902 := 0;
IMSData[intPoint].C903 := 0;
IMSData[intPoint].C904 := Now;
IMSData[intPoint].C905 := Now;
IMSData[intPoint].C906 := 0;
end;
txt820.Text := FloatToStr(IMSData[intCtrPoint].C820);
ViewIMS;
comIMS.InputLen := 0;
comIMS.PortOpen := True;
intUnPackOK := 0;
end;
procedure TForm1.ViewIMS;
begin
{这块不翻译了，专门的Format格式忘记了，让我都使用循环太累了，
lbl821.Caption := Format(IMSData[intCtrPoint].C821, '######.#0 ');
lbl822.Caption := Format(IMSData[intCtrPoint].C822, '######.#0 ');
lbl823.Caption := Format(IMSData[intCtrPoint].C823, '######.#0 ');
lbl824.Caption := Format(IMSData[intCtrPoint].C824, '######.#0 ');
lbl825.Caption := Format(IMSData[intCtrPoint].C825, '######.#0 ');
lbl826.Caption := Format(IMSData[intCtrPoint].C826, '######.#0 ');
lbl827.Caption := Format(IMSData[intCtrPoint].C827, '######.#0 ');
lbl902.Caption := Format(IMSData[intCtrPoint].C902, '######.#0 ');
lbl903.Caption := Format(IMSData[intCtrPoint).C903, '######.#0 ');
lblSTime.Caption := Format(IMSData[intCtrPoint].C905, 'hh: mm: ss');
lblETime.Caption := Format(IMSData[intCtrPoint].C904, 'hh: mm: ss');}
end;
procedure TForm1.cmdBeginClick(Sender: TObject);
begin
timIMS.Enabled := True;
cmdBegin.Enabled := False;
cmdStop.Enabled := True;
end;
procedure TForm1.cmd_ExitClick(Sender: TObject);
begin
if comIMS.PortOpen = True then
comIMS.PortOpen := False;
Close;
end;
procedure TForm1.cmd_IMSClick(Sender: TObject);
begin
if IMSData[intCtrPoint].C806 = 0 then
begin
try
IMSData[intCtrPoint].C820 := StrToFloat(txt820.Text);
except
end;
IMSData[intCtrPoint].C821 := IMSData[intCtrPoint].C820;
IMSData[intCtrPoint].C806 := 99;
IMSData[intCtrPoint].C905 := Now;
ViewIMS;
end;
end;
procedure TForm1.cmd_LastClick(Sender: TObject);
begin
try
if IMSData[intCtrPoint].C806 = 0 then
IMSData[intCtrPoint].C820 := StrToFloat(txt820.Text);
except
end;
intCtrPoint := intCtrPoint - 1;
if intCtrPoint < 0 then intCtrPoint := DeviceNumber;
//IMSCtr.Caption := 'IMS : ' + Format(intCtrPoint + 1, "0#");不翻译了
txt820.Text := FloatToStr(IMSData[intCtrPoint].C820);
ViewIMS;
end;
procedure TForm1.cmd_NextClick(Sender: TObject);
begin
try
if IMSData[intCtrPoint].C806 = 0 then
IMSData[intCtrPoint].C820 := StrToFloat(txt820.Text);
except
end;
intCtrPoint := intCtrPoint + 1;
if intCtrPoint > DeviceNumber then intCtrPoint := 0;
//IMSCtr.Caption := 'IMS : ' + Format(intCtrPoint + 1, '0#');不翻译了
txt820.Text := FloatToStr(IMSData[intCtrPoint].C820);
ViewIMS;
end;
procedure TForm1.cmdStopClick(Sender: TObject);
begin
timIMS.Enabled := False;
cmdBegin.Enabled := True;
cmdStop.Enabled := False;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitSystem;
end;
procedure TForm1.timIMSTimer(Sender: TObject);
var
intPoint: Integer;
begin
for intPoint := 0 to DeviceNumber do
begin
if IMSData[intPoint].C806 > 0 then
begin
IMSData[intPoint].C821 := IMSData[intPoint].C821 - Random * 10; //Random范围？
if IMSData[intPoint].C821 <= 0 then
begin
IMSData[intPoint].C902 := IMSData[intPoint].C820;
IMSData[intPoint].C903 := IMSData[intPoint].C820 * 1.00024;
IMSData[intPoint].C820 := 0;
IMSData[intPoint].C822 := 0;
IMSData[intPoint].C823 := 0;
IMSData[intPoint].C824 := 0;
if intPoint = intCtrPoint then txt820.Text := '0';
IMSData[intPoint].C904 := Now;
IMSData[intPoint].C821 := 0;
IMSData[intPoint].C806 := 0;
end
else
begin
IMSData[intPoint].C822 := IMSData[intPoint].C820 - IMSData[intPoint].C821;
IMSData[intPoint].C823 := IMSData[intPoint].C822 * 1.00024;
IMSData[intPoint].C824 := Random * 10; //范围？
end;
end;
IMSData[intPoint].C825 := IMSData[intPoint].C825 + Random - 0.5;
IMSData[intPoint].C826 := IMSData[intPoint].C826 + Random - 0.5;
IMSData[intPoint].C827 := IMSData[intPoint].C827 + Random - 0.5;
end;
ViewIMS;
PrcRequest;
end;
procedure TForm1.PrcRequest;
begin
if comIMS.InBufferCount > 0 then
begin
strUnPackData := comIMS.Input;
ProUnPackData;
if intUnPackOK = 99 then
begin
intUnPackOK := 0;
Answer;
end
else if intUnPackOK < 0 then
intUnPackOK := 0;
end;
end;
{ ================================================
功能: 获取数据效验值
================================================}
function strCheckSum(strData: string): string;
var
intTemp, intSum: Integer;
begin
intSum := 0;
for intTemp := 1 to Length(strData) do
intSum := intSum + ord(Copy(strData, intTemp, 1)[1]);
// 原文strCheckSum := Hex((intSum / $10) Mod $10)& Hex(intSum Mod $10);
strCheckSum := IntToHex(((intSum div $10) mod $10), 1) + IntToHex((intSum mod $10), 1); //可能有问题，取余和取整在VB和Delphi里面弄混了
end;
{ ================================================
功能: 处理卸载协议数据
================================================}
procedure TForm1.ProUnPackData;
var
intEndPoint: Integer;
begin
intEndPoint := 0;
case intUnPackOK of
0:
begin
if Copy(strUnPackData, 1, 1) = SOH then
begin
// intEndPoint := InStr(1, strUnPackData, ETX);//不知道对应函数
if (intEndPoint < 1) then
begin
strTempData := strUnPackData;
intUnPackOK := 1;
end
else
begin
{If 代替了Case，因为Delphi的Case不支持变量}
if Length(strUnPackData) = intEndPoint then
begin
strTempData := strUnPackData;
intUnPackOK := 2;
end
else if Length(strUnPackData) = intEndPoint + 1 then
begin
strTempData := strUnPackData;
intUnPackOK := 3;
end
else if Length(strUnPackData) = intEndPoint + 2 then
begin
strTempData := strUnPackData;
UnPackProcess;
end
else
//数据错误
intUnPackOK := -1;
end;
end
else
//数据错误
intUnPackOK := -1
end;
1:
begin
// intEndPoint := InStr(1, strUnPackData, ETX);不知道对应函数
{If代替了case循环}
if (intEndPoint < 1) then
strTempData := strTempData + strUnPackData
else if Length(strUnPackData) = intEndPoint then
begin
strTempData := strTempData + strUnPackData;
intUnPackOK := 2;
end
else if Length(strUnPackData) = intEndPoint + 1 then
begin
strTempData := strTempData + strUnPackData;
intUnPackOK := 3;
end
else if Length(strUnPackData) = intEndPoint + 2 then
begin
strTempData := strTempData + strUnPackData;
UnPackProcess;
end
else
//数据错误
intUnPackOK := -1
end;
2:
begin
case Length(strUnPackData) of
1:
begin
strTempData := strTempData + strUnPackData;
intUnPackOK := 3;
end;
2:
begin
strTempData := strTempData + strUnPackData;
UnPackProcess;
end;
else
intUnPackOK := -1;
end;
end;
end;
end;
{ ================================================
功能: 从一个数据包中卸载协议
================================================}
procedure TForm1.UnPackProcess;
var
Tmp_Str: string;
begin
intUnPackOK := -1;
if Copy(strTempData, length(strTempData) - 2, 2) =
strCheckSum(Copy(strTempData, 1, length(strTempData) - 2)) then
if Copy(strTempData, 8, 1) = STX then
begin
strDevAddress := copy(strTempData, 2, 3);
strSpsAddress := copy(strTempData, 5, 3);
strUnPackedData := copy(strTempData, 9, Length(strTempData) - 11);
intUnPackOK := 99;
end;
end;
procedure TForm1.Answer;
var
strTemp: string;
intTemp: Integer;
intDataBegin: Integer;
intDataEnd: Integer;
intCmdType: Integer;
begin
if Copy(strUnPackedData, 1, 1) = 'R' then
begin
intDataBegin := 2;
strTemp := SOH + strSpsAddress + strDevAddress + STX;
repeat
// intDataEnd := InStr(intDataBegin, strUnPackedData, "; ")不知道如何翻译
if intDataEnd > 0 then
begin
// intCmdType = CInt(Copy(strUnPackedData, intDataBegin, intDataEnd - intDataBegin));//不知道如何翻译
intDataBegin := intDataEnd + 1;
end
else
begin
// intCmdType := CInt(Copy(strUnPackedData, length(...),Length(strUnPackedData) - intDataBegin + 1));
end;
if intCmdType = 806 then
begin
// strTemp := strTemp + '806=' + Format(IMSData(CInt(strDevAddress - 1)).C806, '#0');
end;
if intCmdType = 820 then
begin
// strTemp := strTemp + '820 = ' + Format(IMSData[CInt(strDevAddress - 1)].C820, "0#####");
end;
if intCmdType = 821 then
begin
// strTemp := strTemp + '821=' + Format(IMSData[CInt(strDevAddress - 1)].C821, "0#####.#0 ")
end;
if intCmdType = 822 then
begin
// strTemp := strTemp + '822=' + Format(IMSData[CInt(strDevAddress - 1)].C822, "0#####.#0 ")
end;
if intCmdType = 823 then
begin
// strTemp := strTemp + '823=' + Format(IMSData[CInt(strDevAddress - 1)].C823, "0#####.#0 ")
end;
if intCmdType = 824 then
begin
// strTemp := strTemp + '824=' + Format(IMSData[CInt(strDevAddress - 1)].C824, "0####")
end;
if intCmdType = 825 then
begin
// strTemp := strTemp + '825=' + Format(IMSData[CInt(strDevAddress - 1)].C825, "0##.#0 ")
end;
if intCmdType = 826 then
begin
// strTemp := strTemp + '826=' + Format(IMSData[CInt(strDevAddress - 1)].C826, "0###.#0 ")
end;
if intCmdType = 827 then
begin
// strTemp := strTemp + '827=' + Format(IMSData[CInt(strDevAddress - 1)].C827, "0###.# ")
end;
if intCmdType = 828 then
begin
// strTemp := strTemp + '828=' + Format(IMSData[CInt(strDevAddress - 1)].C828, "hh: mm: ss")
end;
if intCmdType = 840 then
begin
// strTemp := strTemp + '840=' + Format(IMSData[CInt(strDevAddress - 1)].C840, '0#######');
end;
if intCmdType = 902 then
begin
// strTemp := strTemp + '902=' + Format(IMSData[CInt(strDevAddress - 1)].C902, '0#####.#0');
end;
if intCmdType = 903 then
begin
// strTemp := strTemp + '903=' + Format(IMSData[CInt(strDevAddress - 1)].C903, '0#####.#0');
end;
if intCmdType = 904 then
begin
// strTemp := strTemp + '904=' + Format(IMSData[CInt(strDevAddress - 1)].C904, 'hh:mm');
end;
if intCmdType = 905 then
begin
// strTemp := strTemp + '905=' + Format(IMSData[CInt(strDevAddress - 1)].C905, 'hh:mm');
end;
if intCmdType = 906 then
begin
// strTemp := strTemp + '906=' + Format(IMSData[CInt(strDevAddress - 1)].C906, '0#######');
end;
if intDataEnd > 0 then
strTemp := strTemp + ';'
else
strTemp := strTemp + ETX;
until (intDataEnd < 0);
strTemp := strTemp + strCheckSum(strTemp);
comIMS.Output := strTemp;
txtOut.Text := '';
for intTemp := 1 to Length(strTemp) do
txtOut.Text := txtOut.Text + IntToHex(ord(Copy(strTemp, intTemp, 1)[1]), 1) + ';';
end;
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
cmdStop: TButton;
cmd_Next: TButton;
cmd_Last: TButton;
cmd_IMS: TButton;
cmd_Exit: TButton;
cmdBegin: TButton;
IMSCtr: TLabel;
txt820: TEdit;
lbl821: TLabel;
lbl822: TLabel;
lbl823: TLabel;
lbl824: TLabel;
lbl825: TLabel;
lbl826: TLabel;
lbl827: TLabel;
lbl902: TLabel;
lbl903: TLabel;
lblSTime: TLabel;
lblETime: TLabel;
timIMS: TTimer;
txtOut: TEdit;
procedure FormCreate(Sender: TObject);
procedure cmdStopClick(Sender: TObject);
procedure cmd_NextClick(Sender: TObject);
procedure cmd_LastClick(Sender: TObject);
procedure cmd_IMSClick(Sender: TObject);
procedure cmd_ExitClick(Sender: TObject);
procedure cmdBeginClick(Sender: TObject);
procedure timIMSTimer(Sender: TObject);
private
{ Private declarations }
procedure InitSystem;
procedure ViewIMS;
procedure PrcRequest;
procedure ProUnPackData;
procedure Answer;
procedure UnPackProcess;
public
{ Public declarations }
end;
type
IMSType = record
C806: Integer;
C820: Single;
C821: Single;
C822: Single;
C823: Single;
C824: Single;
C825: Single;
C826: Single;
C827: Single;
C828: TDateTime;
C840: Single;
C902: Single;
C903: Single;
C904: TDateTime;
C905: TDateTime;
C906: Single;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
DeviceNumber = 11;
var
IMSData: array[0..DeviceNumber] of IMSType;
intCtrPoint: Integer;
intUnPackOK: Integer;
strUnPackData: string;
strTempData: string;
strUnPackedData: string;
strSpsAddress: string;
strDevAddress: string;
SOH, STX, ETX, ACK, NAK: string;
procedure TForm1.InitSystem;
var
intPoint: Integer;
StrTemp: string;
begin
SOH := Chr($1);
STX := Chr($2);
ETX := Chr($3);
ACK := Chr($6);
NAK := Chr($15);
intCtrPoint := 0;
//格式化这句话不会翻译，代替Format(intCtrPoint + 1, "0#")
case length(IntToStr(intCtrPoint + 1)) of
0: StrTemp := '0' + IntToStr(intCtrPoint + 1);
else
StrTemp := IntToStr(intCtrPoint + 1);
end;
IMSCtr.Caption := 'IMS: ' + StrTemp;
cmdStop.Enabled := False;
for intPoint := 0 to DeviceNumber do
begin
IMSData[intPoint].C806 := 0;
IMSData[intPoint].C820 := 1000;
IMSData[intPoint].C821 := 0;
IMSData[intPoint].C822 := 0;
IMSData[intPoint].C823 := 0;
IMSData[intPoint].C824 := 0;
IMSData[intPoint].C825 := 25.54;
IMSData[intPoint].C826 := 154.38;
IMSData[intPoint].C827 := 19.56;
IMSData[intPoint].C828 := Now;
IMSData[intPoint].C840 := 0;
IMSData[intPoint].C902 := 0;
IMSData[intPoint].C903 := 0;
IMSData[intPoint].C904 := Now;
IMSData[intPoint].C905 := Now;
IMSData[intPoint].C906 := 0;
end;
txt820.Text := FloatToStr(IMSData[intCtrPoint].C820);
ViewIMS;
comIMS.InputLen := 0;
comIMS.PortOpen := True;
intUnPackOK := 0;
end;
procedure TForm1.ViewIMS;
begin
{这块不翻译了，专门的Format格式忘记了，让我都使用循环太累了，
lbl821.Caption := Format(IMSData[intCtrPoint].C821, '######.#0 ');
lbl822.Caption := Format(IMSData[intCtrPoint].C822, '######.#0 ');
lbl823.Caption := Format(IMSData[intCtrPoint].C823, '######.#0 ');
lbl824.Caption := Format(IMSData[intCtrPoint].C824, '######.#0 ');
lbl825.Caption := Format(IMSData[intCtrPoint].C825, '######.#0 ');
lbl826.Caption := Format(IMSData[intCtrPoint].C826, '######.#0 ');
lbl827.Caption := Format(IMSData[intCtrPoint].C827, '######.#0 ');
lbl902.Caption := Format(IMSData[intCtrPoint].C902, '######.#0 ');
lbl903.Caption := Format(IMSData[intCtrPoint).C903, '######.#0 ');
lblSTime.Caption := Format(IMSData[intCtrPoint].C905, 'hh: mm: ss');
lblETime.Caption := Format(IMSData[intCtrPoint].C904, 'hh: mm: ss');}
end;
procedure TForm1.cmdBeginClick(Sender: TObject);
begin
timIMS.Enabled := True;
cmdBegin.Enabled := False;
cmdStop.Enabled := True;
end;
procedure TForm1.cmd_ExitClick(Sender: TObject);
begin
if comIMS.PortOpen = True then
comIMS.PortOpen := False;
Close;
end;
procedure TForm1.cmd_IMSClick(Sender: TObject);
begin
if IMSData[intCtrPoint].C806 = 0 then
begin
try
IMSData[intCtrPoint].C820 := StrToFloat(txt820.Text);
except
end;
IMSData[intCtrPoint].C821 := IMSData[intCtrPoint].C820;
IMSData[intCtrPoint].C806 := 99;
IMSData[intCtrPoint].C905 := Now;
ViewIMS;
end;
end;
procedure TForm1.cmd_LastClick(Sender: TObject);
begin
try
if IMSData[intCtrPoint].C806 = 0 then
IMSData[intCtrPoint].C820 := StrToFloat(txt820.Text);
except
end;
intCtrPoint := intCtrPoint - 1;
if intCtrPoint < 0 then intCtrPoint := DeviceNumber;
//IMSCtr.Caption := 'IMS : ' + Format(intCtrPoint + 1, "0#");不翻译了
txt820.Text := FloatToStr(IMSData[intCtrPoint].C820);
ViewIMS;
end;
procedure TForm1.cmd_NextClick(Sender: TObject);
begin
try
if IMSData[intCtrPoint].C806 = 0 then
IMSData[intCtrPoint].C820 := StrToFloat(txt820.Text);
except
end;
intCtrPoint := intCtrPoint + 1;
if intCtrPoint > DeviceNumber then intCtrPoint := 0;
//IMSCtr.Caption := 'IMS : ' + Format(intCtrPoint + 1, '0#');不翻译了
txt820.Text := FloatToStr(IMSData[intCtrPoint].C820);
ViewIMS;
end;
procedure TForm1.cmdStopClick(Sender: TObject);
begin
timIMS.Enabled := False;
cmdBegin.Enabled := True;
cmdStop.Enabled := False;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitSystem;
end;
procedure TForm1.timIMSTimer(Sender: TObject);
var
intPoint: Integer;
begin
for intPoint := 0 to DeviceNumber do
begin
if IMSData[intPoint].C806 > 0 then
begin
IMSData[intPoint].C821 := IMSData[intPoint].C821 - Random * 10; //Random范围？
if IMSData[intPoint].C821 <= 0 then
begin
IMSData[intPoint].C902 := IMSData[intPoint].C820;
IMSData[intPoint].C903 := IMSData[intPoint].C820 * 1.00024;
IMSData[intPoint].C820 := 0;
IMSData[intPoint].C822 := 0;
IMSData[intPoint].C823 := 0;
IMSData[intPoint].C824 := 0;
if intPoint = intCtrPoint then txt820.Text := '0';
IMSData[intPoint].C904 := Now;
IMSData[intPoint].C821 := 0;
IMSData[intPoint].C806 := 0;
end
else
begin
IMSData[intPoint].C822 := IMSData[intPoint].C820 - IMSData[intPoint].C821;
IMSData[intPoint].C823 := IMSData[intPoint].C822 * 1.00024;
IMSData[intPoint].C824 := Random * 10; //范围？
end;
end;
IMSData[intPoint].C825 := IMSData[intPoint].C825 + Random - 0.5;
IMSData[intPoint].C826 := IMSData[intPoint].C826 + Random - 0.5;
IMSData[intPoint].C827 := IMSData[intPoint].C827 + Random - 0.5;
end;
ViewIMS;
PrcRequest;
end;
procedure TForm1.PrcRequest;
begin
if comIMS.InBufferCount > 0 then
begin
strUnPackData := comIMS.Input;
ProUnPackData;
if intUnPackOK = 99 then
begin
intUnPackOK := 0;
Answer;
end
else if intUnPackOK < 0 then
intUnPackOK := 0;
end;
end;
{ ================================================
功能: 获取数据效验值
================================================}
function strCheckSum(strData: string): string;
var
intTemp, intSum: Integer;
begin
intSum := 0;
for intTemp := 1 to Length(strData) do
intSum := intSum + ord(Copy(strData, intTemp, 1)[1]);
// 原文strCheckSum := Hex((intSum / $10) Mod $10)& Hex(intSum Mod $10);
strCheckSum := IntToHex(((intSum div $10) mod $10), 1) + IntToHex((intSum mod $10), 1); //可能有问题，取余和取整在VB和Delphi里面弄混了
end;
{ ================================================
功能: 处理卸载协议数据
================================================}
procedure TForm1.ProUnPackData;
var
intEndPoint: Integer;
begin
intEndPoint := 0;
case intUnPackOK of
0:
begin
if Copy(strUnPackData, 1, 1) = SOH then
begin
// intEndPoint := InStr(1, strUnPackData, ETX);//不知道对应函数
if (intEndPoint < 1) then
begin
strTempData := strUnPackData;
intUnPackOK := 1;
end
else
begin
{If 代替了Case，因为Delphi的Case不支持变量}
if Length(strUnPackData) = intEndPoint then
begin
strTempData := strUnPackData;
intUnPackOK := 2;
end
else if Length(strUnPackData) = intEndPoint + 1 then
begin
strTempData := strUnPackData;
intUnPackOK := 3;
end
else if Length(strUnPackData) = intEndPoint + 2 then
begin
strTempData := strUnPackData;
UnPackProcess;
end
else
//数据错误
intUnPackOK := -1;
end;
end
else
//数据错误
intUnPackOK := -1
end;
1:
begin
// intEndPoint := InStr(1, strUnPackData, ETX);不知道对应函数
{If代替了case循环}
if (intEndPoint < 1) then
strTempData := strTempData + strUnPackData
else if Length(strUnPackData) = intEndPoint then
begin
strTempData := strTempData + strUnPackData;
intUnPackOK := 2;
end
else if Length(strUnPackData) = intEndPoint + 1 then
begin
strTempData := strTempData + strUnPackData;
intUnPackOK := 3;
end
else if Length(strUnPackData) = intEndPoint + 2 then
begin
strTempData := strTempData + strUnPackData;
UnPackProcess;
end
else
//数据错误
intUnPackOK := -1
end;
2:
begin
case Length(strUnPackData) of
1:
begin
strTempData := strTempData + strUnPackData;
intUnPackOK := 3;
end;
2:
begin
strTempData := strTempData + strUnPackData;
UnPackProcess;
end;
else
intUnPackOK := -1;
end;
end;
end;
end;
{ ================================================
功能: 从一个数据包中卸载协议
================================================}
procedure TForm1.UnPackProcess;
var
Tmp_Str: string;
begin
intUnPackOK := -1;
if Copy(strTempData, length(strTempData) - 2, 2) =
strCheckSum(Copy(strTempData, 1, length(strTempData) - 2)) then
if Copy(strTempData, 8, 1) = STX then
begin
strDevAddress := copy(strTempData, 2, 3);
strSpsAddress := copy(strTempData, 5, 3);
strUnPackedData := copy(strTempData, 9, Length(strTempData) - 11);
intUnPackOK := 99;
end;
end;
procedure TForm1.Answer;
var
strTemp: string;
intTemp: Integer;
intDataBegin: Integer;
intDataEnd: Integer;
intCmdType: Integer;
begin
if Copy(strUnPackedData, 1, 1) = 'R' then
begin
intDataBegin := 2;
strTemp := SOH + strSpsAddress + strDevAddress + STX;
repeat
// intDataEnd := InStr(intDataBegin, strUnPackedData, "; ")不知道如何翻译
if intDataEnd > 0 then
begin
// intCmdType = CInt(Copy(strUnPackedData, intDataBegin, intDataEnd - intDataBegin));//不知道如何翻译
intDataBegin := intDataEnd + 1;
end
else
begin
// intCmdType := CInt(Copy(strUnPackedData, length(...),Length(strUnPackedData) - intDataBegin + 1));
end;
if intCmdType = 806 then
begin
// strTemp := strTemp + '806=' + Format(IMSData(CInt(strDevAddress - 1)).C806, '#0');
end;
if intCmdType = 820 then
begin
// strTemp := strTemp + '820 = ' + Format(IMSData[CInt(strDevAddress - 1)].C820, "0#####");
end;
if intCmdType = 821 then
begin
// strTemp := strTemp + '821=' + Format(IMSData[CInt(strDevAddress - 1)].C821, "0#####.#0 ")
end;
if intCmdType = 822 then
begin
// strTemp := strTemp + '822=' + Format(IMSData[CInt(strDevAddress - 1)].C822, "0#####.#0 ")
end;
if intCmdType = 823 then
begin
// strTemp := strTemp + '823=' + Format(IMSData[CInt(strDevAddress - 1)].C823, "0#####.#0 ")
end;
if intCmdType = 824 then
begin
// strTemp := strTemp + '824=' + Format(IMSData[CInt(strDevAddress - 1)].C824, "0####")
end;
if intCmdType = 825 then
begin
// strTemp := strTemp + '825=' + Format(IMSData[CInt(strDevAddress - 1)].C825, "0##.#0 ")
end;
if intCmdType = 826 then
begin
// strTemp := strTemp + '826=' + Format(IMSData[CInt(strDevAddress - 1)].C826, "0###.#0 ")
end;
if intCmdType = 827 then
begin
// strTemp := strTemp + '827=' + Format(IMSData[CInt(strDevAddress - 1)].C827, "0###.# ")
end;
if intCmdType = 828 then
begin
// strTemp := strTemp + '828=' + Format(IMSData[CInt(strDevAddress - 1)].C828, "hh: mm: ss")
end;
if intCmdType = 840 then
begin
// strTemp := strTemp + '840=' + Format(IMSData[CInt(strDevAddress - 1)].C840, '0#######');
end;
if intCmdType = 902 then
begin
// strTemp := strTemp + '902=' + Format(IMSData[CInt(strDevAddress - 1)].C902, '0#####.#0');
end;
if intCmdType = 903 then
begin
// strTemp := strTemp + '903=' + Format(IMSData[CInt(strDevAddress - 1)].C903, '0#####.#0');
end;
if intCmdType = 904 then
begin
// strTemp := strTemp + '904=' + Format(IMSData[CInt(strDevAddress - 1)].C904, 'hh:mm');
end;
if intCmdType = 905 then
begin
// strTemp := strTemp + '905=' + Format(IMSData[CInt(strDevAddress - 1)].C905, 'hh:mm');
end;
if intCmdType = 906 then
begin
// strTemp := strTemp + '906=' + Format(IMSData[CInt(strDevAddress - 1)].C906, '0#######');
end;
if intDataEnd > 0 then
strTemp := strTemp + ';'
else
strTemp := strTemp + ETX;
until (intDataEnd < 0);
strTemp := strTemp + strCheckSum(strTemp);
comIMS.Output := strTemp;
txtOut.Text := '';
for intTemp := 1 to Length(strTemp) do
txtOut.Text := txtOut.Text + IntToHex(ord(Copy(strTemp, intTemp, 1)[1]), 1) + ';';
end;
end;
end.