www.pudn.com > kelon.rar > fData1.frm
VERSION 5.00
Begin VB.Form fComPort
BackColor = &amt;H00FF0000&amt;
BorderStyle = 0 'None
Caption = "数据伺服器 V1.01"
ClientHeight = 510
ClientLeft = 0
ClientTop = 0
ClientWidth = 480
Icon = "fData1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
Picture = "fData1.frx":030A
ScaleHeight = 510
ScaleWidth = 480
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text1
Height = 375
Left = 1185
TabIndex = 1
Text = "1"
Top = 45
Width = 480
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 4000
Left = 705
Top = 45
End
Begin VB.Label Label1
Caption = "Label1"
Height = 315
Left = 780
TabIndex = 0
Top = 570
Width = 825
End
End
Attribute VB_Name = "fComPort"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sSql As String
Dim nrs As New ADODB.Recordset
Private Const LocFileName = "\res\lz_runtime.ini"
Dim times As Long
Private Sub Form_DblClick()
If MsgBox("确定关闭串口数据连接器? ", 33, "提示") = 1 Then
Unload Me
End If
End Sub
Private Sub Form_Load()
If App.PrevInstance Then
' MsgBox ("注意:程序已经运行,不能再次装载。"), vbExclamation
End
End If
Call GetIniFileName
Call OpenODBC(Cn_Des, "ConnectionString001")
times = Val(pGetString(App.Path + LocFileName, "timer", "times"))
Call SetRefTime
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call DragForm(Button, Me)
End Sub
Private Sub Form_Unload(Cancel As Integer)
mdt01.Cn_Des.Close
End Sub
Private Sub Timer1_Timer()
Call GetSsql
Call Cn_Des.Execute(sSql)
End Sub
Private Sub SetRefTime()
Dim ss As Long
ss = Val(pGetString(App.Path + LocFileName, "timer", "timer2"))
If ss < 1 Then ss = 3 ' 不能小于1秒
If ss > 15 Then ss = 10 '不能大于15秒
Timer1.Interval = Val(ss) * 1000
Timer1.Enabled = True
End Sub
Private Sub GetSsql()
Dim str1 As String
str1 = Str(times)
Call WritePrivateProfileString("timer", "times", str1, App.Path + LocFileName)
' Debug.Print times
times = times + 1
Dim num As String
num = Text1.Text
sSql = pGetString(App.Path + LocFileName, "access", "sqlupdate")
sSql = "UPDATE " &amt; sSql
sSql = Replace(sSql, "@id", num)
End Sub