📄 frmbackup.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frmBackup
BorderStyle = 3 'Fixed Dialog
Caption = "数据备份"
ClientHeight = 3210
ClientLeft = 30
ClientTop = 420
ClientWidth = 5865
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3210
ScaleWidth = 5865
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame2
Caption = "备份路径"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 975
Left = 120
TabIndex = 9
Top = 1080
Width = 5655
Begin VB.TextBox txtPath
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 360
TabIndex = 10
Text = "\\"
Top = 360
Width = 5055
End
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 135
Left = 1200
TabIndex = 8
Top = 2880
Visible = 0 'False
Width = 3375
_ExtentX = 5953
_ExtentY = 238
_Version = 393216
Appearance = 1
End
Begin VB.Frame Frame1
Caption = "备份时段"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 120
TabIndex = 2
Top = 120
Width = 5650
Begin MSComCtl2.DTPicker DTPicker1
Height = 330
Left = 840
TabIndex = 4
Top = 360
Width = 1695
_ExtentX = 2990
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 53215233
CurrentDate = 38823
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 330
Left = 3240
TabIndex = 5
Top = 360
Width = 1695
_ExtentX = 2990
_ExtentY = 582
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 53215233
CurrentDate = 38823
End
Begin VB.Label Label2
Caption = "到："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2880
TabIndex = 6
Top = 360
Width = 495
End
Begin VB.Label Label1
Caption = "从："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 3
Top = 360
Width = 855
End
End
Begin VB.CommandButton Command2
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 370
Left = 3120
TabIndex = 1
Top = 2280
Width = 1330
End
Begin VB.CommandButton Command1
Caption = "确定"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 370
Left = 1440
TabIndex = 0
Top = 2280
Width = 1330
End
Begin VB.Label Label3
Caption = "Label3"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 7
Top = 2760
Visible = 0 'False
Width = 5655
End
End
Attribute VB_Name = "frmBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim stDate1 As String
Dim stDate2 As String
Private Sub Command1_Click() '备份
Dim pslist As New ADODB.Recordset '本地临时库
Dim pslisttmp As New ADODB.Recordset '本地临时库
Dim rs As New ADODB.Recordset
Dim txtM1_CardID As String
Dim txtM1_Cdate As String
Dim txtM1_Ctime As String
Dim txtM1_CardType As String
Dim txtM1_addmoney As String
Dim txtM1_balance As String
Dim txtM1_balance_old As String
Dim pbIn(32) As Byte
Dim pbinTmp(8) As String
Dim i As Integer
Dim psBFPathFile As String
Dim psPathFile As String
Dim txtI As Integer
Dim a1 As String
Dim a2 As String
Dim a3 As String
Dim a4 As String
Dim a5 As String
Dim a6 As String
Dim a7 As String
Dim a8 As String
Dim sExcute As String
Dim sTmp As New ADODB.Recordset
On Error GoTo err:
'txtPath = "\\192.168.0.131\Client\"
'Open App.Path + "\data.txt" For Output As #1 'Binary As #1 'Output As #1
If txtPath = "" And Left(txtPath, 2) <> "\\" And Right(txtPath, 1) <> "\" Then
MsgBox "路径设置错误！", vbCritical + vbOKOnly, "警告"
Exit Sub
End If
txtI = 0
Set pslist = GetRecordset(maSys_db, "select * from linkaddmoneybuffer where r_send='09' order by m1_cdate,m1_ctime ")
If pslist.RecordCount <> 0 Then
pslist.MoveFirst
Else
Exit Sub
End If
Do While Not pslist.EOF
''''''''''temp
''''' a1 = pslist.Fields("cpu_cardid")
''''' a2 = pslist.Fields("m1_cardid")
''''' a3 = pslist.Fields("m1_cardtype")
''''' a4 = pslist.Fields("m1_addmoney")
''''' a5 = pslist.Fields("m1_balance")
''''' a6 = pslist.Fields("m1_cdate")
''''' a7 = pslist.Fields("m1_ctime")
''''' sExcute = "insert LinkAddMoneyBuffer(Cpu_CardID,M1_CardID,M1_CardType,M1_AddMoney," & _
''''' "M1_Balance,M1_CDate,M1_CTime,R_Send" & _
''''' " ) values( " & _
''''' "'" & a1 & "'," & "'" & a2 & "'," & "'" & a3 & "'," & a4 & "," & a5 & ", '" & a6 & "', '" & a7 & "','03')"
'''''
''''' maSys_db.Execute sExcute
'''''''''''temp
For i = 0 To 31
pbIn(i) = &H0
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
txtM1_CardID = hex(CDbl(Val(pslist.Fields("m1_cardid"))))
If Len(txtM1_CardID) <= 8 Then
Do While Not Len(txtM1_CardID) = 8
txtM1_CardID = "0" + txtM1_CardID
Loop
Else
Exit Sub
End If
pbIn(3) = "&H" + Mid(txtM1_CardID, 1, 2)
pbIn(2) = "&H" + Mid(txtM1_CardID, 3, 2)
pbIn(1) = "&H" + Mid(txtM1_CardID, 5, 2)
pbIn(0) = "&H" + Mid(txtM1_CardID, 7, 2)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
pbIn(4) = &HF
pbIn(5) = &HF
pbIn(6) = &HF
pbIn(7) = &HF
pbIn(8) = "&h" + hex(CDbl(Val(pslist.Fields("m1_cardtype"))))
pbIn(9) = &H50
pbIn(10) = &H8
pbIn(11) = &H8
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
txtM1_balance_old = hex(CDbl(pslist.Fields("m1_balance_old") * 100))
If Len(txtM1_balance_old) <= 8 Then
Do While Not Len(txtM1_balance_old) = 8
txtM1_balance_old = "0" + txtM1_balance_old
Loop
Else
Exit Sub
End If
pbIn(15) = "&H" + Mid(txtM1_balance_old, 1, 2)
pbIn(14) = "&H" + Mid(txtM1_balance_old, 3, 2)
pbIn(13) = "&H" + Mid(txtM1_balance_old, 5, 2)
pbIn(12) = "&H" + Mid(txtM1_balance_old, 7, 2)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If pslist.Fields("m1_addmoney") < 0 Then
txtM1_addmoney = pslist.Fields("m1_addmoney") * 100
txtM1_addmoney = Right(txtM1_addmoney, Len(txtM1_addmoney) - 1)
Else
txtM1_addmoney = pslist.Fields("m1_addmoney") * 100
End If
txtM1_addmoney = hex(CDbl(txtM1_addmoney))
If Len(txtM1_addmoney) <= 8 Then
Do While Not Len(txtM1_addmoney) = 6
txtM1_addmoney = "0" + txtM1_addmoney
Loop
Else
Exit Sub
End If
pbIn(18) = "&H" + Mid(txtM1_addmoney, 1, 2)
pbIn(17) = "&H" + Mid(txtM1_addmoney, 3, 2)
pbIn(16) = "&H" + Mid(txtM1_addmoney, 5, 2)
txtM1_Cdate = pslist.Fields("m1_cdate")
pbIn(19) = "&h" + Mid(txtM1_Cdate, 1, 2)
pbIn(20) = "&h" + Mid(txtM1_Cdate, 3, 2)
pbIn(21) = "&h" + Mid(txtM1_Cdate, 6, 2)
pbIn(22) = "&h" + Mid(txtM1_Cdate, 9, 2)
txtM1_Ctime = pslist.Fields("m1_ctime")
pbIn(23) = "&h" + Mid(txtM1_Ctime, 1, 2)
pbIn(24) = "&h" + Mid(txtM1_Ctime, 4, 2)
pbIn(25) = "&h" + Mid(txtM1_Ctime, 7, 2)
For i = 26 To 31
pbIn(i) = &H0
Next
pbWrite = WriteData(pbIn())
pslist.MoveNext
txtI = 1
'''''' Set rs = GetRecordset(maSys_db, "select * from listtmp where m1_cardid='" & txtM1_CardID & "' and m1_cdate='" & txtM1_Cdate & "' and m1_ctime='" & txtM1_Ctime & "'")
'''''' If rs.EOF And rs.BOF Then
'''''' pslisttmp.Open "select * from listtmp", maSys_db, 3, 3
'''''' pslisttmp.AddNew
'''''' pslisttmp.Fields("cpu_cardid") = Format(Val(txtCpu_CardID), "00000000") '8
'''''' pslisttmp.Fields("user_id") = Format(Trim(txtUser), "00000000") '8
'''''' pslisttmp.Fields("m1_readerno") = Format(Val(txtCpu_CardID), "00000000") '08
'''''' pslisttmp.Fields("m1_cardid") = Format(txtM1_CardID, "000000000000") '8
'''''' pslisttmp.Fields("m1_cardtype") = txtM1_CardType
'''''' pslisttmp.Fields("m1_addmoney") = Val(txtM1_addmoney)
'''''' pslisttmp.Fields("m1_balance") = Val(txtM1_balance)
'''''' pslisttmp.Fields("m1_balance_old") = Val(txtM1_balance_old)
'''''' pslisttmp.Fields("m1_cdate") = txtM1_Cdate
'''''' pslisttmp.Fields("m1_ctime") = txtM1_Ctime
'''''' pslisttmp.Fields("r_send") = "03"
'''''' pslisttmp.Update
'''''' pslisttmp.Close
''''''
''''''
'''''' End If
'''''' pslist.MoveNext
Loop
''''''''''''''''''''''''''''''''将备份文件更名后拷贝到指定备份目录
psPathFile = App.Path & "\" + "data.full"
psBFPathFile = txtPath + "data.full"
FileCopy psPathFile, psBFPathFile
Name psBFPathFile As txtPath & Format(Now, "yyyymmddhhmmss") + ".full"
''''''''''''''''''''''''''''''''删除当前目录下的备份文件
Kill psPathFile
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''备份后删除表内已经解包数据
'maSys_db.Execute "delete linkaddmoneybuffer where r_send='09'"
Exit Sub
err:
If txtI = 1 Then
Kill psPathFile
End If
Exit Sub
'''''''''' LinkTimer.Enabled = False
'''''''''' On Error GoTo err1
''''''''''r1:
'''''''''' If piDial = 0 Then
'''''''''' giDial = Shell("RUNDLL32.EXE RNAUI.DLL,RnaRunImport " _
'''''''''' & App.Path & "\gjgs.dun", 1)
'''''''''' Else
'''''''''' AppActivate giDial
'''''''''' End If
'''''''''' LinkTimer.Enabled = True
'''''''''' Exit Sub
''''''''''
''''''''''err1:
'''''''''' If err.Number = 5 Then
'''''''''' piDial = 0
'''''''''' Resume r1
'''''''''' Else
'''''''''' Exit Sub
'''''''''' End If
End Sub
Private Sub Form_Load()
DTPicker1.Value = Format(Now, "yyyy-mm-dd")
DTPicker2.Value = Format(Now, "yyyy-mm-dd")
stDate1 = Format(DTPicker1.Value, "yyyy-mm-dd")
stDate2 = Format(DTPicker2.Value, "yyyy-mm-dd")
Me.Top = (Screen.Height - Me.Height) / 2 + 200
Me.Left = (Screen.Width - Me.Width) / 2
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -