silahkan lanjutkan aja
silahkan aja di copas ni kode pada module
Option Explicit
'Translate the literals if you want...
Const MSG_01 = "Dibuat Oleh: " 'created by
Const MSG_02 = "NamaDatabase: " 'database name
Const MSG_03 = "Tanggal/Waktu: " 'Data and time
Const MSG_04 = "DD/MM/YY HH:MM:SS" 'Your prefered format to display dates
Const MSG_05 = "DBMS: MySQL v"
Const MSG_06 = "Struktur Tabel " 'Table structure
Const MSG_07 = "Data Tabel " 'Table data
Const MSG_08 = "Akhir dari Backup: " 'End of backup
Public Sub MySQLBackup(ByVal strFileName As String, cnn As ADODB.Connection)
' strFileName contains the filename where you want to backup to go...
' It will overwrite the file if it exists...
' cnn is the current conection with the database...
On Error Resume Next
Dim rss As ADODB.Recordset
Dim rssAux As ADODB.Recordset
Dim X As Long, i As Integer
Dim strTableName As String
Dim strCurLine As String
Dim strBuffer As String
Dim strDBName As String
X = FreeFile
Open strFileName For Output As X
Print #X, ""
Print #X, "#"
Print #X, "# " & MSG_01 & App.Title & " v" & App.Major & "." & App.Minor & "." & App.Revision
'Looking for the database name
strDBName = Mid(cnn.ConnectionString, InStr(cnn.ConnectionString, "DATABASE=") + 9)
strDBName = Left(strDBName, InStr(strDBName, ";") - 1)
Print #X, "# " & MSG_02 & strDBName
Set rss = New ADODB.Recordset
Set rssAux = New ADODB.Recordset
'Looking for the version of MySQL
Print #X, "# " & MSG_03 & Format(Now, MSG_04)
rss.Open "show variables like 'version';", cnn
If Not rss.EOF Then
Print #X, "# " & MSG_05 & rss.Fields(1)
End If
rss.Close
'Preventing errors by foreign key violation during the restoring process
Print #X, "#"
Print #X, ""
Print #X, "SET FOREIGN_KEY_CHECKS=0;"
Print #X, ""
strTableName = ""
With rss
.Open "SHOW TABLE STATUS", cnn
'For each table...
Do While Not .EOF
strTableName = .Fields.Item("Name").Value
With rssAux
.Open "SELECT * FROM " & strTableName & "", cnn
If Not .EOF Then
Print #X, "INSERT INTO `" & strTableName & "` VALUES "
Do While Not .EOF
strCurLine = ""
For i = 0 To .Fields.Count - 1
strBuffer = .Fields.Item(i).Value
If .Fields.Item(i).Type = 131 Then
strBuffer = Replace(Format(strBuffer, "0.00"), ",", ".")
End If
'Some safe replacements...
strBuffer = Replace(strBuffer, "\", "\\")
strBuffer = Replace(strBuffer, "'", "\'")
strBuffer = Replace(strBuffer, Chr(10), "")
strBuffer = Replace(strBuffer, Chr(13), "\r\n")
If strCurLine <> "" Then
strCurLine = strCurLine & ", "
End If
strCurLine = strCurLine & "'" & strBuffer & "'"
Next i
.MoveNext
strCurLine = "(" & strCurLine & ")"
If .EOF Then
Print #X, strCurLine & ";"
Else
Print #X, strCurLine & ","
End If
Loop
End If
.Close
End With
Print #X, "unlock tables;"
Print #X, "#--------------------------------------------"
.MoveNext
Loop
'Setting the DB to its normal behavior...
Print #X, ""
Print #X, "SET FOREIGN_KEY_CHECKS=1;"
Print #X, ""
Print #X, "# " & MSG_08 & Format(Now, MSG_04)
.Close
End With
Close #X
End Sub
Public Sub MySQLRestore(ByVal strFileName As String, cnn As ADODB.Connection)
' strFileName contains the filename of the backup...
' cnn is the current conection with the database...
Dim lngTotalBytes As Long, lngCurrentBytes As Long
Dim X As Integer, strCurLine As String, strAux As String
Dim blnPassLines As Boolean
Dim blnAnalizeIt As Boolean
X = FreeFile
On Error GoTo ErrDrv
Open strFileName For Input As #X
lngTotalBytes = LOF(X)
blnPassLines = False
Do While Not EOF(X)
Line Input #X, strCurLine
lngCurrentBytes = lngCurrentBytes + Len(strCurLine)
'If you want to inform the user about the progress of the restoring process...
' do so with UpdateProgressBar (or whatever name you gave it to this function).
'Call UpdateProgressBar(lngTotalBytes, lngCurrentBytes)
'DoEvents
'Avoiding comments...
blnAnalizeIt = True
strCurLine = Trim(strCurLine)
If Not blnPassLines Then
If Left(strCurLine, 1) = "#" Then
blnAnalizeIt = False
ElseIf Left(strCurLine, 2) = "/*" Then
blnAnalizeIt = False
blnPassLines = True
End If
ElseIf Right(Trim(strCurLine), 2) = "*/" Then
blnPassLines = False
blnAnalizeIt = False
End If
'if the line should be proccessed...
If blnAnalizeIt And strCurLine <> "" Then
'Do it... Searching for a whole SQL statment
' (those with a trailing semicolon)
While Mid(strCurLine, Len(strCurLine), 1) <> ";"
strAux = strCurLine
Line Input #X, strCurLine
lngCurrentBytes = lngCurrentBytes + Len(strCurLine)
strCurLine = Trim(strCurLine)
'Call UpdateProgressBar(lngTotalBytes, lngCurrentBytes)
'DoEvents
strCurLine = strAux & strCurLine
Wend
'Execute the sentence...
cnn.Execute strCurLine
End If
'Call MyDoEvents
Loop
Close #X
'Call UpdateProgressBar(lngTotalBytes, lngTotalBytes)
HackPesan "Penambahan OK"
Exit Sub
ErrDrv:
Debug.Print "ERROR:" & Err.Number & vbNewLine & Err.Description & vbNewLine, vbCritical
Err.Clear
End Sub
nah kalau ini di taruh pada command
Call MySQLBackup(App.Path + "\Backup\backup" + Format(Now, "hhmmss") + ".sql", cn)
demikian semoga bermanfaat
2 comments
ini yang sedang ana cari. thanks
ReplyTerima kasih banyak....
ReplyIzin copas nih gan.
Posting Komentar