main.frm

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

'MyValue = InputBox(message, title, 0)
'
'If MyValue <> "" Then
'If IsNumeric(MyValue) Then
'QUHAO = CByte(MyValue)
'SaveSetting appname:=App.title, section:="SECURITY", _
'            Key:="QUHAO", setting:=QUHAO
'Me.StatusBar1.Panels(10).Text = "区号" & Hex(QUHAO)
'Else
'MsgBox "对不起,您输入的不是数,请重新输入!"
'End If
'End If
'
'End Sub


Private Sub GFHGFKR_Click()
frmLogin1.Show 1
End Sub

Private Sub T5_Click()
Dim msg, style, title, response

On Error Resume Next
msg = "您是否真的要退出本系统?"   ' 定义信息。
style = vbYesNo + vbDefaultButton2 + vbApplicationModal + vbExclamation
title = "谢谢您的使用"  ' 定义标题。
response = MsgBox(msg, style, title)
If response = vbYes Then  ' 用户按下“是”。
Call Kill_All
End If
End Sub

Private Sub Rain_table1_Click()
Form4.Show
End Sub
Private Sub Rain_table2_Click()
Form5.Show
End Sub
Private Sub Rain_table3_Click()
Form6.Show
End Sub


Private Sub T3_Click()
If Not all_lock Then
Form1.Show 1
End If
End Sub

Private Sub T1_Click()
On Error Resume Next
Dim a As New frmdata
sql_string = "SELECT * FROM 接收设置 ORDER BY 站号"
frmdata_caption = "接收设置"
a.Show 1
End Sub

Private Sub t567_Click()
On Error Resume Next
Call ShellAbout(hWnd, "北京拓禹自动化系统工程有限公司", "欢迎您的使用" & vbCrLf & "您使用的是正版的软件", Me.Icon)
End Sub

Private Sub T6_Click()
On Error Resume Next
Dim a As New frmdata
sql_string = "SELECT * FROM 水位高程 ORDER BY 站号"
frmdata_caption = "水位高程"
a.Show 1
End Sub

Private Sub T7_Click()
On Error Resume Next
Dim a As New frmdata
sql_string = "SELECT * FROM 水位微调 ORDER BY 站号"
frmdata_caption = "水位微调"
a.Show 1
End Sub

Private Sub T8_Click()
FrmSql.Show
End Sub

Private Sub Timer1_Timer()
'Dim i As Integer '演示版代码
'
'all_jishi = all_jishi + 1
'If all_jishi >= 120 Then
'all_lock = True
'For i = 1 To 8
'If Me.MSComm1(i).PortOpen Then Me.MSComm1(i).PortOpen = False
'Next i
'MsgBox "演示版已经到期！不能接收任何数据！"
'End If '演示版代码

jishuqi = jishuqi + 1
If jishuqi = Key_Lock Then
jishuqi = 0
Call LIUYFTS_Click
End If
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
Timer2.Enabled = False
Call cha_KU '
End Sub
'Private Sub BingKu()
'Dim i As Integer
'Dim File_Name As String
'Dim tt As String
'Dim a, b, c, d As String
'Dim st, st1 As String
'
'On Error Resume Next
'For i = 1 To 255
'File_Name = App.Path & file_Path & Format$(i, "000") & ".txt"
'Open File_Name For Append As #2
'Close #2
'
'Open File_Name For Input As #1
'Do While Not EOF(1)
'   Line Input #1, tt
'   DoEvents
'   a = JIE(tt, 1) '站号
'   b = JIE(tt, 2) '数值
'   c = JIE(tt, 3) '时间
'   d = JIE(tt, 4) '物理量
'
'st = "INSERT INTO 原始数据 (站号,数值,时间,物理量) VALUES (" & _
'                  a & "," & _
'                  b & "," & _
'                  zhong_time_symbol & c & zhong_time_symbol & "," & _
'                  "'" & d & "')"
'DB1.Execute st
'
'Select Case d
'Case "雨量"
'st1 = "INSERT INTO 雨量 (站号,雨量,时间) VALUES (" & _
'                  a & "," & _
'                  b & "," & _
'                  zhong_time_symbol & c & zhong_time_symbol & ")"
'DB1.Execute st1
'
'Case "水位"
'st1 = "INSERT INTO 水位 (站号,水位,时间) VALUES (" & _
'                  a & "," & _
'                  Format$((CInt(b) + Find_WeiTiao(CInt(a)) / 100) + Find_GaoCheng(CInt(a)), "0.00") & "," & _
'                  zhong_time_symbol & c & zhong_time_symbol & ")"
'DB1.Execute st1
'
'Case "电压"
'st1 = "INSERT INTO 电压 (站号,电压,时间) VALUES (" & _
'                  a & "," & _
'                  Format$(CInt(b) / 100, "0.00") & "," & _
'                  zhong_time_symbol & c & zhong_time_symbol & ")"
'DB1.Execute st1
'
'Case Else
'End Select
'
'Loop
'Close #1
'Kill File_Name
'Next i
'End Sub
Private Sub cha_1()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 接收设置"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 接收设置 (站号 int,站名 text,雨量 bit,水位 bit,电压 bit,字节类型 int,设备号 int);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_2()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 原始数据"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 原始数据 (站号 int,数值 Single,时间 datetime,物理量 text);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub

Private Sub cha_3()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 雨量"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 雨量 (站号 int,雨量 Single,时间 datetime);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_4()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 水位"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 水位 (站号 int,水位 Single,时间 datetime);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_5()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 电压"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 电压 (站号 int,电压 Single,时间 datetime);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_6()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 水位高程"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 水位高程 (站号 int,水位高程 Single);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_7()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 水位微调"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 水位微调 (站号 int,水位微调 int);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_8()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 雨量排除"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 雨量排除 (雨量排除 Single);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_9()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 水位排除"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 水位排除 (水位排除 int);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub
Private Sub cha_10()
Dim tabl As Recordset
Dim OPEN_STRING As String

On Error GoTo ER1
  OPEN_STRING = "SELECT count(*) from 电压排除"
  Set tabl = New Recordset
  tabl.Open OPEN_STRING, DB1, adOpenStatic, adLockOptimistic
  Set tabl = Nothing
Exit Sub

ER1:
OPEN_STRING = "CREATE TABLE 电压排除 (电压排除 int);"
DB1.Execute OPEN_STRING
Set tabl = Nothing
End Sub

Private Sub cha_KU()
On Error Resume Next
Call cha_1 '接收设置
Call cha_2 '原始数据
Call cha_3 '雨量
Call cha_4 '水位
Call cha_5 '电压
Call cha_6 '水位高程
Call cha_7 '水位微调
Call cha_8 '雨量排除
Call cha_9 '水位排除
Call cha_10 '电压排除
End Sub
Private Sub read_kou_zijie()
c_port(1) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port1", Default:=0)
c_zijie(1) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie1", Default:=4)
                       
c_port(2) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port2", Default:=0)
c_zijie(2) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie2", Default:=4)
                       
c_port(3) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port3", Default:=0)
c_zijie(3) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie3", Default:=4)
                       
c_port(4) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port4", Default:=0)
c_zijie(4) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie4", Default:=4)
                       
c_port(5) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port5", Default:=0)
c_zijie(5) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie5", Default:=4)
                       
c_port(6) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port6", Default:=0)
c_zijie(6) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie6", Default:=4)
                       
c_port(7) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port7", Default:=0)
c_zijie(7) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie7", Default:=4)
                       
c_port(8) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="port8", Default:=0)
c_zijie(8) = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="zijie8", Default:=4)
End Sub

Private Sub Com_Init(ByVal b As Integer)
On Error GoTo xxx
If MSComm1(b).PortOpen Then MSComm1(b).PortOpen = False
MSComm1(b).CommPort = c_port(b)
MSComm1(b).PortOpen = True
be_open(b) = True
Exit Sub
xxx:
be_open(b) = False
End Sub

Private Sub T2_Click()
On Error Resume Next
Kan = 1
Form15.Show
End Sub
Private Sub T9_Click()
On Error Resume Next
Kan = 2
Form15.Show
End Sub

Private Sub Timer4_Timer()
Timer4.Enabled = False
Call status
End Sub

Private Sub Water_Table_Click()
MDIForm1.Show
End Sub

Private Sub XIANSHISHUXING_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl")
End Sub

Private Sub YOUXIKONGZHIQI_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL joy.cpl")
End Sub