📄 frmnx5trim.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FrmNx5Trim
BorderStyle = 1 'Fixed Single
Caption = "抄表器数据传输"
ClientHeight = 6090
ClientLeft = 45
ClientTop = 435
ClientWidth = 10620
Icon = "FrmNx5Trim.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6090
ScaleWidth = 10620
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command4
Caption = "参数配置(&P)"
Height = 720
Left = 9375
Style = 1 'Graphical
TabIndex = 19
Top = 4380
Width = 1140
End
Begin VB.Frame Frame2
BackColor = &H8000000A&
Height = 3990
Left = 5880
TabIndex = 8
Top = 0
Width = 4665
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "操作说明"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 300
Left = 1440
TabIndex = 18
Top = 645
Width = 1125
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = " 参数说明: 首次下载时要设置正确端口号和比特率,电脑端和抄表器端的比特率一定要一致."
ForeColor = &H00000000&
Height = 450
Left = 360
TabIndex = 17
Top = 2505
Width = 4095
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "◆"
ForeColor = &H0000C000&
Height = 225
Left = 345
TabIndex = 16
Top = 2490
Width = 210
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "◆"
ForeColor = &H0000C000&
Height = 225
Left = 345
TabIndex = 15
Top = 1845
Width = 210
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = " 下载便笺数据: 运行后在程序界面中选择要下载的便笺文件,注意：文件类型为.Txt结尾的纯文本文件."
ForeColor = &H00000000&
Height = 570
Left = 375
TabIndex = 14
Top = 1860
Width = 4095
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "◆"
ForeColor = &H0000C000&
Height = 225
Left = 330
TabIndex = 13
Top = 1200
Width = 210
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = $"FrmNx5Trim.frx":08CA
ForeColor = &H00000000&
Height = 660
Left = 360
TabIndex = 10
Top = 1200
Width = 4095
End
Begin VB.Image Image1
Height = 825
Left = 315
Picture = "FrmNx5Trim.frx":0954
Top = 300
Width = 825
End
Begin VB.Label Label1
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Height = 3750
Left = 45
TabIndex = 9
Top = 150
Width = 4575
End
End
Begin VB.Frame Frame1
Height = 5985
Left = 75
TabIndex = 5
Top = 0
Width = 5760
Begin VB.ListBox List1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5310
Left = 90
TabIndex = 7
Top = 540
Width = 1860
End
Begin VB.ListBox List2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 5310
ItemData = "FrmNx5Trim.frx":1185
Left = 2085
List = "FrmNx5Trim.frx":1187
MultiSelect = 1 'Simple
TabIndex = 6
Top = 555
Width = 3525
End
Begin VB.Label Label4
Caption = "村组或台区："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 240
Left = 2130
TabIndex = 12
Top = 255
Width = 1290
End
Begin VB.Label Label3
Caption = "乡镇或线路："
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 285
Left = 120
TabIndex = 11
Top = 255
Width = 1230
End
End
Begin VB.CommandButton Command1
Caption = "退出窗口(&E)"
Height = 720
Index = 3
Left = 9375
Picture = "FrmNx5Trim.frx":1189
Style = 1 'Graphical
TabIndex = 4
Top = 5295
Width = 1155
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 5880
TabIndex = 3
Top = 4065
Visible = 0 'False
Width = 4650
_ExtentX = 8202
_ExtentY = 450
_Version = 393216
BorderStyle = 1
Appearance = 0
End
Begin VB.CommandButton Command1
Caption = "上载数据(&R)"
Height = 750
Index = 2
Left = 5910
Picture = "FrmNx5Trim.frx":1493
Style = 1 'Graphical
TabIndex = 2
Top = 5250
Width = 1185
End
Begin VB.CommandButton Command1
Caption = "下载便笺(&F)"
Height = 750
Index = 1
Left = 7695
Picture = "FrmNx5Trim.frx":179D
Style = 1 'Graphical
TabIndex = 1
Top = 4380
Width = 1140
End
Begin VB.CommandButton Command1
Caption = "下载数据(&S)"
Height = 735
Index = 0
Left = 5895
Picture = "FrmNx5Trim.frx":1AA7
Style = 1 'Graphical
TabIndex = 0
Top = 4410
Width = 1185
End
End
Attribute VB_Name = "FrmNx5Trim"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim rstA As ADODB.Recordset
Dim rstB As ADODB.Recordset
Dim Fso As New FileSystemObject
Private Declare Function OpenProcess Lib "Kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "Kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public PpathStr As String, PDownFileApath As String, PDownFileAname As String, PDownFileBpath As String, Pinifile As String, PDownFileBname As String
Public PUpFileApath As String, PUpFileAname As String, PUpFileBpath As String, PUpFileBname As String
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFFFFFF
Const Pini = "Readamneter.ini"
Const PfileA = "普通用户信息表.dbf"
Const PfileB = "大用户信息表.dbf"
Const PfileC = "电价信息表.dbf"
Const PfileD = "线路台区信息表.dbf"
Const SqlStr1 = "SELECT * FROM 线路台区信息表"
Const sqlStr2 = "SELECT * FROM 普通用户信息表 WHERE 抄表情况=.T." '"SELECT * FROM 普通用户信息表"
Const sqlStr3 = "SELECT * FROM 电价信息表"
Const sqlStr4 = "SELECT * FROM 大用户信息表"
Private Sub Form_Load()
Dim intCounter As Integer, intRecCount As Integer
OpenMdb
Set MdbR = NdMd.OpenRecordset("乡镇档案")
MdbR.MoveLast
intCounter = MdbR.RecordCount
MdbR.MoveFirst
For intRecCount = 0 To intCounter - 1
List1.AddItem& MdbR.Fields("镇代码") & " " & MdbR.Fields("简称") & ""
MdbR.MoveNext
Next intRecCount
List1.ListIndex = 0
PpathStr = RemoveBackslash(App.Path)
Pinifile = PpathStr & "\" & Pini
If FileExists(Pinifile) = False Then
Call WriteINI(Pinifile, "ComPort", "Comm", "1")
Call WriteINI(Pinifile, "ComPort", "BaudRate", "115200")
Call WriteINI(Pinifile, "RecentFile", "普通用户信息表", PpathStr & "\Downdbf\" & PfileA)
Call WriteINI(Pinifile, "RecentFile", "大用户信息表", PpathStr & "\Downdbf\" & PfileB)
Call WriteINI(Pinifile, "RecentFile", "电价信息表", PpathStr & "\Downdbf\" & PfileC)
Call WriteINI(Pinifile, "RecentFile", "线路台区信息表", PpathStr & "\Downdbf\" & PfileD)
Call WriteINI(Pinifile, "Upload", "Path", PpathStr & "\Updbf")
Call WriteINI(Pinifile, "Other", "AutoClose", "-1")
Call WriteINI(Pinifile, "Other", "Stay", "5")
Call WriteINI(Pinifile, "Other", "Resultinfo", "Result.Txt")
End If
If DirectoryExists(PpathStr & "\Updbf") = False Then
MakeDirectory (PpathStr & "\Updbf")
End If
If DirectoryExists(PpathStr & "\Downdbf") = False Then
MakeDirectory (PpathStr & "\Downdbf")
FileCopy PpathStr & "\Cbj\LineT.Dat", PpathStr & "\Downdbf\线路台区信息表.FPT"
End If
End Sub
Sub DataTrim()
Dim I As Integer, II As Integer
Dim sqlrec As String, stt As String
On Error GoTo DerrOr
If Fso.FileExists(App.Path & "\UpDbf\线路台区信息表.dbf") = False Then
MsgBox "本次数据不完整，无法回收抄表数据！请重新传输！", vbCritical, "提示"
Exit Sub
End If
If Fso.FileExists(App.Path & "\UpDbf\普通用户信息表.dbf") = False Then
MsgBox "本次数据不完整，无法回收抄表数据！请重新传输！", vbCritical, "提示"
Exit Sub
End If
Screen.MousePointer = 11
Set cn = New ADODB.Connection
Set rst = New ADODB.Recordset
Set rstA = New ADODB.Recordset
Set rstB = New ADODB.Recordset
cn.Open "Provider=MSDASQL.1;Persist Security Info=false;Extended Properties=Driver={Microsoft Visual FoxPro Driver};UID=;SourceDB=" & (App.Path & "\UpDbf") & ";SourceType=DBF;Exclusive=No;BackgroundFetch=Yes;Collate=Machine;Null=Yes;Deleted=Yes;"
OpenMdb
With rstA
.CursorType = adOpenStatic
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -