module1.bas

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

 Next i
  Open FileName For Random As FileNum Len = Len(Save_Baobiao)
    
    For Z = 1 To 144
       Put FileNum, Z, Save_Baobiao
    Next Z
   Close FileNum
 End If
 
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Save_Baobiao)
 Temp_s = (Hour(Now) * 6 + Minute(Now) \ 10)
  For i = 1 To 32
   For J = 1 To 15
       Save_Baobiao.Chaoliu(i, J) = Celiang_SJ(i, J)
    Next J
 Next i
 Put FileNum, Temp_s + 1, Save_Baobiao
Close FileNum

End Sub

Sub Read_Czkl()
Dim FileName As String
Dim FileNum
Dim A
FileName = App.Path + "\" + "kouling.dat"
FileNum = FreeFile
Open FileName For Random As FileNum Len = Len(Czry(1))
 For i = 1 To 17
  Get FileNum, i, Czry(i)
 Next i
Close FileNum

End Sub
Sub read_bb_name()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "bbdy.dat"
FileNum = FreeFile
Open FileName For Random As FileNum Len = Len(Baobiao_tou(1))
 For i = 1 To 120
  Get FileNum, i, Baobiao_tou(i)
 Next i
Close FileNum
End Sub
Sub read_dd_name()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "dddy.dat"
FileNum = FreeFile
Open FileName For Random As FileNum Len = Len(Diandu_tou(1))
 For i = 1 To 120
  Get FileNum, i, Diandu_tou(i)
 Next i
Close FileNum

End Sub
Sub Read_Chaoliu(yyyy As Integer, mm As Integer, dd As Integer)
Dim FileName As String
Dim FileNum
Dim Temp_s As Integer
Dim i As Integer
On Error Resume Next
FileName = "C:\" & Format(yyyy, "0000") & "\" & Format(mm, "00") & "\" & Format(dd, "00") & ".yun"
FileNum = FreeFile
 If Dir(FileName) = "" Then
   Exit Sub
 End If
Open FileName For Random As FileNum Len = Len(Save_Baobiao)
For i = 1 To 144  '时间
  Get FileNum, i, Get_Baobiao(i)
Next i
Close FileNum
End Sub
Public Sub send_bj()
Dim S() As Byte
S = Send_command(Sound_Address, &HBB)
Main_Form.Main_Com(0).Output = S
S = Send_command(Sound_Address, &HB0)
Main_Form.Main_Com(0).Output = S
Bjys = BjYanshi
End Sub
Public Sub send_sg()
Dim S() As Byte
S = Send_command(Sound_Address, &HCC)
Main_Form.Main_Com(0).Output = S
S = Send_command(Sound_Address, &HC0)
Main_Form.Main_Com(0).Output = S
Bjys = BjYanshi
End Sub
Sub Read_CL_XS()
Dim Addr As Integer
For Addr = 1 To Danyuanshu
   For J = 1 To 255
    If Danyuan(J).dy_addr = Addr Then '单元序号
        dy_xh = J
     Exit For
    End If
    Next J
    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
Next Addr
End Sub
Sub Save_diandu()
Dim FileName As String
Dim FileNum
Dim Temp_s As Integer
Dim i As Integer
Dim J  As Integer
Dim S() As Byte
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") & ".D_d"
 FileNum = FreeFile
If Dir(FileName) = "" Then
  For i = 1 To 32
  For J = 1 To 6
  Save_Now_Diandu.Diandu(i, J) = 0
  Next J
  Next i
  For i = 1 To 24
     Open FileName For Random As FileNum Len = Len(Save_Now_Diandu)
     Put FileNum, i, Save_Now_Diandu
  Next i
   Close FileNum
End If
Temp_s = Hour(Now) + 1

Open FileName For Random As FileNum Len = Len(Save_Now_Diandu)
  For i = 1 To 32
   For J = 1 To 4
    Save_Now_Diandu.Diandu(i, J) = Jifen_diandu(i).Diandu(J)
    Next J
    For J = 5 To 6
     Save_Now_Diandu.Diandu(i, J) = Maichong_diandu(i).Diandu(J - 4)
    Next J
  Next i
 Put FileNum, Temp_s, Save_Now_Diandu
Close FileNum
If Main_Form.Main_Com(0).PortOpen = True Then
'S = set_jf(&HFF)
Main_Form.Main_Com(0).Output = S
End If

End Sub
Sub Read_yfjd()
Dim FileName As String
Dim FileNum
 FileName = App.Path + "\" + "yfjd.dat"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Yfjd)
   Get FileNum, 1, Yfjd
 Close FileNum
 If (Yfjd.address) > 256 Or (Yfjd.address < 1) Then Yfjd.address = 1
 If (Yfjd.wei > 8) Or (Yfjd.wei < 1) Then Yfjd.wei = 1
End Sub
Sub read_Tyzz()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "Ty.dat"
FileNum = FreeFile

Open FileName For Random As FileNum Len = Len(Ty_zz(1))
For i = 1 To 5
 Get FileNum, i, Ty_zz(i)
Next i
Close FileNum

End Sub

Sub Read_Yaotiao_dangwei()
Dim A As Integer
Dim i As Integer
Dim T As Integer
Dim M As Integer
Dim k As Integer

 For i = 1 To 5
  yt_dangwei_2(i) = 0
  If Ty_zz(i).bcd = 1 Then
   A = 0
   For T = 1 To 6
    If (Ty_zz(i).dangwei_danyuan(T) < 1) Or (Ty_zz(i).dangwei_danyuan(T) > 128) Then Ty_zz(i).dangwei_danyuan(T) = 1
      M = YX_byte(A)
      If (M And (2 ^ (Ty_zz(i).dangwei_zijie(T) - 1))) = 0 Then k = 0
      If (M And (2 ^ (Ty_zz(i).dangwei_zijie(T) - 1))) <> 0 Then k = 1
      yt_dangwei_2(i) = yt_dangwei_2(i) + k * 10 ^ (T - 1)
    Next T
     yt_dangwei(i) = Itobcd(yt_dangwei_2(i))
  Else
   yt_dangwei(i) = 0
   For T = 1 To 19
   If (Ty_zz(i).dangwei_danyuan(T) < 1) Or (Ty_zz(i).dangwei_danyuan(T) > 128) Then Ty_zz(i).dangwei_danyuan(T) = 1
      M = YX_byte(Ty_zz(i).dangwei_danyuan(T))
      If (M And (2 ^ (Ty_zz(i).dangwei_zijie(T) - 1))) <> 0 Then
         yt_dangwei(i) = T
         Exit For
      End If
   Next T
  End If
Next i
End Sub
Function Itobcd(ByVal MMM As Long) As Integer
Dim A As Long
Static w(1 To 6) As Integer
Static T(1 To 2) As Integer
Dim ttt As String

w(6) = MMM \ 100000
w(5) = MMM \ 10000 - w(6) * 10
w(4) = MMM \ 1000 - w(6) * 100 - w(5) * 10
w(3) = MMM \ 100 - w(6) * 1000 - w(5) * 100 - w(4) * 10
w(2) = MMM \ 10 - w(6) * 10000 - w(5) * 1000 - w(4) * 100 - w(3) * 10
w(1) = MMM - w(6) * 100000 - w(5) * 10000 - w(4) * 1000 - w(3) * 100 - w(2) * 10
T(1) = w(6) * 2 + w(5)
T(2) = 0
For i = 1 To 4
 T(2) = T(2) + w(i) * (2 ^ (i - 1))
Next i
Itobcd = T(1) * 10 + T(2)

End Function

Sub Save_Caozuo(KG As String, Style As Integer, czr As String)
 Dim Caozuo_1 As Caozuotype
 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") & ".cz"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Caozuo_1)
 File_num = LOF(FileNum) / Len(Caozuo_1)
 Caozuo_1.kg_name = KG
 Caozuo_1.shi = Hour(Now)
 Caozuo_1.Fen = Minute(Now)
 Caozuo_1.miao = Second(Now)
 Caozuo_1.Zhuangtai = Style
 Caozuo_1.caozuoren = czr
 Put FileNum, File_num + 1, Caozuo_1
 Close FileNum
End Sub
Public Sub Read_HwYx()
  Dim FileName As String
  Dim FileNum
  FileName = App.Path + "\" + "Hwyx.dat"
  FileNum = FreeFile
  Open FileName For Random As FileNum Len = Len(Huawei_yx(1))
   For i = 1 To 512
     Get FileNum, i, Huawei_yx(i)
   Next i
  Close FileNum
 
End Sub
Public Sub Save_gzlb(address As Integer)
 Dim FileName As String
 Dim FileNum
 Dim File_num 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") & ".glb"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Unit_gzlb(address))
   File_num = LOF(FileNum) / Len(Unit_gzlb(address))
   Unit_gzlb(address).Gz_Address = address
   Put FileNum, File_num + 1, Unit_gzlb(address)
  Close FileNum
End Sub
Function set_jfdd(address As Integer, V1 As Single, V2 As Single, V3 As Single, V4 As Single) As String
Dim S1(3) As Byte
Dim S2(3) As Byte
Dim S3(3) As Byte
Dim S4(3) As Byte
Dim Temp_s1 As String
Dim Temp_s2 As String
Dim Temp_s3 As String
Dim Temp_s4 As String
Dim A As Integer
Dim i As Integer
Dim Temp_s As String * 12
Dim Wu_s As String
  RtlMoveMemory S1(0), V1, 4
  RtlMoveMemory S2(0), V2, 4
  RtlMoveMemory S3(0), V3, 4
  RtlMoveMemory S4(0), V4, 4
Wu_s = ChrB(&HEB) + ChrB(&H90) + ChrB(22) + ChrB(address) + ChrB(255 - address) + ChrB(&H1E)
Temp_s1 = S1
Temp_s2 = S2
Temp_s3 = S3
Temp_s4 = S4
Temp_s = Wu_s + Temp_s1 + Temp_s2 + Temp_s3 + Temp_s4 + ChrB(0) + ChrB(0)

For i = 3 To LenB(Temp_s)
  A = A + AscB(MidB(Temp_s, i, 1))
Next i

 MidB(Temp_s, 23, 1) = ChrB(A Mod 256)
 MidB(Temp_s, 24, 1) = ChrB(A \ 256)
set_jfdd = Temp_s
End Function
Function Set_Mcdd(address As Integer, V1 As Long, V2 As Long, V3 As Long, V4 As Long) As String
Dim S1(3) As Byte
Dim S2(3) As Byte
Dim S3(3) As Byte
Dim S4(3) As Byte
Dim Temp_s1 As String
Dim Temp_s2 As String
Dim Temp_s3 As String
Dim Temp_s4 As String
Dim A As Integer
Dim i As Integer
Dim Temp_s As String * 12
Dim Wu_s As String
  RtlMoveMemory S1(0), V1, 4
  RtlMoveMemory S2(0), V2, 4
  RtlMoveMemory S3(0), V3, 4
  RtlMoveMemory S4(0), V4, 4
Wu_s = ChrB(&HEB) + ChrB(&H90) + ChrB(22) + ChrB(address) + ChrB(255 - address) + ChrB(&H1D)
Temp_s1 = S1
Temp_s2 = S2
Temp_s3 = S3
Temp_s4 = S4
Temp_s = Wu_s + Temp_s1 + Temp_s2 + Temp_s3 + Temp_s4 + ChrB(0) + ChrB(0)

For i = 3 To LenB(Temp_s)
  A = A + AscB(MidB(Temp_s, i, 1))
Next i

 MidB(Temp_s, 23, 1) = ChrB(A Mod 256)
 MidB(Temp_s, 24, 1) = ChrB(A \ 256)
Set_Mcdd = Temp_s
End Function

Function qiumi(MMM As Integer) As Integer
  Dim A As Integer
  Dim XXX As Integer
  A = 0
  XXX = MMM
  For i = 1 To 16
    XXX = XXX \ 2
    A = A + 1
    If XXX = 0 Then Exit For
  Next i
  qiumi = A
End Function
Sub Read_wsbt()
 On Error Resume Next
    FileName = App.Path + "\" + "wsbt.dat"
     FileNum = FreeFile
     Open FileName For Random As FileNum Len = Len(WSBT_Name(1))
     For i = 1 To 16
       Get FileNum, i, WSBT_Name(i)
      Next i
      Close FileNum
End Sub
Sub Save_Ws_string()
Dim S() As Byte
Dim i As Integer
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
 For i = 1 To 16
 If LenB(WeiSheng_String(i)) = 91 Then
   S = MidB(WeiSheng_String(i), 10, 80)
   RtlMoveMemory Weisheng_Biao(i), S(0), 80
   Save_Ws_data.Zxyg(i) = Weisheng_Biao(i).GongLv(1)
   Save_Ws_data.Gxwg(i) = Weisheng_Biao(i).GongLv(6)
   Save_Ws_data.Rxwg(i) = Weisheng_Biao(i).GongLv(11)
   Save_Ws_data.Fxyg(i) = Weisheng_Biao(i).GongLv(16)
 End If
Next i
FileName = FileName & "\" & Format(Day(Now), "00") & ".wsb"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Save_Ws_data)
  Put FileNum, 1, Save_Ws_data
 Close FileNum
End Sub