module001.bas

一个水情自动测报系统的接收例程

Attribute VB_Name = "Module1"
Option Explicit
Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
   (ToVar As Any, FromVar As Any, ByVal cbLen As Long)
Public Declare Function GetCrc Lib "pp.dll" (ByRef a As Any, ByVal l As Integer) As Long

Public Kan  As Integer
Public LoginSucceeded As Boolean
Public jiami_password As String
Public Const First_password = "9999"
Public Const all_password = "93609606"
Public Const YaoShi = "222"
'Public ZIJIE As Integer
Public Const QUHAO = &H0 ' As Integer
Public Name_(1 To 255) As String
Public Database_KaoJI As String
Public Const zhong_time_symbol = "#"
Public DB1 As Connection
Public sql_string As String
Public frmdata_caption  As String
Public x As New Form17
Public Y As New Form17
Public z As New Form17
Public w As New Form17
Public inx(1 To 8, 1 To 12) As Byte
Public inx2(1 To 8, 1 To 8) As Byte
Public inx3(1 To 8, 0 To 50) As Byte
Public Rflx(1 To 8) As Integer
Public jycode(15) As Byte
Public imm(1 To 8) As Integer
Public imm2(1 To 8) As Integer
Public imm3(1 To 8) As Integer
Public Total_Water As Long
Public Total_Rain As Long
Public Total_V As Long
Public Const file_Path = "\"
Public Const Key_Lock = 5
Public jishuqi As Integer
Public Remote As String
Public Const DefauleIp = "127.0.0.1"
Public Const SMART_QUHAO = &H7E
Public Const ZHEN = &H3
Public c_port(1 To 8) As Integer
Public c_zijie(1 To 8) As Integer
Public be_open(1 To 8) As Boolean
Public objiets(1 To 8) As Object

Type pe_date
addr As Integer
total As Integer
character As Integer
mon  As Integer
day As Integer
hour As Integer
min As Integer
End Type
Public p_date As pe_date
Public Const old_file = "data.dat"
Public all_jishi As Integer
Public all_lock As Boolean

Public Function pd3(ByVal char1 As Byte, ByVal char2 As Byte, ByVal ZI_JIE As Integer, ByVal SHEBEIHAO As Integer) As Boolean
Dim addr0, addr1 As Byte
Dim addr2 As Byte
Dim tt As String
Dim tabl As Recordset
On Error Resume Next

         addr0 = find(char1)
         addr1 = find(char2)
         addr2 = addr0 * 16 + addr1

tt = "SELECT * From 接收设置 where 站号=" & CStr(addr2) & " and (雨量 OR 水位 OR 电压) and 字节类型 = " & CStr(ZI_JIE) & " and 设备号 = " & CStr(SHEBEIHAO)
Set tabl = New Recordset
tabl.Open tt, DB1, adOpenStatic, adLockOptimistic

If Not tabl.BOF Then
pd3 = True
Else
pd3 = False
End If
Set tabl = Nothing
End Function
Public Function pd4(ByVal char1 As Byte, ByVal char2 As Byte, ByVal char3 As Byte, ByVal ZI_JIE As Integer, ByVal SHEBEIHAO As Integer) As Boolean
Dim addr0, addr1 As Byte
Dim addr2 As Byte
Dim character As Byte
Dim tt As String
Dim tabl As Recordset

On Error Resume Next

        addr0 = find(char1)
        addr1 = find(char2)
        addr2 = addr0 * 16 + addr1
        character = char3 \ 16
Select Case character
Case &HF
tt = "水位"

Case &HC
tt = "雨量"

Case &HD
tt = "电压"
Case Else
End Select

tt = "SELECT * From 接收设置 where 站号=" & CStr(addr2) & " and " & tt & " and 字节类型 = " & CStr(ZI_JIE) & " and 设备号 = " & CStr(SHEBEIHAO)
Set tabl = New Recordset
tabl.Open tt, DB1, adOpenStatic, adLockOptimistic

If Not tabl.BOF Then
pd4 = True
Else
pd4 = False
End If
Set tabl = Nothing
End Function


Public Function find(ByVal ic As Byte) As Byte
Dim j As Integer
On Error Resume Next

For j = 0 To 15
If ic = jycode(j) Then
find = j
Exit Function
End If
Next j
End Function
Public Sub Kill_All()
On Error Resume Next
Unload Form1
Unload Form4
Unload Form5
Unload Form6
Unload Form7
Unload Form8
Unload Form9
Unload Form10
Unload Form11
Unload MDIForm1
Unload frmdata
Unload Form15
Unload frmLogin
Unload frmLogin1
Unload FrmSql
Unload Max
End Sub
Private Sub Main()
On Error Resume Next
      If App.PrevInstance Then
         Exit Sub
      Else
      Max.Show
      End If
End Sub
Public Sub Change_StatusBar()
On Error Resume Next
Max.StatusBar1.Panels(4).Text = "总计" & CStr(Total_Water + Total_Rain + Total_V)
Max.StatusBar1.Panels(5).Text = "雨" & CStr(Total_Rain)
Max.StatusBar1.Panels(6).Text = "水" & CStr(Total_Water)
Max.StatusBar1.Panels(7).Text = "电" & CStr(Total_V)

MDIForm1.StatusBar1.Panels(1).Text = "总计" & CStr(Total_Water + Total_Rain + Total_V)
MDIForm1.StatusBar1.Panels(2).Text = "雨量" & CStr(Total_Rain)
MDIForm1.StatusBar1.Panels(3).Text = "水位" & CStr(Total_Water)
MDIForm1.StatusBar1.Panels(4).Text = "电压" & CStr(Total_V)
End Sub



Public Sub Write_Act(ByVal Ad As Integer, ByVal st As String, ByVal F As Byte)
Dim i As Integer

On Error Resume Next

x.Text1.Text = st & Chr(13) & Chr(10) & x.Text1.Text

Select Case F
Case &HC
Y.Text1.Text = st & Chr(13) & Chr(10) & Y.Text1.Text

Case &HF
z.Text1.Text = st & Chr(13) & Chr(10) & z.Text1.Text

Case &HD
w.Text1.Text = st & Chr(13) & Chr(10) & w.Text1.Text


Case Else
End Select

End Sub

Public Sub Find_All_Name()
  Dim adoPrimaryRS1 As Recordset
  Dim OPEN_STRING As String
  
  On Error Resume Next

  OPEN_STRING = "SELECT * from 接收设置 ORDER BY 站号"
  Set adoPrimaryRS1 = New Recordset
  adoPrimaryRS1.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic

  If Not adoPrimaryRS1.BOF Then
    Do While (Not adoPrimaryRS1.EOF)
    Name_(adoPrimaryRS1("站号").Value) = adoPrimaryRS1("站名").Value
      adoPrimaryRS1.MoveNext
    Loop
  End If
  Set adoPrimaryRS1 = Nothing
End Sub

Public Function GetPrivateProfileString(ByVal Ini_Name As String, Gig_Item_Name As String, Small_Item_Name As String, Def_String As String) As String
Dim st, tt As String
Dim Find_1 As Boolean

On Error Resume Next

st = Def_String
tt = ""
Find_1 = False
Open Ini_Name For Input As #1
Do Until EOF(1)
   Line Input #1, tt
   If tt = "[" & Gig_Item_Name & "]" Then Find_1 = True
   If Find_1 Then

   If Left(tt, Len(Small_Item_Name)) = Small_Item_Name Then
   st = Right(tt, Len(tt) - Len(Small_Item_Name) - 1)
   GoTo aaa
   End If

   End If

Loop
aaa:
Close #1
GetPrivateProfileString = st
End Function



Public Function pd5(ByVal addr As Integer, ByVal FRA As Byte, ByVal ZI_JIE As Integer, ByVal SHEBEIHAO As Integer) As Boolean
Dim tt As String
Dim tabl As Recordset

On Error Resume Next

Select Case FRA
Case &HF
tt = "水位"

Case &HC
tt = "雨量"

Case &HD
tt = "电压"
Case Else
End Select

tt = "SELECT * From 接收设置 where 站号=" & CStr(addr) & " and " & tt & " and 字节类型 = " & CStr(ZI_JIE) & " and 设备号 = " & CStr(SHEBEIHAO)
Set tabl = New Recordset
tabl.Open tt, DB1, adOpenStatic, adLockOptimistic

If Not tabl.BOF Then
pd5 = True
Else
pd5 = False
End If
Set tabl = Nothing
End Function

Public Function JIAME(ByVal s As String) As String
JIAME = Crypt(s, YaoShi)
End Function
Public Function Crypt(texti, salasana) As String
Dim t
Dim sana
Dim X1
Dim G
Dim tt
Dim Crypted

On Error Resume Next
              For t = 1 To Len(salasana)
                     sana = Asc(Mid(salasana, t, 1))
                     X1 = X1 + sana
              Next

       X1 = Int((X1 * 0.1) / 6)
       salasana = X1
       G = 0

              For tt = 1 To Len(texti)
                     sana = Asc(Mid(texti, tt, 1))
                     G = G + 1

                            If G = 6 Then G = 0
                                   X1 = 0

                                          If G = 0 Then X1 = sana - (salasana - 2)

                                                        If G = 1 Then X1 = sana + (salasana - 5)

                                                                      If G = 2 Then X1 = sana - (salasana - 4)

                                                                                    If G = 3 Then X1 = sana + (salasana - 2)

                                                                                                  If G = 4 Then X1 = sana - (salasana - 3)

                                                                                                                If G = 5 Then X1 = sana + (salasana - 5)
                                                                                                                       X1 = X1 + G
                                                                                                                       Crypted = Crypted & Chr(X1)
                                                                                                                Next


                                                                                                                Crypt = Crypted
End Function

Public Function Find_GaoCheng(ByVal addr As Integer) As Single
Dim table As Recordset
Dim ss1 As Single
Dim st As String

On Error GoTo abcd
Set table = New Recordset
st = "SELECT * FROM 水位高程 WHERE 站号 = " & CStr(addr)
table.Open st, DB1, adOpenStatic, adLockOptimistic

If Not table.BOF Then
ss1 = table("水位高程").Value
Else
ss1 = 0
End If

Find_GaoCheng = ss1
Set table = Nothing
Exit Function

abcd:
Find_GaoCheng = 0
Set table = Nothing
End Function


Public Function Find_WeiTiao(ByVal addr As Integer) As Integer
Dim table As Recordset
Dim ss1 As Integer
Dim st As String
'
On Error GoTo abcd
Set table = New Recordset
st = "SELECT * FROM 水位微调 WHERE 站号 = " & CStr(addr)
table.Open st, DB1, adOpenStatic, adLockOptimistic

If Not table.BOF Then
ss1 = table("水位微调").Value
Else
ss1 = 0
End If

Find_WeiTiao = ss1
Set table = Nothing

Exit Function

abcd:
Find_WeiTiao = 0
Set table = Nothing

End Function