数据备份问题，请指点~~~~~~

[xhstudio]

我做了一个小程序，需要将数据备份，可试了几个压缩控件都不好用
哪位大哥有好用的给小弟一个好用的控件或好的备份方法，谢谢了~~~~

[ivt]

如是SQL数据库
直接用
backup database XXXX to disk='c:\backup\XXX.bak'
就行
restore database XXXX from disk=''

[xhstudio]

是ACCESS的数据库呀
本来我想用压缩控件的，可是没找到好用的，好多都不好用，还有别的办法吗

[xayzmb]

导出到文本文件
恢复时
再从文本文件读回来。

[TRUE]

access 有压缩的功能，可以查找一下

[xhstudio]

可能是我没说明白吧
把数据备份到软盘上啊，我想还压缩 下好吧，那么不就要用到压缩控件
我的ACCESS库里有3个表，做文本不好吧，如果文件大于1。44了，那就要分盘，
所以本本和ACCESS本身的压缩好像就不实用了吧

大家做程序的时候不做备份功能吗？

[zhangbob]

' 压缩 Access 数据库
Public Sub CompactJetDatabase(SourceFile As String, Optional Password As String, Optional BackupOriginal As Boolean = True)
On Error GoTo CompactErr

Dim strBackupFile As String
Dim strTempFile As String

' 判断来源文件是否存在
If Dir(SourceFile) <> "" Then
' 如果需要备份原文件
If BackupOriginal = True Then
strBackupFile = GetSourceFilePath(SourceFile) & "Backup.mdb"
If Dir(strBackupFile) <> "" Then
Kill strBackupFile
End If

FileCopy SourceFile, strBackupFile
End If

' 建立压缩文件名
strTempFile = GetSourceFilePath(SourceFile) & "Temp.mdb"
If Dir(strTempFile) <> "" Then
Kill strTempFile
End If

' 通过 DBEngine 压缩文件，注意，您必须引用 Microsoft DAO 3.xx Object Library
DBEngine.CompactDatabase SourceFile, strTempFile, , , ";Pwd=" & Password & ";"
' 删除旧文件
Kill SourceFile

' 重新命名新文件名
Name strTempFile As SourceFile
Else
MsgBox SourceFile & "File not fond！", vbExclamation
End If

CompactErr:
If Err.Number <> 0 Then
MsgBox Err.Description & Err.Number, vbCritical, "error"
End If

On Error GoTo 0
Exit Sub
End Sub

Public Function GetSourceFilePath(SourceFile As String) As String
Dim n As Integer

n = InStrRev(SourceFile, "\")
GetSourceFilePath = Left(SourceFile, n)
End Function

Public Function fBrowseForFolder(hWndOwner As Long, sPrompt As String) As String
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo

With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With

lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)

iNull = InStr(sPath, vbNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If

fBrowseForFolder = sPath

End Function

' 备份这个数据库
Public Function BackupDB(ByVal SourceFile As String, ByVal BackupFolderName As String) As Boolean
On Error Resume Next
Dim lFileOp As Long
Dim lResult As Long
Dim lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim strSourceDir As String
Dim strDestinationDir As String

Screen.MousePointer = vbHourglass

If Right(BackupFolderName, 1) <> "\" Then
BackupFolderName = BackupFolderName & "\"
End If

lFileOp = FO_COPY
lFlags = lFlags And Not FOF_SILENT
lFlags = lFlags Or FOF_NOCONFIRMATION
lFlags = lFlags Or FOF_NOCONFIRMMKDIR
lFlags = lFlags Or FOF_FILESONLY

With SHFileOp
.wFunc = lFileOp
.pFrom = SourceFile & vbNullChar
.pTo = BackupFolderName & "PMBackup" & Format(Date, "mmdd") & ".pmb"
.fFlags = lFlags
End With
lResult = SHFileOperation(SHFileOp)

BackupDB = (lResult = 0)

Screen.MousePointer = vbDefault
End Function

' 还原这个数据库
Public Function RestoreDB(ByVal SourceFile As String, ToFile As String) As Boolean
On Error Resume Next
Dim lFileOp As Long
Dim lResult As Long
Dim lFlags As Long
Dim SHFileOp As SHFILEOPSTRUCT

Screen.MousePointer = vbHourglass

lFileOp = FO_COPY
lFlags = lFlags And Not FOF_SILENT
lFlags = lFlags Or FOF_NOCONFIRMATION
lFlags = lFlags Or FOF_NOCONFIRMMKDIR
lFlags = lFlags Or FOF_FILESONLY

With SHFileOp
.wFunc = lFileOp
.pFrom = SourceFile & vbNullChar
.pTo = ToFile & vbNullChar
.fFlags = lFlags
End With
lResult = SHFileOperation(SHFileOp)

RestoreDB = (lResult = 0)

Screen.MousePointer = vbDefault
End Function

[lxcc]

up