📄 readbankdisk.frm
字号:
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSAdodcLib.Adodc tempado
Height = 375
Left = 4920
Top = 2910
Visible = 0 'False
Width = 1215
_ExtentX = 2143
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = ""
OLEDBString = ""
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.Image Image1
Height = 1605
Left = 4965
Picture = "ReadBankDisk.frx":1EE2
Stretch = -1 'True
Top = 3630
Width = 2460
End
Begin VB.Label Label1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 5025
TabIndex = 7
Top = 5310
Width = 2310
End
End
Attribute VB_Name = "ReadBankDisk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Combo1_Click()
Set MdbR = NdMd.OpenRecordset("SELECT * FROM 银行配置 where Bank='" & Trim(Combo1.Text) & "'")
Label4.Caption = MdbR.Fields!Cname & ""
Label6.Caption = MdbR.Fields!Ip & ""
Label8.Caption = MdbR.Fields!Port & ""
Label12.Caption = MdbR.Fields!User & ""
Label11.Caption = MdbR.Fields!Pass & ""
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
Select Case SelectType.Text
Case "文本文件|*.Txt"
File1.Pattern = "*.txt"
Case "数据库|*.Mdb"
File1.Pattern = "*.mdb"
Case "电子表格|*.Xsl"
File1.Pattern = "*.xsl"
End Select
End Sub
Private Sub Drive1_Change()
On Error GoTo eh
Dir1.Path = Drive1.Drive
Exit Sub
eh:
Select Case Err.Number
Case 68
MsgBox "请把数据软盘插到软驱！", vbCritical
Drive1.Drive = "C:"
Exit Sub
End Select
End Sub
Private Sub Form_Load()
Dim i As Integer
If Screen.Width \ Screen.TwipsPerPixelX = 800 And Screen.Height \ Screen.TwipsPerPixelY = 600 Then
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 1 - 800
Else
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
End If
Frame2.Enabled = False
Frame3.Enabled = False
Frame4.Enabled = False
If GetSetting(App.EXEName, "BankInfo", "Deduck", "") = "1" Then
Option1.Value = True
Frame2.Enabled = True
Else
Option2.Value = True
Frame3.Enabled = True
End If
OpenMdb
Set MdbR = NdMd.OpenRecordset("银行配置")
If MdbR.RecordCount = 0 Then
MsgBox "请建立银行数据！", vbInformation
Unload Me
BasicData.Show vbModal
Exit Sub
Else
With MdbR
For i = 0 To .RecordCount - 1
Combo1.AddItem .Fields!Bank
.MoveNext
Next
Combo1.ListIndex = 0
End With
End If
SelectType.AddItem "所有文件(*.*)", 0
SelectType.AddItem "文本文件|*.TXT", 1
SelectType.AddItem "数据库|*.MDB", 2
SelectType.AddItem "电子表格|*.XSL", 3
SelectType.ListIndex = 0
p_bar.Visible = False
mgrid.Visible = False
adotemp.ConnectionString = "DBQ=" & App.Path & "\Data\Eletricity.Mdb" & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=281;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;PWD=;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
End Sub
Private Sub SelectType_Click()
Select Case SelectType.Text
Case "所有文件(*.*)"
File1.Pattern = "*.txt;*.mdb;*.xsl;*.ico"
Case "文本文件|*.TXT"
File1.Pattern = "*.txt"
Case "电子表格|*.XSL"
File1.Pattern = "*.xsl"
Case "数据库|*.MDB"
File1.Pattern = "*.mdb"
End Select
File1.Refresh
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim temp_usercode As String
Dim temp_text As String
Dim i As Integer
Dim iHS As Integer
Dim t_year As String
Dim t_month As String
Dim zhanghao As String
Dim DirStr As String
Dim t_record_count As Integer
Dim sign_str As String
Dim temp_path As String
Dim mydb As New ADODB.Connection
Dim j As Integer
t_year = Year(Date)
t_month = Format(Month(Date), "0#")
temp_path = Right(t_year, 2) & t_month
Label1.Visible = True
Label1.Caption = "系统正在读取信用社返回信息,请您稍候...."
Label1.Refresh
Screen.MousePointer = 11
mydb.Open "DBQ=" & App.Path & "\Data\Eletricity.Mdb" & ";Driver={Microsoft Access Driver (*.mdb)};DriverId=281;FIL=MS Access;MaxBufferSize=2048;MaxScanRows=8;PageTimeout=5;PWD=;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
'On Error GoTo hander
If Right(Dir1.Path, 1) <> "\" Then
DirStr = Dir1.Path + "\" & File1.Filename
End If
'If FileExists("A:\Ndf" & temp_path & ".Txt") = False Then
'If FileExists(DirStr) = False Then
' MsgBox "信用社返回数据文件Ndf" & temp_path & ".Txt没找到!", vbInformation
' Screen.MousePointer = 0
' Exit Sub
' Else
' If FileExists(App.Path & "\Bank\Ndf" & temp_path & ".Txt") Then
' If FileExists(App.Path & "\Bank\" & File1.Filename) Then
' Kill App.Path & "\Bank\" & File1.Filename
' End If
' CopyFile "A:\NDF" & temp_path & ".Txt", App.Path & "\Bank\Ndf" & temp_path & ".Txt", False
' End If
'Open App.Path & "\Bank\Ndf" & temp_path & ".Txt" For Input As #1
Open DirStr For Input As #1
iHS = 0
Do While Not eof(1)
Line Input #1, temp_text
iHS = iHS + 1
Loop
Close #1
'Open App.Path & "\Bank\Ndf" & temp_path & ".Txt" For Input As #1
Open DirStr For Input As #1
i = 0
' ReadBankDisk.Height = 7065
p_bar.Visible = True
p_bar.Max = iHS
For i = 0 To p_bar.Max - 1
Line Input #1, temp_text
temp_usercode = "0" + Mid(temp_text, 3, 2) & "0" + Mid(temp_text, 5, 2) & Mid(temp_text, 7, 4)
' Call convert_str(temp_text)
sign_str = Mid(temp_text, 35 - convert_str(temp_text), 1)
i = i + 1
If sign_str = "1" Then
zhanghao = Mid(temp_text, 36 - convert_str(temp_text), 12) 'Trim(Mid(temp_text, 33, 18))
mydb.Execute "update 用户电费 set 用户电费.代扣信息=1,用户电费.交费情况=1 where 用户电费.组合编码='" & temp_usercode & "'"
mydb.Execute "update 用户电费 set 用户电费.账号='" & zhanghao & "' where 用户电费.组合编码='" & temp_usercode & "'"
End If
If sign_str = "0" Then
zhanghao = Mid(temp_text, 36 - convert_str(temp_text), 12) ' Trim(Mid(temp_text, 33, 18))
mydb.Execute "update 用户电费 set 用户电费.代扣信息=0 where 用户电费.组合编码='" & temp_usercode & "'"
mydb.Execute "update 用户电费 set 用户电费.账号='" & zhanghao & "' where 用户电费.组合编码='" & temp_usercode & "'"
End If
p_bar.Value = i
DoEvents
Next
Close #1
MsgBox "信用社返回盘读取完成！！！", vbInformation
mydb.Close
ReadBankDisk.Height = 6735
p_bar.Visible = False
Label1.Visible = False
Screen.MousePointer = 0
Exit Sub
hander:
Select Case Err.Number
Case 52:
MsgBox "磁盘没插好!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 53:
MsgBox "文件没找到!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 54:
MsgBox "文件模式错误!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 55:
MsgBox "文件已打开!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 61:
MsgBox "磁盘已满!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 62:
MsgBox "文件太大!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 63:
MsgBox "文件记录号错误!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 68:
MsgBox "设备不可用!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 70:
MsgBox "对不起,无权访问!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 71:
MsgBox "磁盘没准备好!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 75:
MsgBox "文件路径不对或文件错误!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
Case 76:
MsgBox "路径没找到!", vbInformation
mydb.Close
Screen.MousePointer = 0
Exit Sub
End Select
End Sub
Private Sub tempado_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
MsgBox "数据库连接失败！！！", vbInformation
fCancelDisplay = True
Unload Me
End Sub
Private Sub adotemp_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
MsgBox "数据库连接失败！！！", vbInformation
fCancelDisplay = True
Unload Me
End Sub
Private Sub Toolbar3_ButtonClick(ByVal Button As MSComctlLib.Button)
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -