Sub Cb485STS_Read(is_CMD As String)
Dim ReadCommand As String
Dim dbbh, Sjbs, temp1, ins2, ins3, ins4 As String
Dim Start, xms, zjs, i, j As Integer
Dim L, kzm, sjycd, sjbs2 As Long
Dim Ins As Variant
MsgBox is_CMD
'MsgBox Err.Number
'& ": " & Error(Err)
On Error GoTo errHandler
Call Cb485STS_G_CMD(is_CMD)
li = 0
'LB_MSG.Caption = "正在抄" + c8.Sjbs + "......"
LB_MSG.Caption = "Reading" + c8.Sjbs + "......"
MsgBox c8.Sjbs
'zjs = c8.zjs
zjs = Val(Right(c8.zjs, 2))
kzm = Val("&H" + Right(c8.kzm, 2))
sjycd = Val("&H" + Right(c8.sjycd, 2))
sjbs2 = Val("&H" + Right(c8.sjbs2, 2))
'Csh = 211
W(li) = 254
li = li + 1
W(li) = 254
li = li + 1
W(li) = 254
li = li + 1
Csh = 0
W(li) = 104
Csh = Csh + W(li)
li = li + 1
Call MlzhSTS(c8.Number, 6, 0)
W(li) = 104
Csh = Csh + W(li)
li = li + 1
W(li) = kzm
Csh = Csh + W(li)
li = li + 1
W(li) = sjycd
Csh = Csh + W(li)
li = li + 1
Call MlzhSTS(c8.Sjbs, 2, 0)
If sjycd = 3 Then
Call MlzhSTS(c8.sjbs2, 1, 0)
End If
Csh = Csh Mod 256
W(li) = Csh
li = li + 1
W(li) = 22
c8.Send = ""
ins2 = ""
MsgBox "dd" & CStr(UBound(W))
For i = 0 To UBound(W)
'ins2 = ins2 & CStr(Hex(W(i))) & " "
ins2 = ins2 & Right("0" & CStr(Hex(W(i))), 2) & " "
'MsgBox ins2
Next
c8.Send = ins2
'c8.Send = Right(c8.Send & String((255 - Len(c8.Send)), " "), 255)
MsgBox "aa" & c8.Send
'c8.Send = CStr(UBound(W))
'MsgBox "bb" & c8.Send
'设置COM端口
OpenCommSTS (0)
If CommOpen < 0 Then
Exit Sub
End If
'向串口发读命令
MSComm1.Output = CVar(W)
'延时0.5秒
Start1 = Timer
Do While Timer < Start1 + 3
DoEvents ' 将控制让给其他程序。
Loop
Ins = MSComm1.Input
Arr = Ins
'显示读出的数据
'MsgBox (Arr)
'For i = 0 To 100
' MsgBox (Arr(i))
' If Val(Arr(i)) = 22 Then
' Exit For
' End If
'Next
i = 0
c8.Rece = ""
ins3 = ""
For i = 0 To UBound(Arr)
ins3 = ins3 & Right("0" & CStr(Hex(Arr(i))), 2) & " "
'MsgBox ins2
Next
c8.Rece = ins3
c8.Rece = Right(c8.Rece & String((255 - Len(c8.Rece)), " "), 255)
MsgBox "Rece" & c8.Rece
c8.Data = ""
i = 0
Do While i <= 1
If Val(Arr(i)) = 104 Then
Start = i
Exit Do
End If
'If i = 1 Then
If i <> 0 Then
c8.Flag = "3"
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "没有数据返回!"
LB_MSG.Caption = "No data returned one!"
Exit Sub
End If
i = i + 1
Loop
'MsgBox "start" & CStr(Start)
If Val(Arr(Start + 8)) <> 129 Then
c8.Cwz = Right("00" + Trim(Str(Arr(Start + i))), 2)
c8.Flag = 3
is_CMD = c8.Flag & c8.Cwz & c8.Data
'LB_MSG.Caption = "代码错误!"
'LB_MSG.Caption = "返回帧控制码错误!"
LB_MSG.Caption = "Return frame error control code!"
Exit Sub
End If
i = 0
Csh = 0
'j = UBound(Arr) - 4
'MsgBox "J" & CStr(j)
j = 0
If c8.Sjbs = "F365" Then
j = 10
Else
j = 12
End If
'Do While i < 12 '12个固定字节,计算校验核计算到数据标识,Data之前
Do While i < j '12个固定字节,计算校验核计算到数据标识,Data之前
'MsgBox "arr" & Hex(Arr(Start + i))
Csh = Csh + Val(Arr(Start + i))
i = i + 1
Loop
'Csh = Csh Mod 256
'MsgBox "csh" & Hex(Csh)
Select Case c8.Sjbs
Case "F365"
Csh1 = Val(Arr(Start + 10))
Case "90E1"
Call SjtqSTS(1, 2, Start + 8)
Call SjtqSTS(13, 4, Start + 10)
Csh1 = Val(Arr(Start + 56))
Case "B21F"
Call Sjtq(2, 4, Start)
Call Sjtq(2, 2, Start + 8)
Call Sjtq(1, 3, Start + 12)
Csh1 = Val(Arr(Start + 27))
Case "C01F"
Call Sjtq(1, 4, Start)
Call Sjtq(1, 3, Start + 4)
Csh1 = Arr(Start + 19)
Case "C03F"
Call Sjtq(2, 3, Start)
Call Sjtq(3, 6, Start + 6)
Csh1 = Arr(Start + 36)
Case "C11F"
Call Sjtq(6, 1, Start)
Call Sjtq(1, 2, Start + 6)
Call Sjtq(1, 1, Start + 8)
Call Sjtq(2, 4, Start + 9)
Csh1 = Arr(Start + 29)
Case "DD10", "DD11", "DD12", "DD13", "DD14", "DD15" ', "DD20", "DD21", "DD22", "DD23", "DD24", "DD25"
xms = 4
Call Sjtq2(4, 4, Start)
Csh1 = Val(Arr(Start + 12 + xms * zjs))
Case "DD20", "DD21", "DD22", "DD23", "DD24", "DD25"
xms = 4
Call Sjtq(4, 4, Start)
Csh1 = Val(Arr(Start + 12 + xms * zjs))
Case Else
' MsgBox (Val(Arr(Start + 9)))
' MsgBox (Hex(Val(Arr(Start + 9))))
'xms = (Hex(Val(Arr(Start + 9))) - 2) / Val(c8.zjs)
' MsgBox (xms)
'Call Sjtq(xms, zjs, Start)
'csh1 = Val(Arr(Start + 12 + xms * zjs))
'xms = Val(Hex(Arr(Start + 9))) / Val(c8.zjs)
' xms = (Val(Hex(Arr(Start + 9))) - 4) / Val(c8.zjs) '有用
'MsgBox "xms" & CStr(xms)
'Call Sjtq2007(xms, zjs, Start) ’有用
'Csh1 = Val(Arr(Start + 14 + xms * zjs))
'Csh1 = Val(Arr(Start + 14 + xms * zjs)) '有用
'MsgBox "csh1" & Hex(Csh1)
xms = (Hex(Val(Arr(Start + 9))) - 2) / Val(c8.zjs) '返回数据有多少组数据,一个项目数据为一组
Call SjtqSTS(xms, zjs, Start)
Csh1 = Val(Arr(Start + 12 + xms * zjs))
End Select
'MsgBox "csh1 " & Hex(Csh1)
Csh = Csh Mod 256
'MsgBox Hex(Csh)
'MsgBox Hex(Csh1)
If Csh <> Csh1 Then
c8.Flag = 3
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "效验错误!"
'LB_MSG.Caption = "效验核错误!"
LB_MSG.Caption = "Verify Error!"
Exit Sub
End If
c8.Flag = "1"
'LB_MSG.Caption = "抄表成功!"
LB_MSG.Caption = "Read Success!"
'返回数据
'is_CMD = c8.Flag & " " & c8.Send & c8.Rece & c8.Data
is_CMD = c8.Flag & "00" & c8.Send & c8.Rece & c8.Data Exit Sub
'错误处理
errHandler:
If Err.Number = 9 Then
c8.Flag = "3"
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "没有数据返回!"
LB_MSG.Caption = "No data returned two!"
Else
c8.Flag = "3"
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "抄表失败!"
LB_MSG.Caption = "Read failure!"
End If
End Sub
Dim ReadCommand As String
Dim dbbh, Sjbs, temp1, ins2, ins3, ins4 As String
Dim Start, xms, zjs, i, j As Integer
Dim L, kzm, sjycd, sjbs2 As Long
Dim Ins As Variant
MsgBox is_CMD
'MsgBox Err.Number
'& ": " & Error(Err)
On Error GoTo errHandler
Call Cb485STS_G_CMD(is_CMD)
li = 0
'LB_MSG.Caption = "正在抄" + c8.Sjbs + "......"
LB_MSG.Caption = "Reading" + c8.Sjbs + "......"
MsgBox c8.Sjbs
'zjs = c8.zjs
zjs = Val(Right(c8.zjs, 2))
kzm = Val("&H" + Right(c8.kzm, 2))
sjycd = Val("&H" + Right(c8.sjycd, 2))
sjbs2 = Val("&H" + Right(c8.sjbs2, 2))
'Csh = 211
W(li) = 254
li = li + 1
W(li) = 254
li = li + 1
W(li) = 254
li = li + 1
Csh = 0
W(li) = 104
Csh = Csh + W(li)
li = li + 1
Call MlzhSTS(c8.Number, 6, 0)
W(li) = 104
Csh = Csh + W(li)
li = li + 1
W(li) = kzm
Csh = Csh + W(li)
li = li + 1
W(li) = sjycd
Csh = Csh + W(li)
li = li + 1
Call MlzhSTS(c8.Sjbs, 2, 0)
If sjycd = 3 Then
Call MlzhSTS(c8.sjbs2, 1, 0)
End If
Csh = Csh Mod 256
W(li) = Csh
li = li + 1
W(li) = 22
c8.Send = ""
ins2 = ""
MsgBox "dd" & CStr(UBound(W))
For i = 0 To UBound(W)
'ins2 = ins2 & CStr(Hex(W(i))) & " "
ins2 = ins2 & Right("0" & CStr(Hex(W(i))), 2) & " "
'MsgBox ins2
Next
c8.Send = ins2
'c8.Send = Right(c8.Send & String((255 - Len(c8.Send)), " "), 255)
MsgBox "aa" & c8.Send
'c8.Send = CStr(UBound(W))
'MsgBox "bb" & c8.Send
'设置COM端口
OpenCommSTS (0)
If CommOpen < 0 Then
Exit Sub
End If
'向串口发读命令
MSComm1.Output = CVar(W)
'延时0.5秒
Start1 = Timer
Do While Timer < Start1 + 3
DoEvents ' 将控制让给其他程序。
Loop
Ins = MSComm1.Input
Arr = Ins
'显示读出的数据
'MsgBox (Arr)
'For i = 0 To 100
' MsgBox (Arr(i))
' If Val(Arr(i)) = 22 Then
' Exit For
' End If
'Next
i = 0
c8.Rece = ""
ins3 = ""
For i = 0 To UBound(Arr)
ins3 = ins3 & Right("0" & CStr(Hex(Arr(i))), 2) & " "
'MsgBox ins2
Next
c8.Rece = ins3
c8.Rece = Right(c8.Rece & String((255 - Len(c8.Rece)), " "), 255)
MsgBox "Rece" & c8.Rece
c8.Data = ""
i = 0
Do While i <= 1
If Val(Arr(i)) = 104 Then
Start = i
Exit Do
End If
'If i = 1 Then
If i <> 0 Then
c8.Flag = "3"
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "没有数据返回!"
LB_MSG.Caption = "No data returned one!"
Exit Sub
End If
i = i + 1
Loop
'MsgBox "start" & CStr(Start)
If Val(Arr(Start + 8)) <> 129 Then
c8.Cwz = Right("00" + Trim(Str(Arr(Start + i))), 2)
c8.Flag = 3
is_CMD = c8.Flag & c8.Cwz & c8.Data
'LB_MSG.Caption = "代码错误!"
'LB_MSG.Caption = "返回帧控制码错误!"
LB_MSG.Caption = "Return frame error control code!"
Exit Sub
End If
i = 0
Csh = 0
'j = UBound(Arr) - 4
'MsgBox "J" & CStr(j)
j = 0
If c8.Sjbs = "F365" Then
j = 10
Else
j = 12
End If
'Do While i < 12 '12个固定字节,计算校验核计算到数据标识,Data之前
Do While i < j '12个固定字节,计算校验核计算到数据标识,Data之前
'MsgBox "arr" & Hex(Arr(Start + i))
Csh = Csh + Val(Arr(Start + i))
i = i + 1
Loop
'Csh = Csh Mod 256
'MsgBox "csh" & Hex(Csh)
Select Case c8.Sjbs
Case "F365"
Csh1 = Val(Arr(Start + 10))
Case "90E1"
Call SjtqSTS(1, 2, Start + 8)
Call SjtqSTS(13, 4, Start + 10)
Csh1 = Val(Arr(Start + 56))
Case "B21F"
Call Sjtq(2, 4, Start)
Call Sjtq(2, 2, Start + 8)
Call Sjtq(1, 3, Start + 12)
Csh1 = Val(Arr(Start + 27))
Case "C01F"
Call Sjtq(1, 4, Start)
Call Sjtq(1, 3, Start + 4)
Csh1 = Arr(Start + 19)
Case "C03F"
Call Sjtq(2, 3, Start)
Call Sjtq(3, 6, Start + 6)
Csh1 = Arr(Start + 36)
Case "C11F"
Call Sjtq(6, 1, Start)
Call Sjtq(1, 2, Start + 6)
Call Sjtq(1, 1, Start + 8)
Call Sjtq(2, 4, Start + 9)
Csh1 = Arr(Start + 29)
Case "DD10", "DD11", "DD12", "DD13", "DD14", "DD15" ', "DD20", "DD21", "DD22", "DD23", "DD24", "DD25"
xms = 4
Call Sjtq2(4, 4, Start)
Csh1 = Val(Arr(Start + 12 + xms * zjs))
Case "DD20", "DD21", "DD22", "DD23", "DD24", "DD25"
xms = 4
Call Sjtq(4, 4, Start)
Csh1 = Val(Arr(Start + 12 + xms * zjs))
Case Else
' MsgBox (Val(Arr(Start + 9)))
' MsgBox (Hex(Val(Arr(Start + 9))))
'xms = (Hex(Val(Arr(Start + 9))) - 2) / Val(c8.zjs)
' MsgBox (xms)
'Call Sjtq(xms, zjs, Start)
'csh1 = Val(Arr(Start + 12 + xms * zjs))
'xms = Val(Hex(Arr(Start + 9))) / Val(c8.zjs)
' xms = (Val(Hex(Arr(Start + 9))) - 4) / Val(c8.zjs) '有用
'MsgBox "xms" & CStr(xms)
'Call Sjtq2007(xms, zjs, Start) ’有用
'Csh1 = Val(Arr(Start + 14 + xms * zjs))
'Csh1 = Val(Arr(Start + 14 + xms * zjs)) '有用
'MsgBox "csh1" & Hex(Csh1)
xms = (Hex(Val(Arr(Start + 9))) - 2) / Val(c8.zjs) '返回数据有多少组数据,一个项目数据为一组
Call SjtqSTS(xms, zjs, Start)
Csh1 = Val(Arr(Start + 12 + xms * zjs))
End Select
'MsgBox "csh1 " & Hex(Csh1)
Csh = Csh Mod 256
'MsgBox Hex(Csh)
'MsgBox Hex(Csh1)
If Csh <> Csh1 Then
c8.Flag = 3
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "效验错误!"
'LB_MSG.Caption = "效验核错误!"
LB_MSG.Caption = "Verify Error!"
Exit Sub
End If
c8.Flag = "1"
'LB_MSG.Caption = "抄表成功!"
LB_MSG.Caption = "Read Success!"
'返回数据
'is_CMD = c8.Flag & " " & c8.Send & c8.Rece & c8.Data
is_CMD = c8.Flag & "00" & c8.Send & c8.Rece & c8.Data Exit Sub
'错误处理
errHandler:
If Err.Number = 9 Then
c8.Flag = "3"
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "没有数据返回!"
LB_MSG.Caption = "No data returned two!"
Else
c8.Flag = "3"
is_CMD = c8.Flag & c8.Cwz & c8.Send & c8.Rece & c8.Data
'LB_MSG.Caption = "抄表失败!"
LB_MSG.Caption = "Read failure!"
End If
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货