📄 frmgetsome.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmGetSome
BorderStyle = 1 'Fixed Single
Caption = "指定用户数据采集"
ClientHeight = 3390
ClientLeft = 45
ClientTop = 330
ClientWidth = 7005
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3390
ScaleWidth = 7005
Begin VB.ComboBox cmbBuild
Height = 300
Left = 615
Style = 2 'Dropdown List
TabIndex = 13
Top = 120
Width = 1215
End
Begin VB.CommandButton cmdOK
Caption = "采集"
BeginProperty Font
Name = "MS Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4215
TabIndex = 12
Top = 2850
Width = 1215
End
Begin VB.Data datUser
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 3135
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "temUser"
Top = 2385
Width = 3735
End
Begin VB.ListBox lstUser
Height = 1860
Left = 120
MultiSelect = 2 'Extended
TabIndex = 11
Top = 480
Width = 2295
End
Begin VB.CommandButton cmdDel
Caption = "<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2535
TabIndex = 10
Top = 1200
Width = 495
End
Begin VB.CommandButton cmdAdd
Caption = ">"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2535
TabIndex = 9
Top = 840
Width = 495
End
Begin VB.CommandButton cmdAddAll
Caption = ">>"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2535
TabIndex = 8
Top = 1560
Width = 495
End
Begin VB.CommandButton cmdDelAll
Caption = "<<"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2535
TabIndex = 7
Top = 1920
Width = 495
End
Begin VB.CommandButton cmdCancel
Caption = "返回"
Height = 375
Left = 5610
TabIndex = 6
Top = 2850
Width = 1185
End
Begin VB.TextBox Text1
Height = 270
Left = 135
TabIndex = 5
Top = 2610
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 375
Left = 1455
TabIndex = 4
Top = 2610
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox Text2
Height = 270
Left = 135
TabIndex = 3
Top = 2970
Visible = 0 'False
Width = 495
End
Begin VB.TextBox Text3
Height = 270
Left = 735
TabIndex = 2
Top = 2970
Visible = 0 'False
Width = 615
End
Begin VB.CommandButton Command2
Caption = "opendev"
Height = 375
Left = 2775
TabIndex = 1
Top = 2610
Visible = 0 'False
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "closedev"
Height = 375
Left = 2775
TabIndex = 0
Top = 3090
Visible = 0 'False
Width = 1215
End
Begin MSDBGrid.DBGrid grdUser
Bindings = "frmGetSome.frx":0000
Height = 2295
Left = 3135
OleObjectBlob = "frmGetSome.frx":0016
TabIndex = 14
Top = 120
Width = 3735
End
Begin VB.Label lblDetail
Height = 255
Left = 135
TabIndex = 17
Top = 2880
Width = 3855
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "楼:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 135
TabIndex = 16
Top = 120
Width = 495
End
Begin VB.Label lblSum
Height = 255
Left = 1935
TabIndex = 15
Top = 120
Width = 615
End
End
Attribute VB_Name = "frmGetSome"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim ExitFlag As Boolean
Dim rcTemUserMap As Recordset
Dim curBuildID As String
Dim curBuildAddr As Integer
Dim captest As Integer
Sub Done()
'status
AppendStatusInfo "关闭楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), icoBLUE
SaveLog "关闭楼" + Trim(curBuildID) + " 安全器" + Format(curBuildAddr), 0
CloseBuild (curBuildAddr)
End Sub
Sub CollectUser()
Dim collectStatus As Integer '保存用户采集返回码
Dim retrytimes As Integer '采集失败后重试次数
Dim isForward As Boolean '标志当前网关的打开方向是前向还是后向
Dim temVal As Boolean
Dim curUserID As Integer
Dim curUserAddr As Integer
Dim curUserDevs As Integer
Dim curFrameID As Integer
Dim curStartGate As Integer
Dim curEndGate As Integer
Dim FrameSum As Integer
Dim strHead As String
Dim curCardAddr As Integer
Dim curDevAddr As Integer
Dim curDevID As Integer
Dim curDevTypeID As Integer
Dim curCollectType As Integer
Dim rcUser As Recordset
Dim rcGate As Recordset
Dim rcBuild As Recordset
Dim rcTemUserData As Recordset
Dim rcUserMap As Recordset
Dim rcUserDev As Recordset
Dim rcDevsMap As Recordset
CancelCollect = False
frmMain.videoMain.Visible = True
gCurJPGdir = App.Path & "\data\" & Format(Date, "yyyymmdd")
If Dir(gCurJPGdir, vbDirectory) = "" Then
MkDir gCurJPGdir
End If
SQL = "delete * from temUserData"
dbCbb.Execute SQL
Set rcTemUserData = dbCbb.OpenRecordset("temUserData", dbOpenDynaset)
Set rcUserMap = dbCbb.OpenRecordset("UserMap", dbOpenDynaset)
Set rcGate = dbCbb.OpenRecordset("GateMap", dbOpenDynaset)
Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
Set rcDevsMap = dbCbb.OpenRecordset("DevsMap", dbOpenSnapshot)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -