📄 frmbackup.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Frmbackup
BorderStyle = 3 'Fixed Dialog
Caption = "数据备份"
ClientHeight = 2895
ClientLeft = 45
ClientTop = 330
ClientWidth = 4770
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2895
ScaleWidth = 4770
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdOk
Caption = "保存设置(&S)"
Height = 345
Left = 330
TabIndex = 15
Top = 2430
Width = 1110
End
Begin VB.CommandButton cmdQuit
Caption = " 返回(&Q)"
Height = 345
Left = 3420
TabIndex = 14
Top = 2460
Width = 1125
End
Begin VB.TextBox Txttemp
Height = 270
Left = -1320
TabIndex = 13
Top = 2160
Visible = 0 'False
Width = 975
End
Begin MSComDlg.CommonDialog CommonOpen
Left = 4230
Top = 1500
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "打开"
Filter = "*.dmp"
InitDir = "c:\"
End
Begin VB.Frame Frame2
Height = 855
Left = 120
TabIndex = 10
Top = 1320
Width = 4575
Begin VB.CommandButton CmdBrowse
Caption = "浏览"
Height = 300
Left = 3720
TabIndex = 12
Top = 360
Width = 735
End
Begin VB.TextBox TxtFileName
Height = 270
Left = 1080
TabIndex = 3
Top = 360
Width = 2535
End
Begin VB.Label Label4
Caption = "备份文件名"
Height = 375
Left = 120
TabIndex = 11
Top = 360
Width = 1335
End
End
Begin VB.Frame Frame1
Caption = "用户信息"
Height = 1335
Left = 120
TabIndex = 5
Top = 0
Width = 4575
Begin VB.TextBox Text5
Height = 270
Left = 1080
TabIndex = 9
Text = "EXPDAT.DMP"
Top = 1440
Width = 2295
End
Begin VB.TextBox TxtServerName
Height = 270
Left = 960
TabIndex = 2
Top = 960
Width = 3495
End
Begin VB.TextBox TxtPassword
Height = 270
IMEMode = 3 'DISABLE
Left = 960
PasswordChar = "*"
TabIndex = 1
Top = 600
Width = 3495
End
Begin VB.TextBox TxtUserID
Height = 270
Left = 960
TabIndex = 0
Top = 240
Width = 3495
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "服务器名"
Height = 180
Left = 120
TabIndex = 8
Top = 960
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "用户密码"
Height = 180
Left = 120
TabIndex = 7
Top = 600
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "用户名"
Height = 180
Left = 120
TabIndex = 6
Top = 240
Width = 540
End
End
Begin VB.CommandButton cmdBackup
Caption = "备份(&B)"
Height = 345
Left = 1830
TabIndex = 4
Top = 2430
Width = 1125
End
End
Attribute VB_Name = "Frmbackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SearchPath Lib "kernel32" Alias "SearchPathA" (ByVal lpPath As String, ByVal lpFileName As String, ByVal lpExtension As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, _
lpTotalNumberOfClusters As Long) As Long
'''''''''''''''''''''''''''''''20010926 end by wb''''''''''''''''''''''''
'标准格式："c:\orawin95\bin\exp80.exe qjybuser2/qjyb2@ora8 file=c:\w.dmp"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdBrowse_Click()
Dim i As Integer
CommonOpen.filename = TxtFileName
CommonOpen.InitDir = "c:\"
CommonOpen.ShowOpen
If Trim(CommonOpen.filename) = "" Then
Else
i = InStr(1, CommonOpen.filename, ".", vbTextCompare)
If g_FLAT = "ORACLE" Then
If Mid(CommonOpen.filename, i + 1, 3) <> "dmp" And Mid(CommonOpen.filename, i + 1, 3) <> "DMP" Then
TxtFileName = Mid(CommonOpen.filename, 1, i) & "dmp"
Else
TxtFileName = CommonOpen.filename
End If
Else
If Mid(CommonOpen.filename, i + 1, 3) <> "dat" And Mid(CommonOpen.filename, i + 1, 3) <> "DAT" Then
TxtFileName = Mid(CommonOpen.filename, 1, i) & "dmp"
Else
TxtFileName = CommonOpen.filename
End If
End If
End If
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
Public Sub cmdBackup_Click()
'磁盘信息
Dim lSectorsPerCluster As Long
Dim lBytesPerSector As Long
Dim lNumberOfFreeClusters As Long
Dim lTotalNumberOfClusters As Long
Dim lFreeBytes As Long
TxtFileName.text = Trim(TxtFileName.text)
Dim i
If TxtUserID = "" Then
MsgBox "用户名不能为空!", vbOKOnly, "提示"
TxtUserID.SetFocus
Exit Sub
End If
If TxtServerName = "" Then
MsgBox "数据库名不能为空!", vbOKOnly, "提示"
TxtServerName.SetFocus
Exit Sub
End If
If TxtFileName = "" Then
MsgBox "文件名不能为空!", vbOKOnly, "提示"
TxtServerName.SetFocus
Exit Sub
Else
i = InStr(1, TxtFileName.text, ".", vbTextCompare)
If i = 0 Then
If g_FLAT = "ORACLE" Then
MsgBox "文件扩展名必须为.dmp!", vbOKOnly, "提示"
Else
MsgBox "文件扩展名必须为.dat!", vbOKOnly, "提示"
End If
TxtFileName.SetFocus
TxtFileName.SelStart = 0
TxtFileName.SelLength = Len(TxtFileName.text)
Exit Sub
Else
If g_FLAT = "ORACLE" Then
If Mid(TxtFileName.text, i + 1, 3) <> "dmp" And Mid(TxtFileName.text, i + 1, 3) <> "DMP" Then
MsgBox "文件扩展名必须为.dmp!", vbOKOnly, "提示"
TxtFileName.SetFocus
TxtFileName.SelStart = 0
TxtFileName.SelLength = Len(TxtFileName.text)
Exit Sub
End If
Else
If Mid(TxtFileName.text, i + 1, 3) <> "dat" And Mid(TxtFileName.text, i + 1, 3) <> "DAT" Then
MsgBox "文件扩展名必须为.dat!", vbOKOnly, "提示"
TxtFileName.SetFocus
TxtFileName.SelStart = 0
TxtFileName.SelLength = Len(TxtFileName.text)
Exit Sub
End If
End If
End If
End If
Dim filename, FilePart As String
Dim FilePath As String * 100
Dim ReturnValue, BufferLength As Long
Dim pidNotepad As Long
Dim m_sPath As String
If g_FLAT = "ORACLE" Then
filename = "exp80.exe"
BufferLength = 1024
ReturnValue = SearchPath(vbNullString, filename, vbNullString, BufferLength, FilePath, FilePart)
If ReturnValue = 0 Then
MsgBox "exp80.exe应用程序丢失！", vbCritical, "出错"
Exit Sub
End If
End If
'If CheckUser(Userinform.Userid, "a05") Then '参数说明: 用户代码,模块代码
Dim s As String * 200
Dim t As String
Dim f As New FileSystemObject
Dim m_bFlag As Boolean
Txttemp.text = FilePath
s = Trim(Txttemp.text) & " " & Trim(TxtUserID.text) & "/" & Trim(TxtPassword.text) & "@" & Trim(TxtServerName.text) & " file=" & Trim(TxtFileName.text)
t = Trim(TxtFileName.text)
'当前磁盘还有多少剩余空间
GetDiskFreeSpace Left(t, 2), lSectorsPerCluster, lBytesPerSector, _
lNumberOfFreeClusters, lTotalNumberOfClusters
'如果剩余空间约300M左右，则提示
If lNumberOfFreeClusters <= 75000 Then
MsgBox "磁盘空间不足，请删除不需要的备份文件！", vbInformation
Exit Sub
End If
If Dir(t) <> "" Then
If MsgBox("备份文件" & Trim(TxtFileName.text) & "已存在，要覆盖吗？", vbOKCancel, "提示") = vbOK Then
m_bFlag = True
Else
TxtFileName.SetFocus
Exit Sub
End If
End If
On Error GoTo ErrMessageSec
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
cmd.ActiveConnection = gloSys.cnnSys
cmd.CommandType = adCmdText
If m_bFlag Then
f.DeleteFile (t)
End If
If g_FLAT = "ORACLE" Then
pidNotepad = Shell(s, vbMaximizedFocus)
Else
' cmd.CommandText = "EXEC sp_addumpdevice 'disk', 'ykcw', '" & Trim(TxtFileName.text) & "'"
' cmd.Execute
cmd.CommandText = "BACKUP DATABASE " & TxtServerName.text & " TO disk='" & Trim(TxtFileName.text) & "'"
cmd.Execute
End If
Sleep (5000) '延时,等待文件创建
If Dir(t) <> "" Then
MsgBox "备份完成！", vbInformation, "提示"
Else
MsgBox "备份出错，请检查用户信息、备份路径（DOS目录格式）或网络！", vbCritical, "提示"
TxtUserID.SetFocus
Exit Sub
End If
'End If
Exit Sub
ErrMessageSec:
MsgBox "正在备份过程中！应用程序运行出错！", vbInformation, "提示"
End Sub
Private Sub cmdOk_Click()
Dim i As Integer
TxtFileName.text = Trim(TxtFileName.text)
If TxtUserID = "" Then
MsgBox "用户名不能为空!", vbOKOnly, "提示"
TxtUserID.SetFocus
Exit Sub
End If
If TxtServerName = "" Then
MsgBox "数据库名不能为空!", vbOKOnly, "提示"
TxtServerName.SetFocus
Exit Sub
End If
If TxtFileName = "" Then
MsgBox "文件名不能为空!", vbOKOnly, "提示"
TxtServerName.SetFocus
Exit Sub
Else
i = InStr(1, TxtFileName.text, ".", vbTextCompare)
If i = 0 Then
If g_FLAT = "ORACLE" Then
MsgBox "文件扩展名必须为.dmp!", vbOKOnly, "提示"
Else
MsgBox "文件扩展名必须为.dat!", vbOKOnly, "提示"
End If
TxtFileName.SetFocus
TxtFileName.SelStart = 0
TxtFileName.SelLength = Len(TxtFileName.text)
Exit Sub
Else
If g_FLAT = "ORACLE" Then
If Mid(TxtFileName.text, i + 1, 3) <> "dmp" And Mid(TxtFileName.text, i + 1, 3) <> "DMP" Then
MsgBox "文件扩展名必须为.dmp!", vbOKOnly, "提示"
TxtFileName.SetFocus
TxtFileName.SelStart = 0
TxtFileName.SelLength = Len(TxtFileName.text)
Exit Sub
End If
Else
If Mid(TxtFileName.text, i + 1, 3) <> "dat" And Mid(TxtFileName.text, i + 1, 3) <> "DAT" Then
MsgBox "文件扩展名必须为.dat!", vbOKOnly, "提示"
TxtFileName.SetFocus
TxtFileName.SelStart = 0
TxtFileName.SelLength = Len(TxtFileName.text)
Exit Sub
End If
End If
End If
End If
If g_FLAT = "ORACLE" Then
SaveSetting App.Title, "Backup", "OracleUserId", Trim(TxtUserID.text)
SaveSetting App.Title, "Backup", "OraclePassword", Trim(TxtPassword.text)
SaveSetting App.Title, "Backup", "OracleServerDSN", Trim(TxtServerName.text)
Else
SaveSetting App.Title, "Backup", "SQLUserId", Trim(TxtUserID.text)
SaveSetting App.Title, "Backup", "SQLPassword", Trim(TxtPassword.text)
SaveSetting App.Title, "Backup", "SQLDatabase", Trim(TxtServerName.text)
End If
SaveSetting App.Title, "Backup", "Path", Trim$(Left(TxtFileName.text, InStrRev(TxtFileName.text, "\")))
End Sub
Private Sub Form_Load()
Me.Icon = frmSystem.Icon
If g_FLAT = "SQL" Then
Label3.Caption = "数据库："
TxtUserID.text = GetSetting(App.Title, "Backup", "SQLUserId", "")
TxtPassword.text = GetSetting(App.Title, "Backup", "SQLPassword", "")
TxtServerName.text = GetSetting(App.Title, "Backup", "SQLDatabase", "ora8")
TxtFileName.text = GetSetting(App.Title, "Backup", "Path", "") & "expdat" & Format(Date, "yyyymmdd") & ".dat"
Else
TxtUserID.text = GetSetting(App.Title, "Backup", "OracleUserId", "")
TxtPassword.text = GetSetting(App.Title, "Backup", "OraclePassword", "")
TxtServerName.text = GetSetting(App.Title, "Backup", "OracleServerDSN", "ora8")
TxtFileName.text = GetSetting(App.Title, "Backup", "Path", "") & "expdat" & Format(Date, "yyyymmdd") & ".dmp"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -