📄 frmbflj.frm
字号:
VERSION 5.00
Begin VB.Form Frmbflj
BorderStyle = 3 'Fixed Dialog
Caption = "请确定数据备份路径和文件名"
ClientHeight = 4620
ClientLeft = 45
ClientTop = 330
ClientWidth = 6510
ControlBox = 0 'False
Icon = "Frmbflj.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4620
ScaleWidth = 6510
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.FileListBox File1
Height = 810
Left = 1560
TabIndex = 11
Top = 3600
Visible = 0 'False
Width = 2055
End
Begin VB.Frame Frame3
Height = 30
Left = 240
TabIndex = 10
Top = 3900
Width = 6020
End
Begin VB.TextBox Text3
DataField = "路径"
DataSource = "Data1"
Height = 270
Left = 720
TabIndex = 9
Text = "Text3"
Top = 4080
Visible = 0 'False
Width = 375
End
Begin VB.TextBox Text2
DataField = "盘符"
DataSource = "Data1"
Height = 270
Left = 120
TabIndex = 8
Text = "Text2"
Top = 4080
Visible = 0 'False
Width = 375
End
Begin VB.Data Data1
Caption = "Data1"
Connect = ";pwd=ZH69Y11Jun24"
DatabaseName = "autoxtsz.mdb"
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 240
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "备份路径"
Top = 3600
Visible = 0 'False
Width = 1065
End
Begin VB.TextBox Text1
Height = 270
Left = 3840
TabIndex = 7
Top = 3240
Width = 2295
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 375
Left = 5040
TabIndex = 6
Top = 4080
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "确定"
Height = 375
Left = 3600
TabIndex = 5
Top = 4080
Width = 1095
End
Begin VB.DirListBox Dir1
Height = 1770
Left = 2760
TabIndex = 3
Top = 1320
Width = 3375
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 2760
TabIndex = 2
Top = 960
Width = 3375
End
Begin VB.OptionButton Option2
Caption = "备份到硬盘"
Height = 255
Left = 2760
TabIndex = 1
Top = 600
Width = 1215
End
Begin VB.OptionButton Option1
Caption = "备份到A盘"
Height = 255
Left = 2760
TabIndex = 0
Top = 240
Width = 1215
End
Begin VB.Image Image3
Height = 270
Left = 2280
Picture = "Frmbflj.frx":000C
Stretch = -1 'True
Top = 600
Visible = 0 'False
Width = 375
End
Begin VB.Image Image2
Height = 270
Left = 2300
Picture = "Frmbflj.frx":044E
Stretch = -1 'True
Top = 240
Visible = 0 'False
Width = 285
End
Begin VB.Image Image1
Height = 3360
Left = 240
Picture = "Frmbflj.frx":0980
Stretch = -1 'True
Top = 240
Width = 1920
End
Begin VB.Label Label1
Caption = "备份文件名"
Height = 255
Left = 2760
TabIndex = 4
Top = 3285
Width = 975
End
End
Attribute VB_Name = "Frmbflj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Sub CopyFileWindowsWay(SourceFile As String, DestinationFile As String)
Dim lngReturn As Long
Dim typFileOperation As SHFILEOPSTRUCT
With typFileOperation
.hwnd = 0
.wFunc = FO_COPY
.pFrom = SourceFile & vbNullChar & vbNullChar '源文件。
.pTo = DestinationFile & vbNullChar & vbNullChar '目标文件。
.fFlags = FOF_ALLOWUNDO
End With
'拷贝操作。
lngReturn = SHFileOperation(typFileOperation)
If lngReturn <> 0 Then '如果拷贝失败。
MsgBox "数据备份失败!", vbInformation Or vbOKOnly, "提示信息"
Shibai = True
Else
If typFileOperation.fAnyOperationsAborted = True Then
MsgBox "Operation Failed", vbInformation Or vbOKOnly
End If
End If
End Sub
Private Sub Command1_Click()
Text2.Text = Drive1.Drive
Text3.Text = Dir1.Path
Data1.Refresh
'调用拷贝函数。
If Option2.Value = True Then
Frmbf.Show 1
ElseIf Option1.Value = True Then
On Error GoTo dfe
Me.File1.FileName = "a:\"
Call CopyFileWindowsWay(App.Path & "\data.mdb", "a:" & "\" & Text1.Text & ".ofb")
If Shibai = True Then
Shibai = False
Exit Sub
End If
MsgBox "数据备份成功!", vbOKOnly Or vbInformation, "信息提示"
Exit Sub
dfe:
MsgBox "设备未准备好!", vbOKOnly Or vbInformation, "信息提示"
End If
End Sub
Private Sub Command2_Click()
ChDrive App.Path
ChDir App.Path
Unload Me
End Sub
Private Sub Command3_Click()
End Sub
Private Sub Drive1_Change()
On Error GoTo dfe
Dir1.Path = Drive1.Drive
Exit Sub
dfe:
MsgBox "设备未准备好!", vbOKOnly Or vbInformation, "信息提示"
End Sub
Private Sub Form_Activate()
Me.Drive1.Drive = Text2
'Me.Dir1.Path = Text3
End Sub
Private Sub Form_Load()
'Frmbflj.Text1 = DateSerial(Year(Now), Month(Now), Day(Now)) & "承兑台帐备份"
Frmbflj.Text1.Text = "承兑台帐备份"
End Sub
Private Sub Option1_Click()
On Error GoTo dfe
Me.Option1.Value = True
Me.Option2.Value = False
Me.Drive1.Enabled = False
Me.Dir1.Enabled = False
Exit Sub
dfe:
MsgBox "设备未准备好!", vbOKOnly Or vbInformation, "信息提示"
End Sub
Private Sub Option2_Click()
On Error GoTo dfe
Me.Option2.Value = True
Me.Option1.Value = False
Me.Drive1.Enabled = True
Me.Dir1.Enabled = True
Me.Drive1.Drive = Text2
Me.Dir1.Path = Text3
Exit Sub
dfe:
MsgBox "设备未准备好!", vbOKOnly Or vbInformation, "信息提示"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -