main.frm

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

   StatusBar1.Panels(10).Text = StatusBar1.Panels(10).Text + CStr(i) & "-" + CStr(c_port(i)) & "-" & CStr(c_zijie(i)) + ";"
 End If
Next i
End Sub

Private Sub Command1_Click()
'MsgBox #1/1/2003# - #1/1/2002#
'Call return1(&H0, 1)
'Call return1(&H1B, 1)
'Call return1(&HF0, 1)
'Call return1(&H10, 1)

'Call return1(&H0, 1)
'Call return1(&H1B, 1)
'Call return1(&HF3, 1)
'Call return1(&HDE, 1)

'Debug.Print "INSERT INTO 水位高程 (站号,水位高程) VALUES (" & _
                  CStr(1) & "," & _
                   "10" & ")"

'Dim total As Single
'total = CInt(find(&H1B)) * 256 + CInt(find(&H0)) * 16 + CInt(find(&H0))
'MsgBox total
'Dim addr, total As Integer
'addr = 3

'Debug.Print App.Path & file_Path & "Rain" & Format$(addr, "000") & ".txt"
'Debug.Print App.Path & file_Path & "Water" & Format$(addr, "000") & ".txt"
'Debug.Print App.Path & file_Path & "v" & Format$(addr, "000") & ".txt"


'
'addr = 3
'total = 498
'
'Debug.Print CStr(addr) & "," & _
'          Format$(Year(Now()), "0000") & "," & _
'          CStr(Month(Now())) & "," & _
'          CStr(day(Now())) & "," & _
'          CStr(hour(Now())) & "," & _
'          CStr(Minute(Now())) & "," & _
'          CStr(Second(Now())) & "," & _
'          CStr(total) & ",1"
'
'Debug.Print CStr(addr) & "," & _
'          Format$(Year(Now()), "0000") & "," & _
'          CStr(Month(Now())) & "," & _
'          CStr(day(Now())) & "," & _
'          CStr(hour(Now())) & "," & _
'          CStr(Minute(Now())) & "," & _
'          CStr(Second(Now())) & "," & _
'          CStr(total) & ",2"
'
'
'
'Debug.Print CStr(addr) & "," & _
'          Format$(Year(Now()), "0000") & "," & _
'          CStr(Month(Now())) & "," & _
'          CStr(day(Now())) & "," & _
'          CStr(hour(Now())) & "," & _
'          CStr(Minute(Now())) & "," & _
'          CStr(Second(Now())) & "," & _
'          CStr(total) & ",3"
End Sub

Private Sub DAYINJI_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter")
End Sub

Private Sub DSGFDSG_Click()
If Not LoginSucceeded Then
frmLogin.Show 1
End If
End Sub

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

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

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
jishuqi = 0
End Sub

Private Sub Form_Load()
Dim a1 As String

On Error GoTo er
LoginSucceeded = False

Database_KaoJI = ""
a1 = GetPrivateProfileString(App.Path & "\接收数据库配置.INI", "水雨情接收软件", "DSN", "水雨情接收软件")
Database_KaoJI = Database_KaoJI & "DSN=" & a1 & ";"
a1 = GetPrivateProfileString(App.Path & "\接收数据库配置.INI", "水雨情接收软件", "UID", "admin")
Database_KaoJI = Database_KaoJI & "UID=" & a1 & ";"
a1 = GetPrivateProfileString(App.Path & "\接收数据库配置.INI", "水雨情接收软件", "PWD", "")
Database_KaoJI = Database_KaoJI & "PWD=" & a1 & ";"
a1 = GetPrivateProfileString(App.Path & "\接收数据库配置.INI", "水雨情接收软件", "DATABASE", "水雨情接收软件.mdb")
Database_KaoJI = Database_KaoJI & "DATABASE=" & a1 & ";"

 Set DB1 = New Connection
 DB1.CursorLocation = adUseClient
 DB1.Open "PROVIDER=MSDASQL;" & Database_KaoJI 'SQL

On Error Resume Next
jiami_password = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="PASSWORD", Default:="")
'无加密的密码
If jiami_password = "" Then
SaveSetting appname:=App.title, section:="SECURITY", _
            Key:="PASSWORD", setting:=JIAME(First_password)
jiami_password = JIAME(First_password)
End If

Remote = GetSetting(appname:=App.title, section:="SECURITY", _
                       Key:="Remote", Default:="")
'无IP
If Remote = "" Then
SaveSetting appname:=App.title, section:="SECURITY", _
            Key:="Remote", setting:=DefauleIp
Remote = DefauleIp
End If
Me.StatusBar1.Panels(9).Text = Remote

jycode(0) = &H0
jycode(1) = &H1B
jycode(2) = &H2E
jycode(3) = &H35
jycode(4) = &H47
jycode(5) = &H5C
jycode(6) = &H69
jycode(7) = &H72
jycode(8) = &H8D
jycode(9) = &H96
jycode(10) = &HA3
jycode(11) = &HB8
jycode(12) = &HCA
jycode(13) = &HD1
jycode(14) = &HE4
jycode(15) = &HFF

 Total_Water = 0
 Total_Rain = 0
 Total_V = 0
Me.StatusBar1.Panels(5).Text = "总计0"
Me.StatusBar1.Panels(6).Text = "雨0"
Me.StatusBar1.Panels(7).Text = "水0"
Me.StatusBar1.Panels(8).Text = "电0"

jishuqi = 0


Call LIUYFTS_Click

With Winsock1
.RemoteHost = Remote
.RemotePort = 1689
End With

Set objiets(1) = Form4
Set objiets(2) = Form5
Set objiets(3) = Form6
Set objiets(4) = Form7
Set objiets(5) = Form8
Set objiets(6) = Form9
Set objiets(7) = Form10
Set objiets(8) = Form11

Me.OLE1.CreateLink App.Path & "\JIESHOU.chm"
Call init
Exit Sub

er:
MsgBox "数据库配置错误！！！"
LoginSucceeded = True
Call Kill_All
End Sub
Public Sub init()
Dim i As Integer
StatusBar1.Panels(10).Text = ""
Call read_kou_zijie
For i = 1 To 8
Call Com_Init(i)
Next i
Me.Timer4.Enabled = True
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
jishuqi = 0
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim msg, style, title, response

On Error Resume Next

If LoginSucceeded Then
If UnloadMode = vbFormControlMenu Then

msg = "您是否真的要退出本系统?"   ' 定义信息。
style = vbYesNo + vbDefaultButton2 + vbApplicationModal + vbExclamation
title = "谢谢您的使用"  ' 定义标题。

response = MsgBox(msg, style, title)
If response = vbYes Then  ' 用户按下“是”。
Call Kill_All
Else
Cancel = 1
End If
End If

Else
Cancel = 1
End If
End Sub



Private Sub FUZHICIPAN_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll")
End Sub

Private Sub HELPB_Click()
On Error Resume Next
Me.OLE1.DoVerb
End Sub

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

Private Sub JIANPAN_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1")
End Sub

Private Sub KDSFHJUR09RE_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1")
End Sub

Private Sub KSDFNDSF877_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpL")
End Sub

Private Sub LIUYFTS_Click()
LoginSucceeded = False
Me.T1.Enabled = False
Me.T2.Enabled = False
Me.T3.Enabled = False
Me.t5.Enabled = False
Me.T6.Enabled = False
Me.T7.Enabled = False
Me.T8.Enabled = False
Me.T9.Enabled = False
Me.T10.Enabled = False
Me.T11.Enabled = False
Me.T12.Enabled = False
Me.T13.Enabled = False
Me.Caption = "水雨情接收软件(未登陆)"
End Sub

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

Private Sub MSComm1_OnComm(Index As Integer)
Dim i As Integer
Dim txter As String

Select Case MSComm1(Index).CommEvent
Case comEvReceive '2
MSComm1(Index).RThreshold = 0 '关中断
 Dim buffer() As Byte
 buffer = MSComm1(Index).Input

'十六进制
txter = ""
For i = LBound(buffer) To UBound(buffer)
 If Len(Hex(buffer(i))) = 1 Then
 txter = txter + "0" + Hex(buffer(i)) + " "
 Else
 txter = txter + Hex(buffer(i)) + " "
 End If
Next i
objiets(Index).Text1.Text = objiets(Index).Text1.Text + txter

For i = LBound(buffer) To UBound(buffer)
'解码程序
 If c_zijie(Index) = 4 Then
  Call return1(buffer(i), Index)
 Else
 If c_zijie(Index) = 8 Then
  Call return2(buffer(i), Index)
 Else
  Call return3(buffer(i), Index)
 End If
 End If
Next i
Me.MSComm1(Index).RThreshold = 1 '开中断
Case Else
End Select
End Sub

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

Private Sub Rain_table4_Click()
Form7.Show
End Sub

Private Sub Rain_table5_Click()
Form8.Show
End Sub

Private Sub Rain_table6_Click()
Form9.Show
End Sub

Private Sub Rain_table7_Click()
Form10.Show
End Sub

Private Sub Rain_table8_Click()
Form11.Show
End Sub



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

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

Private Sub SHUBIAO_Click()
On Error Resume Next
Dim x
x = Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0")
End Sub

Private Sub T10_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 T11_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 T12_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 T13_Click()
Dim MyValue As String
Dim message As String
Dim title As String

'On Error Resume Next

message = "请输入远程IP"   ' 设置提示信息。
title = "修改远程IP" ' 设置标题。
MyValue = InputBox(message, title, 0)

If MyValue <> "" Then
Remote = MyValue
SaveSetting appname:=App.title, section:="SECURITY", _
            Key:="Remote", setting:=Remote
With Winsock1
.RemoteHost = Remote
.RemotePort = 1689
End With
Me.StatusBar1.Panels(9).Text = Remote
End If
End Sub

'Private Sub T4_Click()
'Dim MyValue As String
'Dim aaa As Integer
'Dim message As String
'Dim title As String
'
'On Error Resume Next
'
'message = "请输入8字节区号(注意是10进制数)!"   ' 设置提示信息。
'title = "设置8字节区号(注意是10进制数!)!" ' 设置标题。