'*******************************
'*******************************
'****    Zeki Gürsoy ©  ********
'****       2008        ********
'*******************************
'*******************************
'17.03.2008 => Güncelleme : 10 Mb lık birimler halinde kopyalama hızı artırıldı.
 
Option Base 1
 
Sub Yedekle()
Const BackUpFile    As String = "C:\BackUp.mdb"
Const tmpBackUpFile As String = "C:\tmpBackUp.mdb"
 
WinRARX$ = Environ$("ProgramFiles") & "\WinRAR\rar.exe"
 
    '// Yedekleme proseduru..
    Yedek_Proc CurrentProject.FullName, BackUpFile
 
    '// Veritabanı sıkıştırma ve onarma.. _
        Ver. 2000 - 2002 - 2003 için !!!
    DBEngine.CompactDatabase _
            BackUpFile, tmpBackUpFile
 
    '// İlk yedeği sil..
    Kill BackUpFile
 
    '// Sıkıştırma işlemi için geçici dosyanın _
        adına orjinal ismini ver..
    While Dir(tmpBackUpFile) = ""
        DoEvents
    Wend
'
    Name tmpBackUpFile As BackUpFile
 
    '// WinRAR ile sıkıştırma...
    Shell WinRARX & _
        " M -ep " & Chr(34) & Left$(BackUpFile, Len(BackUpFile) - 4) & ".rar" & _
                Chr(34) & " " & Chr(34) & BackUpFile & Chr(34)
    MsgBox "Yedekleme işlemi tamamlandı.", vbInformation
End Sub
 
Sub Yedek_Proc(Kaynak_Dosya As String, Hedef_Dosya As String)
On Error GoTo Hata
 
'// 10485760 Byte = 10 MB
Dim s(10485760) As Byte, X As Long
Dim T() As Byte, i As Integer
 
    Open Kaynak_Dosya For Binary Access Read As #1
    Open Hedef_Dosya For Binary Access Write As #2
 
    '// Döngünün kaç kez çalışması gerektiğini _
        toplam dosya boyutunun 10 MB ile bölümün _
        tamsayı değeri ile buluruz.
    For i = 1 To Int(LOF(1) / 10485760)
        Get #1, , s
        Put #2, , s
    Next
 
    Erase s
 
    '// Eğer kalan Byte 10 MB dan küçükse _
        kalan Byte aşağıdaki yapı ile eklenir.
    X = LOF(1) - LOF(2)
    If X > 0 Then
        ReDim T(X) As Byte
        Get #1, , T
        Put #2, , T
        Erase T
    End If
 
Cikis:
    Close #1
    Close #2
 
  Exit Sub
 
Hata: MsgBox "Hata olustu." & Chr(10) & Err.Description
    GoTo Cikis
End Sub