module1.bas

This is a test ModBus comm s pragam in "STB-311".

  Dim T_S2 As String
  Dim zt As Integer
  Dim Y_b As Integer
  Dim A As Integer
  Dim b As Integer
  Dim C As Integer
  Dim d As Integer
  Dim TEMP_W As Integer
  Dim NET_S() As Byte
  Dim NET_I As Integer
  Dim dy_xh As Integer
  Dim Save_Addr As Integer
  Dim S() As Byte
On Error Resume Next
  NET_S = T
  
If Jiaoyan(T) = 1 Then
' For NET_I = 1 To 8
 '   If InUsed(NET_I) = True Then Main_Form.Server(NET_I).SendData NET_S
 'Next NET_I
   C_W = AscB(MidB(T, 6, 1)) '命令字
   Addr = AscB(MidB(T, 4, 1))
   C_L = AscB(MidB(T, 3, 1))
   If (TxvW_flag = True) And (Txvw.Combo1.ListIndex = 0) And (Txvw.Toolbar1.Buttons(2).Visible = True) Then
    Txvw.Option1(Addr).Value = True
   End If
TXCS_Dy(Addr) = TxGzcs
TX_Enabled(Addr) = True

Select Case C_W
 Case 0, &H66
      Celiang_String(Addr) = T
      YX_byte(Addr) = &HFF - AscB(MidB(Celiang_String(Addr), C_L - 1, 1))
      For i = 4 To LenB(Celiang_String(Addr)) \ 2 - 3
       If AscB(MidB(Celiang_String(Addr), i * 2 - 1, 1)) > 15 Then
           Celiang_SJ(Addr, i - 3) = Val("&H" + Hex$(AscB(MidB(Celiang_String(Addr), i * 2, 1))) + Hex$(AscB(MidB(Celiang_String(Addr), i * 2 - 1, 1))))
        Else
           Celiang_SJ(Addr, i - 3) = Val("&H" + Hex$(AscB(MidB(Celiang_String(Addr), i * 2, 1))) + "0" + Hex$(AscB(MidB(Celiang_String(Addr), i * 2 - 1, 1))))
        End If
            
     Next i
      
   If (C_W = &H66) And (Addr = Danyuan(Danyuanshu).dy_addr) Then
    Read_Now_tu
     For i = 1 To Max_KG_shu
        Shang(i) = False
     Next i
   End If
 Case 1
     Dingzhi_String(Addr) = T
    If LenB(T) > 16 Then
       If AscB(MidB(T, LenB(T) - 7, 1)) > 15 Then
          CT(Addr) = Val("&H" + Hex$(AscB(MidB(T, LenB(T) - 6, 1))) + Hex$(AscB(MidB(T, LenB(T) - 7, 1))))
       Else
          CT(Addr) = Val("&H" + Hex$(AscB(MidB(T, LenB(T) - 6, 1))) + "0" + Hex$(AscB(MidB(T, LenB(T) - 7, 1))))
       End If
      If AscB(MidB(T, LenB(T) - 9, 1)) > 15 Then
          PT(Addr) = Val("&H" + Hex$(AscB(MidB(T, LenB(T) - 8, 1))) + Hex$(AscB(MidB(T, LenB(T) - 9, 1))))
        Else
          PT(Addr) = Val("&H" + Hex$(AscB(MidB(T, LenB(T) - 8, 1))) + "0" + Hex$(AscB(MidB(T, LenB(T) - 9, 1))))
      End If
    End If
    For J = 1 To 255
    If Danyuan(J).dy_addr = Addr Then '单元序号
        dy_xh = J
     Exit For
    End If
    Next J
    If dzcx.Visible = True Then
     dzcx.MSFlexGrid3.Col = 3
     dzcx.MSFlexGrid3.Row = dy_xh
     dzcx.MSFlexGrid3.Text = LenB(Dingzhi_String(Addr))
    End If
    For i = 1 To Celiang_Num(Danyuan(dy_xh).Dy_type)
     
     Select Case CeLiang(Danyuan(dy_xh).Dy_type, i).CL_Type
      Case 1
         Celiang_XS(Addr, i) = PT(Addr) / 2000
      Case 2
        Celiang_XS(Addr, i) = CT(Addr) / 400
      Case 3
        Celiang_XS(Addr, i) = (CT(Addr) / 18000) * PT(Addr)
      Case 4
        Celiang_XS(Addr, i) = 0.3
      Case 5
        Celiang_XS(Addr, i) = 0.01
      Case 6
        Celiang_XS(Addr, i) = 0.001
      Case 7
        Celiang_XS(Addr, i) = 0.0025
      Case 8
        Celiang_XS(Addr, i) = 0.03
      Case 9
        Celiang_XS(Addr, i) = 0.003
      Case 10
        Celiang_XS(Addr, i) = PT(Addr) / 200
      Case 11
        Celiang_XS(Addr, i) = 0.0001
       Case 12
        Celiang_XS(Addr, i) = 1
      Case 13
        Celiang_XS(Addr, i) = 0.1
      Case Else
         Celiang_XS(Addr, i) = CeLiang(Danyuan(dy_xh).Dy_type, i).CL_Type - 100
      
     End Select
    Next i
  '  For I = 1 To 16
   '    RtlMoveMemory Temp_S(0), Celiang_XS(ADDR, I), 4
   ' Next I

 Case &HEA
  Save_Addr = Addr
   For ppp = 1 To 32
    If Danyuan(ppp).dy_addr = Addr Then
    Addr = ppp
     Exit For
     End If
  Next ppp
     
   tt = 1
   SOE_String(Addr, 9) = T
  For i = 1 To 8
     SOE_String(Addr, i) = SOE_String(Addr, i + 1)
     Temp_jf = MidB(T, (i - 1) * 16 + 7, 16)
     RtlMoveMemory Danyuan_SOE(Addr, i), Temp_jf(0), 16
    T_M = Val("&H" + Hex$(Danyuan_SOE(Addr, i).miao) + Hex$(Danyuan_SOE(Addr, i).haomiao))
     If T_M = Last_SOE_S(Addr) Then
        tt = i
     End If
  Next i
  
   For i = tt + 1 To 8
     SSS = Format(Now, "yyyy年mm月dd日") + "  " + Trim(Format(Danyuan_SOE(Addr, i).shi, "00") + "时" + Format(Danyuan_SOE(Addr, i).Fen, "00") + "分" + Format(Danyuan_SOE(Addr, i).miao, "00") + "秒" + Format(Danyuan_SOE(Addr, i).haomiao * 5, "000") + "毫秒" + " " + Danyuan(Addr).Dy_Name)
     
      If Danyuan_SOE(Addr, i).Yaoxin <> 0 Then '直接遥信
         Y_b = 0
         If Danyuan_SOE(Addr, i).Yaoxin_bianwei = &HFF Then
            sgbj.Text2 = SSS
            sgbj.Text3 = ""
            sgbj.Text3 = sgbj.Text3 + Unit_Yx(Addr).YX_NAME(Danyuan_SOE(Addr, i).Yaoxin)
            sgbj.Text3 = Trim(sgbj.Text3) + " " + Unit_Yx(Addr).Yx_0(Danyuan_SOE(Addr, i).Yaoxin)
            SSS = Mid(sgbj.Text2, 1, 40) + sgbj.Text3
            sgbj.Text3 = Unit_Yx(Addr).Yx_0(Danyuan_SOE(Addr, i).Yaoxin)
            If Trim(sgbj.Text3) = "" Then
             sgbj.Text3 = "  " + "遥信" + " " + Format(Danyuan_SOE(Addr, i).Yaoxin, "0") + " " + "分"
             SSS = Mid(SSS, 1, 38) + sgbj.Text3
             YX_byte(Danyuan(Addr).dy_addr) = YX_byte(Danyuan(Addr).dy_addr) And (&HFF - 2 ^ (Danyuan_SOE(Addr, i).Yaoxin - 1))
            End If
           zt = 0
       
            zt = &HFF
          End If
         If Danyuan_SOE(Addr, i).Yaoxin_bianwei = &H0 Then
            If Unit_Yx(Addr).Yx_sy(Danyuan_SOE(Addr, i).Yaoxin) = 1 Then Call send_sg
            If Unit_Yx(Addr).Yx_sy(Danyuan_SOE(Addr, i).Yaoxin) = 2 Then Call send_bj
         

            sgbj.Text2 = SSS
            sgbj.Text3 = ""
            sgbj.Text3 = sgbj.Text3 + Unit_Yx(Addr).YX_NAME(Danyuan_SOE(Addr, i).Yaoxin)
            sgbj.Text3 = Trim(sgbj.Text3) + " " + Unit_Yx(Addr).Yx_1(Danyuan_SOE(Addr, i).Yaoxin)
            SSS = Mid(sgbj.Text2, 1, 40) + sgbj.Text3
                      
            sgbj.Text3 = Unit_Yx(Addr).Yx_1(Danyuan_SOE(Addr, i).Yaoxin)
            If Trim(sgbj.Text3) = "" Then
                sgbj.Text3 = "  " + "遥信" + " " + Format(Danyuan_SOE(Addr, i).Yaoxin, "0") + " " + "合"
             
             SSS = Mid(SSS, 1, 38) + sgbj.Text3
            End If
            YX_byte(Danyuan(Addr).dy_addr) = YX_byte(Danyuan(Addr).dy_addr) Or (2 ^ (Danyuan_SOE(Addr, i).Yaoxin - 1))
            zt = 0
          End If
          TEMP_W = Danyuan_SOE(Addr, i).Yaoxin
              
      End If
    
     If Danyuan_SOE(Addr, i).baojing <> 0 Then '报警遥信
          Y_b = 1
       For Z = 0 To 15
          
        If (Danyuan_SOE(Addr, i).baojing And (2 ^ (Z))) <> 0 Then
               sgbj.Text2 = SSS
               sgbj.Text3 = Trim(Unit_bj(Danyuan(Addr).Dy_type).Bj_Name(Z + 1))
           If Unit_bj(Danyuan(Addr).Dy_type).Bj_sy(Z + 1) = 1 Then Call send_sg
           If Unit_bj(Danyuan(Addr).Dy_type).Bj_sy(Z + 1) = 2 Then Call send_bj
             SSS = Mid(sgbj.Text2, 1, 38) + "  " + sgbj.Text3
              If Z = 0 Then YX_byte(Danyuan(Addr).dy_addr) = YX_byte(Danyuan(Addr).dy_addr) Or 1
              If Z = 1 Then YX_byte(Danyuan(Addr).dy_addr) = YX_byte(Danyuan(Addr).dy_addr) And (&HFF - 1)
            Exit For
         End If
        Next Z
        TEMP_W = Z + 1
     End If
     
        
    If (Danyuan_SOE(Addr, i).Yaoxin <> 0) Then
    If (Unit_Yx(Addr).Yx_Used(TEMP_W) = True) Then
      sgbj.Show
      SetWindowPos sgbj.hwnd, -1, 0, 0, 0, 0, 1 Or 2 Or &H40
      sgbj.Text2.Text = SSS
      sgbj.List1.AddItem SSS
     ' Call writetoprn(1, SSS)
      sgbj.List1.ListIndex = sgbj.List1.ListCount - 1
      Call Save_SG(Save_Addr, Val(Danyuan_SOE(Addr, i).shi), Val(Danyuan_SOE(Addr, i).Fen), Val(Danyuan_SOE(Addr, i).miao), Val(Danyuan_SOE(Addr, i).haomiao), Y_b, zt, TEMP_W)
    End If
    End If
    
    If (Danyuan_SOE(Addr, i).baojing <> 0) Then
     If (Unit_bj(Danyuan(Addr).Dy_type).Bj_Used(TEMP_W)) Then
      sgbj.Show
      SetWindowPos sgbj.hwnd, -1, 0, 0, 0, 0, 1 Or 2 Or &H40
      sgbj.Text2.Text = SSS
      sgbj.List1.AddItem SSS
      'Call writetoprn(1, SSS)
      sgbj.List1.ListIndex = sgbj.List1.ListCount - 1
      Call Save_SG(Save_Addr, Val(Danyuan_SOE(Addr, i).shi), Val(Danyuan_SOE(Addr, i).Fen), Val(Danyuan_SOE(Addr, i).miao), Val(Danyuan_SOE(Addr, i).haomiao), Y_b, zt, TEMP_W)
      End If
     End If
     
   Next i
  Last_SOE_S(Addr) = Val("&H" + Hex$(Danyuan_SOE(Addr, 8).miao) + Hex$(Danyuan_SOE(Addr, 8).haomiao))
  Read_Now_tu
  Shang_enab = True
  
  Read_Yaotiao_dangwei
    For MMM_i = 1 To 5
     If Main_Form.Label4(MMM_i).Visible = True Then Main_Form.Label4(MMM_i).Caption = yt_dangwei(MMM_i)
    Next MMM_i
    
   Case Else
  End Select
    End If
' Exit Sub
'ASW_ERR:
' Select Case Err.Number
'  Case 40006 '客户退出
'   'MsgBox "ERROR" + Str(Err.Number) + "     " + Str(NET_I)
 ' Main_Form.Server(NET_I).Close
 ' Unload Main_Form.Server(NET_I)
 ' InUsed(NET_I) = False
 ' Main_Form.Check1(NET_I).Value = 0
 ' Case Else
 ' End Select
 'Exit Sub
End Sub

Function Jiaoyan(T As String) As Integer
 Dim Temp_A As Integer
 Dim i As Integer
 For i = 7 To LenB(T) - 3
   Temp_A = Temp_A + AscB(MidB(T, i, 1))
 Next i
 If (AscB(MidB(T, LenB(T) - 2, 1)) = Temp_A Mod 256) And (AscB(MidB(T, LenB(T) - 1, 1)) = Temp_A \ 256) Then
  Jiaoyan = 1
 Else
  Jiaoyan = 0
 End If
End Function
Function Duishi() As String
Dim S() As Byte
Dim SSS As String
S = ChrB(&HEB) + ChrB(&H90) + ChrB(&H9) + ChrB(255) + ChrB(0) + ChrB(&HAA) + ChrB(Hour(Now)) + ChrB(Minute(Now)) + ChrB(Second(Now)) + ChrB(0) + ChrB(0)
SSS = S
For i = 3 To LenB(SSS) - 2
  A = A + AscB(MidB(SSS, i, 1))
Next i
S = ChrB(&HEB) + ChrB(&H90) + ChrB(&H9) + ChrB(&HFF) + ChrB(0) + ChrB(&HAA) + ChrB(Hour(Now)) + ChrB(Minute(Now)) + ChrB(Second(Now)) + ChrB(A Mod 256) + ChrB(A \ 256)
Duishi = S
End Function
Public Function Clear_Alarm(Dy_add As Integer) As String
Dim i As Integer
Dim Total As Integer
Dim S() As Byte
Dim SSS As String
Dim T_S As String
Dim L As Integer
Dim H As Integer
Dim T_L As Long
If Baojing_I(Dy_add) < 0 Then
 T_L = 65536 + Baojing_I(Dy_add)
Else
 T_L = Baojing_I(Dy_add)
End If
L = T_L Mod 256
H = T_L \ 256
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H8) + ChrB(Dy_add) + ChrB(&HFF - Dy_add) + ChrB(&H3C) + ChrB(L) + ChrB(H) + ChrB(0) + ChrB(0)
SSS = S
Total = 0
For i = 3 To LenB(SSS)
  Total = Total + AscB(MidB(SSS, i, 1))
Next i
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H8) + ChrB(Dy_add) + ChrB(&HFF - Dy_add) + ChrB(&H3C) + ChrB(L) + ChrB(H) + ChrB(Total Mod 256) + ChrB(Total \ 256)
Clear_Alarm = S
End Function

Sub Save_SG(T_addr As Integer, T_Shi As Integer, T_fen As Integer, T_miao As Integer, T_haomiao As Integer, Y_b As Integer, zt As Integer, T_wei As Integer) '站号,事故号,变化
 Dim sg_n As Save_SG_Name
 Dim FileName As String
 Dim FileNum
 Dim File_num
 On Error Resume Next
 FileName = "c:\" + Format(Year(Now), "0000")
 If Dir(FileName) <> "" Then
 Else
  MkDir (FileName)
 End If
 FileName = FileName & "\" & Format(Month(Now), "00")
 If Dir(FileName) <> "" Then
 Else
 MkDir (FileName)
 End If
 FileName = FileName & "\" & Format(Day(Now), "00") & ".sg"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(sg_n)
 File_num = LOF(FileNum) / Len(sg_n)
 sg_n.address = T_addr
 sg_n.shi = T_Shi
 sg_n.Fen = T_fen
 sg_n.miao = T_miao
 sg_n.haomiao = T_haomiao
 sg_n.wei = T_wei
 sg_n.Yx_bj = Y_b
 sg_n.zhuantai = zt
 Put FileNum, File_num + 1, sg_n
 Close FileNum
 End Sub
Public Function Write_Dingzhi(address As Integer, Td As Integer, zhi As Integer, shuxing As Integer) As String
Dim S() As Byte
Dim Total As Integer
Dim i As Integer
Dim SSS As String
If address > 255 Then Exit Function
S = ChrB(&HEB) + ChrB(&H90) + ChrB(&HA) + ChrB(address) + ChrB(255 - address) + ChrB(&H3) + ChrB(Td) + ChrB(shuxing) + ChrB(zhi Mod &H100) + ChrB(zhi \ &H100) + ChrB(0) + ChrB(0)
SSS = S
Total = 0
For i = 3 To LenB(SSS)
 Total = Total + AscB(MidB(SSS, i, 1))
Next i
S = ChrB(&HEB) + ChrB(&H90) + ChrB(&HA) + ChrB(address) + ChrB(255 - address) + ChrB(&H3) + ChrB(Td) + ChrB(shuxing) + ChrB(zhi Mod &H100) + ChrB(zhi \ &H100) + ChrB(Total Mod 256) + ChrB(Total \ 256)
Write_Dingzhi = S
End Function
Sub Read_Yx(Addr As Integer)
 Dim FileName As String
 Dim FileNum
 Dim i As Integer
 If (Addr < 1) Or (Addr > 255) Then Exit Sub
 FileName = App.Path + "\" + "Yaoxin.dat"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Unit_Yx(1))
   Get FileNum, Addr, Unit_Yx(Addr)
 Close FileNum
End Sub
Sub AdjustTokenPrivilegesForNT()

    Dim hdlProcessHandle As Long
    Dim hdlTokenHandle As Long
    Dim tmpLuid As LUID
    Dim tkp As TOKEN_PRIVILEGES
    Dim tkpNewButIgnored As TOKEN_PRIVILEGES
    Dim lBufferNeeded As Long
  
    hdlProcessHandle = GetCurrentProcess()
    OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
                     TOKEN_QUERY), hdlTokenHandle

    LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
    tkp.PrivilegeCount = 1
    tkp.Privileges(0).pLuid = tmpLuid
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

    AdjustTokenPrivileges hdlTokenHandle, False, tkp, _
                          Len(tkpNewButIgnored), tkpNewButIgnored, _
                          lBufferNeeded
 End Sub
Function Read_cl_zb() As Integer
 Dim FileName As String
 Dim FileNum
 Dim i As Integer
  FileName = App.Path + "\" + "chaoliu.dat"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Disp_Chaoliu(1))
    Max_CL_shu = LOF(FileNum) / Len(Disp_Chaoliu(1))
    For i = 1 To Max_CL_shu
     Get FileNum, i, Disp_Chaoliu(i)
    Next i
 Close FileNum
  Read_cl_zb = Max_CL_shu
   
End Function
Sub Read_Now_tu()
Dim Addr As Integer
Dim Yx_Xh As Integer
Dim Yx_liang As Integer
Dim Tu_xh As Integer
On Error Resume Next
 For i = 1 To Max_KG_shu
  If Disp_KG(i).Visible = True Then
   Addr = Danyuan(Disp_KG(i).Danyuan_xh).dy_addr '单元地址 ,开入板号
    Yx_Xh = Disp_KG(i).Yaoxin_xh
    Tu_xh = Disp_KG(i).Tuxing_xh
    KG_Flag_2(i) = KG_Flag(i)
  Select Case Disp_KG(i).Danyuan_Type
  Case 1
     Yx_liang = YX_byte(Addr)
  Case 2
  Case 3
      Yx_liang = Krb_i(Addr)
  Case 4
      Yx_liang = Dy_DlQ(Addr)
      
  End Select
    If (Yx_liang And (2 ^ (Yx_Xh - 1))) <> 0 Then
      Main_Form.KG(i).Picture = Main_Form.KG_h(Tu_xh).Picture
      KG_Flag(i) = 1
     Else
      Main_Form.KG(i).Picture = Main_Form.KG_f(Tu_xh).Picture
      KG_Flag(i) = 0
    End If
    
  End If
 Next i
 End Sub


Sub Save_Chaoliu()
Dim FileName As String
Dim FileNum
Dim Temp_s As Integer
Dim i As Integer
Dim J  As Integer
On Error Resume Next

 FileName = "c:\" + Format(Year(Now), "0000")
 If Dir(FileName) <> "" Then
 Else
  MkDir (FileName)
 End If
 FileName = FileName & "\" & Format(Month(Now), "00")
 If Dir(FileName) <> "" Then
 Else
 MkDir (FileName)
 End If
 
 FileName = FileName & "\" & Format(Day(Now), "00") & ".YUN"
 FileNum = FreeFile
 If Dir(FileName) = "" Then
  For i = 1 To 32
     For J = 1 To 15
        Save_Baobiao.Chaoliu(i, J) = 0
      Next J