04/11/2010, 15:15
gitarc
Merhaba Arkadaşlar bu kodlar ile otomatik yedekelem yapmaya çalışacağız veri tabanı dosyasını.
Bir adet mdi form ( FrmMain) ve bu forma ayaralar adında bir menü yapıyoruz ve aşağıdaki kodları mdi forma yapıştırıyoruz. ve Projemize references de dao360.dll eklemeyi unutmuyoruz. ve veritabanımızın adı vt1.mdb veritabanı klasörünün adıda veritabanı olmalı
sonra aşağıdaki kodlar gerekli formlara eklemeliyiz
Bir adet mdi form ( FrmMain) ve bu forma ayaralar adında bir menü yapıyoruz ve aşağıdaki kodları mdi forma yapıştırıyoruz. ve Projemize references de dao360.dll eklemeyi unutmuyoruz. ve veritabanımızın adı vt1.mdb veritabanı klasörünün adıda veritabanı olmalı
sonra aşağıdaki kodlar gerekli formlara eklemeliyiz
Option Explicit
'değişkenleri tanımlıyoruz
Dim otoyedeklead1, yedekle, otoyedekle
Private Sub MDIForm_Resize()
otoyedeklead1 = GetSetting("huseyin", "Settings", "otoyedeklead")
If otoyedeklead1 = "" Then
SaveSetting "huseyin", "Settings", "otoyedeklead", "c:/veritabani/" & Date & ".ydk"
End If
yedekle = GetSetting("huseyin", "Settings", "yedekle")
If yedekle = "" Then
SaveSetting "huseyin", "Settings", "yedekle", "c:/veritabani/vt1.ydk"
End If
otoyedekle = GetSetting("huseyin", "Settings", "otoyedekle")
If otoyedekle = "" Then
SaveSetting "huseyin", "Settings", "otoyedekle", Date
SaveSetting "huseyin", "Settings", "otoyedeklegun", 10
End If
' eğer kayıt defterinde ototyedekle alanı yoksa giriş yapıyoruz
otoyedekle = GetSetting("huseyin", "Settings", "otoyedekle")
If otoyedekle = "" Then
SaveSetting "huseyin", "Settings", "otoyedekle", Date
SaveSetting "huseyin", "Settings", "otoyedeklegun", 10
End If
otoyedekle = GetSetting("huseyin", "Settings", "otoyedekle")
If CDate(otoyedekle) <= Date Then
otoyedekleme.Show
Else
'MsgBox "Değil"
End If
End Sub
Private Sub mnuayar_Click()
ayarlar.Show
End Sub
şimide bir form daha ekliyoruz ve adını ayarlar yapıp aşagıdaki kodlar yapıştırıyoruz. bu forma bir adet commandbuton ve bir adet textbox (Text1) yerleştirip kodları yazınız
Private Sub Command1_Click()
If Text1 < 0 Or Text1 > 31 Then
MsgBox " buraya 0`dan büyük 31`den küçük bir sayı girmelisiniz", vbCritical, "Hüseyin"
Text1.SetFocus
Exit Sub
Else
End If
SaveSetting "huseyin", "Settings", "otoyedekle", DateAdd("d", Text1Text, Date)
SaveSetting "huseyin", "Settings", "otoyedeklegun", Text1.Text
Unload Me
End Sub
Private Sub Form_Load()
Text1.Text = GetSetting("huseyin", "Settings", "otoyedeklegun")
End Sub
en son olarak bir form daha ekleiyoruz ve adınınıda otoyedekle yapıp kodları yazıyoruz ve bu forma bir adet Timer (Timer1) 2 adet textbox (Text1, Text2 ) ve bir adet Progresbar ( ProgresBar1) yerleştiriyoruz
Option Explicit
' Fonksiyon ve özellikleri tanımlıyoruz
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Const HWND_TOPMOST = -1 ' Hep üstte tutan değişken değer
Const HWND_NOTOPMOST = -2 ' Hep üstte özelliğini yok eden değişken değer...
Const SWP_NOSIZE = &H1 ' Formun boyutlarını değiştirilmez yapar...
Const SWP_NOMOVE = &H2 ' Formu taşınmaz yapar...
Const SWP_NOACTIVATE = &H10 ' Form Aktif yapılmaz...
Const SWP_SHOWWINDOW = &H40 ' Pencere Görünür Yapılır...
Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Sub Form_Activate()
On Error Resume Next
' Eğer veritabanı dizini ve dosyası bulunmazsa formu kapatıyoruz
If Dir$("c:/veritabani/vt1.mdb") = "" Then
Unload Me
Exit Sub
Else
End If
' Formu en üste tutmak içIn
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE _
Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
' formu seçilemez yapıyoruzki işlem kulanıcı tarafından iptal edilemsin
otoyedekleme.Enabled = False
Dim dbsvt1 As Database
Dim dbsvt As Database
' veritabanı yolu
Set dbsvt1 = OpenDatabase("c:/veritabani/vt1.mdb")
' yedeklenecek veritabanı dosyasını sıkıştırarak boyutunu kültüyoruz
With dbsvt1
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With
If Dir("c:/veritabani/vt.mdb") <> "" Then _
Kill "c:/veritabani/vt.mdb"
DBEngine.CompactDatabase "c:/veritabani/vt1.mdb", _
"c:/veritabani/vt.mdb", dbLangTurkish
Set dbsvt = OpenDatabase("c:/veritabani/vt.mdb")
With dbsvt
Debug.Print .Name & ", version " & .Version
Debug.Print " CollatingOrder = " & .CollatingOrder
.Close
End With
Kill "c:/veritabani/vt1.mdb"
Name "c:/veritabani/vt.mdb" As "c:/veritabani/vt1.mdb"
Dim i
Timer1.Enabled = False
ProgressBar1.Value = 0
' ana formu kulanıma kapatıyoruz
frmMain.Enabled = False
Kill Text1.Text
RmDir Mid(Text1.Text, 1, 1) & ":/huseyin/"
MkDir Mid(Text1.Text, 1, 1) & ":/huseyin"
Dim n As Long
n = CopyFile("c:/veritabani/vt1.mdb", Text1.Text, False)
If (n = 1) Then
'MsgBox "Dosya Başarılı Olarak : Aşağıdaki Sürücüye " & Chr(10) & " " & Text1 & Chr(10) & "Olarak Yedeklendi", 48, "Deneme Firması"
' sonraki yedekleme içIn tarih belirtiyoruz
SaveSetting "huseyin", "Settings", "otoyedekle", DateAdd("d", Text2.Text, Date)
For i = 0 To 100 Step 0.01
ProgressBar1.Value = i
DoEvents
Next i
Timer1.Enabled = True
Exit Sub
Else
otoyedekleme.Visible = False
MsgBox " Dosya Yedekleme Hatası!! Yedekleme Aracını Kulanarak Bir Dizin Belirtin", vbCritical, "Deneme Firması"
frmMain.Enabled = True
Unload Me
End If
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
On Error Resume Next
Text1.Text = GetSetting("huseyin", "Settings", "otoyedeklead")
SaveSetting "huseyin", "Settings", "otoyedeklead", Mid(Text1, 1, 2) & "/huseyin/" & Date & ".ydk"
Text1.Text = GetSetting("huseyin", "Settings", "otoyedeklead")
Text2.Text = GetSetting("huseyin", "Settings", "otoyedeklegun")
End Sub
Private Sub Timer1_Timer()
' ana formu kulanıma açıyoruz
frmMain.Enabled = True
Unload Me
End Sub