chaobiao.frm

VB编写的基于645规约的电表行业485通讯抄表程序

Private Sub Grid_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu sys
End Sub

Private Sub JD_Click()
VoltageDown
End Sub

Private Sub S_BZ_Click()
If Dir(App.Path & "\readme.txt") <> "" Then
   StartDoc App.Path & "\readme.txt"
End If
End Sub

Private Sub S_CB_Click()
If Fang_Shi = "台体抄表" Then
   Sys_TaiTi_Run
Else
   Sys_ChaoBiao_Run
End If
End Sub

Private Sub S_SX_Click()
  ListClear
End Sub

Private Sub S_TC_Click()
  Unload Me
End Sub

Private Sub S_TZ_Click()
Sk = False
BiaoHao_QuanXuan (False)
BH_QX.Checked = False
End Sub

Private Sub SD_Click()
VoltageRase gIntComPort485, gVoltage
End Sub

Private Sub YXXT_Click()
XiangTong Grid.Row, Grid.Col, Val(gIntMeters)
End Sub



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


Public Sub LianHao(Row As Variant, Col As Variant, BiaoWei As Variant)
Dim Biaohao, tmp, BianLiang As String
Dim p, S As Variant
Biaohao = Trim(Grid.TextMatrix(Row, Col))
If Biaohao = "" Then Exit Sub
Dim K As Integer
For K = 1 To Len(Biaohao)
  tmp = Mid(Biaohao, K, 1)
  If isNumber(tmp) = True Then
     BianLiang = Left(Biaohao, K - 1)
     p = K - 1
     Exit For
  End If
Next K
S = Val(Mid(Biaohao, p + 1, Len(Biaohao) - p))
For K = Row To BiaoWei
   Grid.TextMatrix(K, Col) = BianLiang & AddZero(Len(Biaohao) - p - Len(S)) & S
   S = S + 1
Next K
End Sub

Public Sub XiangTong(Row As Variant, Col As Variant, BiaoWei As Variant)
Dim hm As String
hm = Trim(Grid.TextMatrix(Row, Col))
If hm = "" Then Exit Sub
For K = Row To BiaoWei
  Grid.TextMatrix(K, Col) = hm
Next K
End Sub

Public Sub BiaoHao_QuanXuan(QX As Boolean)
Dim i As Variant
  Grid.Col = 1
  For i = 1 To Grid.Rows - 1
    If QX = True Then
      Grid.Row = i
      Set Grid.CellPicture = Nothing
      Set Grid.CellPicture = SCheck.Picture
    Else
      Grid.Row = i
      Set Grid.CellPicture = Nothing
      Set Grid.CellPicture = SUnCheck.Picture
    End If
  Next i

End Sub

Public Sub ListClear()
Dim K, t As Variant
For K = 2 To Grid.Cols - 1
  For t = 1 To Grid.Rows - 1
    Grid.TextMatrix(t, K) = ""
    Grid.Col = K
    Grid.Row = t
    Grid.CellForeColor = &H0&
    Grid.CellFontBold = False
  Next t
Next K
End Sub

Public Sub IniList(YongHu As String, BiaoWei As Variant)

BiaoZhi = ""
GeShi = ""
ZiJieShu = ""
KongZhiMa = ""
MiMa = ""
DuXie = ""
      
On Error GoTo ErrMsg
            
Dim p As Variant
Dim SQL As String
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
Rs.CursorType = adOpenKeyset
Rs.LockType = adLockOptimistic
Connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\fa.mdb;Persist Security Info=True"
SQL = " Select * From 方案 where 方案名称 like '%" & YongHu & "%'"
Rs.Open SQL, Connstr, , , adCmdText

If Not Rs.EOF Then
   Me.Caption = Rs.Fields("方案名称").Value
   Grid.Rows = BiaoWei + 1
   Grid.TextMatrix(0, 0) = "表位"
   Grid.TextMatrix(0, 1) = "运行"
   Grid.Cols = Rs.RecordCount + 2
   Grid.ColWidth(0) = 450
   Grid.ColWidth(1) = 450
   
   Rs.MoveFirst
 
   For p = 1 To Rs.RecordCount
      Grid.TextMatrix(0, p + 1) = Rs.Fields("字段名称").Value
      Grid.ColWidth(p + 1) = 18.8 * IIf(6.8 * Len(Trim(Rs.Fields("规约格式").Value)) > 15 * Len(Grid.TextMatrix(0, p + 1)), 6.8 * Len(Trim(Rs.Fields("规约格式").Value)), 15 * Len(Grid.TextMatrix(0, p + 1)))
      BiaoZhi = BiaoZhi & Trim(Rs.Fields("规约标识").Value) & "|"
      GeShi = GeShi & Trim(Rs.Fields("规约格式").Value) & "|"
      ZiJieShu = ZiJieShu & Trim(Rs.Fields("项字节数").Value) & "|"
      KongZhiMa = KongZhiMa & Trim(Rs.Fields("控制码").Value) & "|"
      MiMa = MiMa & Trim(Rs.Fields("编程密码").Value) & "|"
      DuXie = DuXie & Trim(Rs.Fields("读写").Value) & "|"
      Rs.MoveNext
   Next p
End If

Grid.Col = 1
For p = 1 To Val(BiaoWei)
   Grid.TextMatrix(p, 0) = CStr(p)
   Grid.Row = p
   Set Grid.CellPicture = SCheck.Picture
Next p


Set Rs = Nothing

Exit Sub

ErrMsg:
   MsgBox (Err.Description)
End Sub


Public Sub Sys_ChaoBiao_Run()   '工装抄表

Set Sll = New SLL_DataOperate.DataOperate
Dim Msg_1, Msg_2, Msg_3 As String
Dim KZM As String

Dim SQL As String
Dim p As Long

Dim Row, Col As Variant
For Row = 1 To Grid.Rows - 1

  '判断是否需要运行
  
  Grid.Col = 1
  Grid.Row = Row
  Sk = IIf(Grid.CellPicture = SCheck.Picture, True, False)
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  For Col = 2 To Grid.Cols - 1
        If Sk = True Then
            
            If Com485.PortOpen = True Then Com485.PortOpen = False
            Com485.Commport = gIntComPort485
            Dim Ys As Variant
                      
            Select Case GetItem(DuXie, "|", Col - 2)
            
              Case "读"
              
                    Ys = Val(gFrameDelay) * CInt((GetItem(ZiJieShu, "|", Col - 2) / 3))
                    Msg_1 = Sll.DataPart(GetItem(BiaoZhi, "|", Col - 2), "", "", GetItem(GeShi, "|", Col - 2), True)
                    Msg_2 = Sll.DataSend(Com485, gInitAddress, "0102", CStr(Msg_1), Val(gByteDelay), Val(Ys), p)
                    Msg_3 = Sll.ReceiveData_Operate(CStr(Msg_2), GetItem(GeShi, "|", Col - 2), GetItem(ZiJieShu, "|", Col - 2))
                    If Msg_3 <> "" Then
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellForeColor = &H0&
                      Grid.CellFontBold = False
                      Grid.TextMatrix(Row, Col) = Msg_3
                    Else
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellForeColor = &HFF&
                      Grid.CellFontBold = True
                      Grid.TextMatrix(Row, Col) = "Error"
                    End If
                    
              Case "写"
              
                    KZM = GetItem(KongZhiMa, "|", Col - 2) & Right("00" & Hex(Len(GetItem(BiaoZhi, "|", Col - 2)) / 2 + Len(GetItem(MiMa, "|", Col - 2)) / 2 + Val(GetItem(ZiJieShu, "|", Col - 2))), 2)
                    Msg_1 = Sll.DataPart(GetItem(BiaoZhi, "|", Col - 2), CStr(GetItem(MiMa, "|", Col - 2)), Trim(Grid.TextMatrix(Row, Col)), GetItem(GeShi, "|", Col - 2), False)
                    Msg_2 = Sll.DataSend(Com485, gInitAddress, CStr(KZM), CStr(Msg_1), Val(gByteDelay), 0.8, p)
                    Grid.TextMatrix(Row, Col) = StringFormat(Trim(Grid.TextMatrix(Row, Col)), GetItem(GeShi, "|", Col - 2))
                    If Msg_2 <> "" Then
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellFontBold = False
                      Grid.CellForeColor = &H0&
                    Else
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellFontBold = True
                      Grid.CellForeColor = &HFF&
                    End If
                    
              Case "" '
                    
            End Select
               
        End If
  Next Col
Next Row

End Sub


Public Sub Sys_TaiTi_Run()     '台体抄表

Set Sll = New SLL_DataOperate.DataOperate

Dim lStrOrder, sResult As String
Set myUdt8000 = New Class8000
myUdt8000.Commport = gIntComPort
myUdt8000.CommSetting = "9600,n,8,1"

'上电
VoltageRase gIntComPort, gVoltage
'
Dim Msg_1, Msg_2, Msg_3 As String
Dim KZM As String

Dim SQL As String
Dim p As Long

Dim Row, Col As Variant
For Row = 1 To Grid.Rows - 1

  '判断是否需要运行
  
  Grid.Col = 1
  Grid.Row = Row
  Sk = IIf(Grid.CellPicture = SCheck.Picture, True, False)
  
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  
  For Col = 2 To Grid.Cols - 1
        If Sk = True Then
            
            '打通通道
            lStrOrder = ErrorOrder_gFun(10, Val(Row))
            If myUdt8000.SendOrder(CStr(lStrOrder)) = "" Then Exit For
            
            If Com485.PortOpen = True Then Com485.PortOpen = False
            Com485.Commport = gIntComPort485
            Dim Ys As Variant

            Select Case GetItem(DuXie, "|", Col - 2)
            
              Case "读"
              
                    Ys = Val(gFrameDelay) * CInt((GetItem(ZiJieShu, "|", Col - 2) / 3))
                    Msg_1 = Sll.DataPart(GetItem(BiaoZhi, "|", Col - 2), "", "", GetItem(GeShi, "|", Col - 2), True)
                    Msg_2 = Sll.DataSend(Com485, gInitAddress, "0102", CStr(Msg_1), Val(gByteDelay), Val(Ys), p)
                    Msg_3 = Sll.ReceiveData_Operate(CStr(Msg_2), GetItem(GeShi, "|", Col - 2), GetItem(ZiJieShu, "|", Col - 2))
                    If Msg_3 <> "" Then
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellForeColor = &H0&
                      Grid.CellFontBold = False
                      Grid.TextMatrix(Row, Col) = Msg_3
                    Else
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellForeColor = &HFF&
                      Grid.CellFontBold = True
                      Grid.TextMatrix(Row, Col) = "Error"
                    End If
                    
              Case "写"
              
                    KZM = GetItem(KongZhiMa, "|", Col - 2) & Right("00" & Hex(Len(GetItem(BiaoZhi, "|", Col - 2)) / 2 + Len(GetItem(MiMa, "|", Col - 2)) / 2 + Val(GetItem(ZiJieShu, "|", Col - 2))), 2)
                    Msg_1 = Sll.DataPart(GetItem(BiaoZhi, "|", Col - 2), CStr(GetItem(MiMa, "|", Col - 2)), Trim(Grid.TextMatrix(Row, Col)), GetItem(GeShi, "|", Col - 2), False)
                    Msg_2 = Sll.DataSend(Com485, gInitAddress, CStr(KZM), CStr(Msg_1), Val(gByteDelay), 0.8, p)
                    Grid.TextMatrix(Row, Col) = StringFormat(Trim(Grid.TextMatrix(Row, Col)), GetItem(GeShi, "|", Col - 2))
                    If Msg_2 <> "" Then
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellFontBold = False
                      Grid.CellForeColor = &H0&
                    Else
                      Grid.Col = Col
                      Grid.Row = Row
                      Grid.CellFontBold = True
                      Grid.CellForeColor = &HFF&
                    End If
                    
              Case "" '
                    
            End Select
               
        End If
  Next Col
Next Row

Call VoltageDown

End Sub


Private Sub TT_DDCD_Click()  '单点抄读
'
Set Sll = New SLL_DataOperate.DataOperate

Dim lStrOrder, sResult As String
Set myUdt8000 = New Class8000
myUdt8000.Commport = gIntComPort
myUdt8000.CommSetting = "9600,n,8,1"

'上电
VoltageRase gIntComPort, gVoltage
'
Dim Msg_1, Msg_2, Msg_3 As String
Dim KZM As String

Dim SQL As String
Dim p As Long

    
    '打通通道
    lStrOrder = ErrorOrder_gFun(10, Val(Grid.Row))
    If myUdt8000.SendOrder(CStr(lStrOrder)) = "" Then Exit Sub
    
    If Com485.PortOpen = True Then Com485.PortOpen = False
    Com485.Commport = gIntComPort485
    Dim Ys As Variant

    Select Case GetItem(DuXie, "|", Col - 2)
    
      Case "读"
      
            Ys = Val(gFrameDelay) * CInt((GetItem(ZiJieShu, "|", Col - 2) / 3))
            Msg_1 = Sll.DataPart(GetItem(BiaoZhi, "|", Col - 2), "", "", GetItem(GeShi, "|", Col - 2), True)
            Msg_2 = Sll.DataSend(Com485, gInitAddress, "0102", CStr(Msg_1), Val(gByteDelay), Val(Ys), p)
            Msg_3 = Sll.ReceiveData_Operate(CStr(Msg_2), GetItem(GeShi, "|", Col - 2), GetItem(ZiJieShu, "|", Col - 2))
            If Msg_3 <> "" Then
              Grid.Col = Col
              Grid.Row = Row
              Grid.CellForeColor = &H0&
              Grid.CellFontBold = False
              Grid.TextMatrix(Row, Col) = Msg_3
            Else
              Grid.Col = Col
              Grid.Row = Row
              Grid.CellForeColor = &HFF&
              Grid.CellFontBold = True
              Grid.TextMatrix(Row, Col) = "Error"
            End If
            
      Case "写"
      
            KZM = GetItem(KongZhiMa, "|", Col - 2) & Right("00" & Hex(Len(GetItem(BiaoZhi, "|", Col - 2)) / 2 + Len(GetItem(MiMa, "|", Col - 2)) / 2 + Val(GetItem(ZiJieShu, "|", Col - 2))), 2)
            Msg_1 = Sll.DataPart(GetItem(BiaoZhi, "|", Col - 2), CStr(GetItem(MiMa, "|", Col - 2)), Trim(Grid.TextMatrix(Row, Col)), GetItem(GeShi, "|", Col - 2), False)
            Msg_2 = Sll.DataSend(Com485, gInitAddress, CStr(KZM), CStr(Msg_1), Val(gByteDelay), 0.8, p)
            Grid.TextMatrix(Row, Col) = StringFormat(Trim(Grid.TextMatrix(Row, Col)), GetItem(GeShi, "|", Col - 2))
            If Msg_2 <> "" Then
              Grid.Col = Col
              Grid.Row = Row
              Grid.CellFontBold = False
              Grid.CellForeColor = &H0&
            Else
              Grid.Col = Col
              Grid.Row = Row
              Grid.CellFontBold = True
              Grid.CellForeColor = &HFF&
            End If
            
      Case "" '
            
    End Select
       

Call VoltageDown
End Sub