module1.bas

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

Public Rs_485(0 To 32) As Unit_Prop
Public Rs_422(0 To 32) As Unit_Prop
Public Shezhi_485(0 To 32) As String
Public Shezhi_422(0 To 32) As String
Public Send_Flag(0 To 255) As Integer
Public Send_Flag_2(0 To 255) As Integer
Public CT(0 To 255) As Integer
Public PT(0 To 255) As Integer
Public Main_In_String(1 To 4) As String

Public Danyuan_SOE(0 To 255, 0 To 8) As SOE_BJ
Public Dingzhi_Num(0 To 255) As Integer
Public Weisheng_C(0 To 32) As Integer
Public XSBW As Boolean
Public TxvW_flag  As Boolean
Public Celiang_SJ(0 To 255, 0 To 32) As Integer
Public Celiang_XS(0 To 255, 0 To 32) As Single
Public Celiang_String(0 To 255) As String
Public Yaoxin_String(0 To 255) As String
Public Dingzhi_String(0 To 255) As String
Public Maichong_String(0 To 128) As String
Public Jifen_String(0 To 128) As String

Public WeiSheng_String(0 To 128) As String

Public Wendu_String(0 To 128) As String
Public Weisheng_Shunshi_String(0 To 128) As String
Public WSBT_Name(1 To 32) As Ws_name

Public SOE_String(0 To 128, 1 To 9) As String
Public Unit_leixing(0 To 128) As String
Public Time_Int(0 To 16) As Integer
Public WEEK_NAME(0 To 7) As String
Public MeitianJilu(0 To 500) As Save_SG_Name
Public TXCS_Dy(0 To 128) As Integer
Public TXGZ(0 To 128) As Boolean
Public TX_Enabled(0 To 128) As Boolean
Public CL_Index As Integer
Public Label_C As Integer
Public KG_C As Integer
Public Image_C As Integer
Public Rs_232_In_string As String
Public Rs_232_yx(1 To 16, 1 To 4) As Integer
Public Plc_Send_Flag(0 To 100) As Integer
Public SC_flag As Integer

Public Init_yb(0 To 255) As Integer '初始化标志 0表示没有初始化 1表示已经初始化 且为0时不报警

Public Yaoxin_Liang(0 To 255, 0 To 16) As Integer '遥信量
Public Baojing_Liang(0 To 255, 0 To 16) As Integer '报警量

Public Temp_Yaoxin_Liang(0 To 255, 0 To 16) As Integer '临时遥信量
Public Temp_Baojing_Liang(0 To 255, 0 To 16) As Integer '临时报警量

Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long


Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Declare Sub RtlMoveMemory Lib "kernel32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SendMessageBynum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SendMessageBystring Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function TestPrint Lib "Mydll" () As Integer

Sub Read_WS_XS()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "wsxs.dat"
FileNum = FreeFile
For i = 1 To 20
Open FileName For Random As FileNum Len = Len(Weishen_value_Unit(1))
 Get FileNum, i, Weishen_value_Unit(i)
 For T = 1 To 8
 Weishen_value_Unit(i).Cl_Value(T) = 0
Next T
Close FileNum
Next i
End Sub
Function Read_kg_zb() As Integer
Dim FileName As String
 Dim FileNum
 Dim i As Integer
  FileName = App.Path + "\" + "KAIGUAN.DAT"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Disp_KG(1))
    Max_KG_shu = LOF(FileNum) / Len(Disp_KG(1))
    For i = 1 To Max_KG_shu
     Get FileNum, i, Disp_KG(i)
    Next i
 Close FileNum
  Read_kg_zb = Max_KG_shu
End Function
Sub Read_Rs485()
Dim FileName As String
Dim FileNum
On Error Resume Next
FileName = App.Path + "\" + "Rs485.Set"
FileNum = FreeFile
Open FileName For Input As FileNum
  For i = 1 To 25
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   Rs_485(i).Mingcheng = FileName
  
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   If Val(FileName) < 0 Then Exit For
   Rs_485(i).Leixing = Val(FileName)
      
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   If Val(FileName) < 0 Then Exit For
   Rs_485(i).Dizhi = Val(FileName)
     
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   If Val(FileName) < 0 Then Exit For
   Rs_485(i).botelv = Val(FileName)
     
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   Rs_485(i).Jiaoyan = FileName
     
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   Rs_485(i).ShuJuwei = Val(FileName)
      
   Input #FileNum, FileName
   If (FileName = "-1") Or (FileName = "") Then Exit For
   Rs_485(i).Tingzhiwei = Val(FileName)
   Shezhi_485(i) = Str(Rs_485(i).botelv) + "," + Rs_485(i).Jiaoyan + "," + Str(Rs_485(i).ShuJuwei) + "," + Str(Rs_485(i).Tingzhiwei)
   Next i
   RS_485_DanyuanShu = i - 1
Close FileNum
End Sub
Public Function Call_shigu(Dy_add As Integer) As String
Dim S() As Byte
Dim SSS As String
 S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H6) + ChrB(Dy_add) + ChrB(&HFF - Dy_add) + ChrB(&HEA) + ChrB(&HEF) + ChrB(&H1)
 SSS = S
 Call_shigu = SSS
End Function
Sub Read_Txsz()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "Txsz.dat"
FileNum = FreeFile
Open FileName For Random As FileNum Len = Len(Tongxinduankou(1))
 For i = 1 To 4
   Get FileNum, i, Tongxinduankou(i)
 Next i
Close FileNum
End Sub
Public Function Call_celiang(Dy_add As Integer) As String
Dim S() As Byte
Dim SSS As String
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H6) + ChrB(Dy_add) + ChrB(&HFF - Dy_add) + ChrB(&H66) + ChrB(&H6B) + ChrB(&H1)
Call_celiang = S
End Function
Public Function Send_command(Dy_add As Integer, command As Integer) As String
Dim S() As Byte
Dim SSS As String
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H6) + ChrB(Dy_add) + ChrB(&HFF - Dy_add) + ChrB(command) + ChrB(&H0) + ChrB(&H0)
SSS = S
For i = 3 To LenB(SSS)
  A = A + AscB(MidB(SSS, i, 1))
Next i
 S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H6) + ChrB(Dy_add) + ChrB(&HFF - Dy_add) + ChrB(command) + ChrB(A Mod &H100) + ChrB(A \ &H100)
 SSS = S
Send_command = SSS
End Function
Function Send_zbwdcommand(dy_addr As Integer) As String
Dim S() As Byte
Dim SSS As String
S() = ChrB(&H80 + dy_addr) + ChrB(&H80 + dy_addr) + ChrB(&H52) + ChrB(&HC) '+ ChrB(&H80 + dy_addr + 1) + ChrB(&H80 + dy_addr + 1) + ChrB(&H52) + ChrB(&HC)
SSS = S
Send_zbwdcommand = SSS

End Function
Public Function set_jf(dy_addr As Integer)
Dim S() As Byte
Dim SSS As String
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H16) + ChrB(dy_addr) + ChrB(&HFF - dy_addr) + ChrB(&H1E) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0)
SSS = S
For i = 3 To LenB(SSS)
  A = A + AscB(MidB(SSS, i, 1))
Next i
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&H16) + ChrB(dy_addr) + ChrB(&HFF - dy_addr) + ChrB(&H1E) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(A Mod &H100) + ChrB(A \ &H100)
SSS = S
set_jf = SSS
End Function
Public Function set_maichong(dy_addr As Integer)
 Dim S() As Byte
Dim SSS As String
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&HE) + ChrB(dy_addr) + ChrB(&HFF - dy_addr) + ChrB(&H1D) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0)
SSS = S
For i = 3 To LenB(SSS)
  A = A + AscB(MidB(SSS, i, 1))
Next i
S() = ChrB(&HEB) + ChrB(&H90) + ChrB(&HE) + ChrB(dy_addr) + ChrB(&HFF - dy_addr) + ChrB(&H1D) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(0) + ChrB(0) + ChrB(&H0) + ChrB(A Mod &H100) + ChrB(A \ &H100)
SSS = S
set_maichong = SSS

End Function
Public Function CRC(S() As Byte) As Integer
Dim SSS As String
Dim AL As Integer
AL = 0
If UBound(S) < 4 Then Exit Function
For i = 0 To UBound(S) - 1
SSS = SSS + ChrB(S(i))
 AL = AL Xor AscB(MidB(SSS, i + 1, 1))
For J = 1 To 8
 AL = AL * 2
  If AL > &HFF Then AL = AL Xor &H107
 Next J
 Next i
CRC = AL Xor &HFF
End Function
Public Function Wei_Sheng(address As Integer, CMD As Integer, length As Integer) As String
Dim SSS As String
Dim w() As Byte
Dim Temp_Sum   As Integer
w() = ChrB(address) + ChrB(&H55) + ChrB(CMD Mod 256) + ChrB(CMD \ 256) + ChrB(length) + ChrB(0) + ChrB(&HD)
SSS = w
Temp_Sum = 0
For i = 1 To 5
   Temp_Sum = Temp_Sum + AscB(MidB(SSS, i, 1))
Next i
w() = ChrB(address) + ChrB(&H55) + ChrB(CMD Mod 256) + ChrB(CMD \ 256) + ChrB(length) + ChrB(Temp_Sum Mod 256) + ChrB(&HD)
Wei_Sheng = w
End Function
Sub Read_Rs422()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "Rs422.Set"
FileNum = FreeFile
Open FileName For Input As FileNum
    For i = 1 To 25
     Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      Rs_422(i).Mingcheng = FileName
     
     Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      If Val(FileName) < 0 Then Exit For
      Rs_422(i).Leixing = Val(FileName)
      
     Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      If Val(FileName) < 0 Then Exit For
      Rs_422(i).Dizhi = Val(FileName)
     
     
     Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      If Val(FileName) < 0 Then Exit For
      Rs_422(i).botelv = Val(FileName)
     
     
     Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      Rs_422(i).Jiaoyan = FileName
      
     Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      Rs_422(i).ShuJuwei = Val(FileName)
      
      Input #FileNum, FileName
      If (FileName = "-1") Or (FileName = "") Then Exit For
      Rs_422(i).Tingzhiwei = Val(FileName)
      Shezhi_422(i) = Str(Rs_422(i).botelv) + "," + Rs_422(i).Jiaoyan + "," + Str(Rs_422(i).ShuJuwei) + "," + Str(Rs_422(i).Tingzhiwei)
      Next i
         RS_422_DanyuanShu = i - 1
Close FileNum
End Sub
Sub Read_time()
Dim FileName As String
Dim FileNum
FileName = App.Path + "\" + "time.dat"
FileNum = FreeFile
Open FileName For Random As FileNum Len = Len(Time_Int(1))
For i = 1 To 8
 Get FileNum, i, Time_Int(i)
Next i
Close FileNum
End Sub
Sub Set_Focus(A As TextBox)
 A.SelStart = 0
 A.SelLength = Len(A)
End Sub
Sub Read_Unit()
Dim FileName As String
Dim S2 As Integer
Static AAA(3) As Integer
Dim FileNum
For i = 1 To 3
 DANYUAN_FSGS(i) = 0
 AAA(i) = 0
Next i
 
 FileName = App.Path + "\" + "Unit.dat"
 FileNum = FreeFile
 Open FileName For Random As FileNum Len = Len(Danyuan(1))
  For i = 1 To 32
    Get FileNum, i, Danyuan(i)
    If Trim(Danyuan(i).Dy_Name) = "" Then Exit For
   
     If (Danyuan(i).Dy_Duankou > 3) Or (Danyuan(i).Dy_Duankou < 1) Then Danyuan(i).Dy_Duankou = 1
      DANYUAN_FSGS(Danyuan(i).Dy_Duankou) = DANYUAN_FSGS(Danyuan(i).Dy_Duankou) + 1
      AAA(Danyuan(i).Dy_Duankou) = AAA(Danyuan(i).Dy_Duankou) + 1
     DANYUAN_FSSX(Danyuan(i).Dy_Duankou, AAA(Danyuan(i).Dy_Duankou)) = Danyuan(i).dy_addr
   '  T = Danyuan(i).Dy_type
   Next i
 Danyuanshu = i - 1
 Close FileNum
End Sub
Sub Read_leixing()
FileName = App.Path + "\" + "Lexing.dat"
  FileNum = FreeFile
  Open FileName For Random As FileNum Len = Len(Danyuan_Leixing(1))
   For i = 1 To 32
    Get FileNum, i, Danyuan_Leixing(i)
    Next i
  Close FileNum
End Sub
Sub Read_Dz_Num(Type_num As Integer)
Dim FileName As String
Dim FileNum
On Error Resume Next
FileName = App.Path + "\" + "dz" + Format(Type_num, "00") + ".dat"
If Dir(FileName) = "" Then
MsgBox FileName + "不存在！"
Else
FileNum = FreeFile
Open FileName For Input As FileNum
For i = 1 To 104
  Input #FileNum, File_Name
  If File_Name = "-1" Then Exit For
   Dingzhi(Type_num, i).dz_name = File_Name
  Input #FileNum, File_Name
    Dingzhi(Type_num, i).Dz_Datatype = Val(File_Name)
  Input #FileNum, File_Name
    Dingzhi(Type_num, i).Dz_Xishu = Val(File_Name)
Next i
Dingzhi_Num(Type_num) = i - 1
Close (FileNum)
End If
End Sub
Sub Read_CL_Num(Type_num As Integer)
Dim FileName As String
Dim FileNum
On Error Resume Next
FileName = App.Path + "\" + "CL" + Format(Type_num, "00") + ".txt"
If Dir(FileName) = "" Then
MsgBox FileName + "不存在！"
Else
FileNum = FreeFile
Open FileName For Input As FileNum
For i = 1 To 40 '测量个数
  Input #FileNum, FileName
  If FileName = "-1" Then Exit For
   CeLiang(Type_num, i).Cl_Name = FileName
  Input #FileNum, FileName
    CeLiang(Type_num, i).CL_Type = Val(FileName)
  Input #FileNum, FileName
    CeLiang(Type_num, i).CL_Danwei = FileName
  Next i
 Celiang_Num(Type_num) = i - 1
Close (FileNum)
End If
End Sub
Sub Read_bj_name(Type_num As Integer)
Dim FileName As String
Dim FileNum
On Error Resume Next
FileName = App.Path + "\" + "BJ" + Format(Type_num, "00") + ".txt"
If Dir(FileName) = "" Then
MsgBox FileName + "不存在！"
Else
FileNum = FreeFile
Open FileName For Random As FileNum Len = Len(Unit_bj(1))
     Get #FileNum, 1, Unit_bj(Type_num)
 Close FileNum
End If
End Sub
Function WenDu(Addr As Integer) As String
 Dim S() As Byte
 Dim SSS As String
 Dim S2 As String
 Dim J_s As String
 Dim i As Integer
 Dim J As Integer
 Dim Temp_s As String
 If Addr > 16 Then
     Temp_s = Hex$(Addr)
 Else
     Temp_s = "0" + Hex$(Addr)
 End If
 
 SSS = "@" + Temp_s + "RD"
 For i = 1 To Len(SSS)
     S2 = S2 + ChrB(Asc(Mid(SSS, i, 1)))
 Next i
 
 For i = 2 To LenB(S2)
      J = J Xor AscB(MidB(S2, i, 1))
 Next i
  
 If J > 16 Then
     J_s = Hex$(J) + Chr(&HD)
 Else
     J_s = "0" + Hex$(J) + Chr(&HD)
 End If
  For i = 1 To Len(J_s)
     S2 = S2 + ChrB(Asc(Mid(J_s, i, 1)))
 Next i
  WenDu = S2
End Function
Sub Set_wendu(Wd_s As String)
Dim ADD_R As Integer
Dim S As String
ADD_R = Chr(Val("&H" + Hex$(AscB(MidB(Wd_s, 3, 1)))))
For i = 1 To 7
   S = MidB(Wendu_String(ADD_R), (i - 1) * 6 + 8, 4)
   WenDu_Unit(ADD_R).Shuju(i) = Val("&H" + Chr(Val("&h" + Hex$(AscB(MidB(S, 3, 1))))) + Chr(Val("&h" + Hex$(AscB(MidB(S, 4, 1))))) + Chr(Val("&h" + Hex$(AscB(MidB(S, 1, 1))))) + Chr(Val("&h" + Hex$(AscB(MidB(S, 2, 1))))))
   S = MidB(Wendu_String(ADD_R), (i - 1) * 6 + 12, 4)
   WenDu_Unit(ADD_R).XS(i) = Val("&H" + Chr(Val("&h" + Hex$(AscB(MidB(S, 1, 1))))) + Chr(Val("&h" + Hex$(AscB(MidB(S, 2, 1))))))
Next i
End Sub
Sub Read_In_String(T As String)
  Dim C_W As Integer
  Dim Addr As Integer
  Dim C_L As Integer
  Dim SSS As String
  Dim Temp_s(3) As Byte
  Dim Temp_L As Long
  Dim Temp_T As Integer
  Dim M As Integer
  Dim i As Integer
  Dim tt As Integer
  Dim Temp_str As String
  Dim Temp_type As Integer
  Dim Temp_jf() As Byte
  Dim T_M As Double
  Dim T_S1 As String