Oto Yedekleme


Visual Basic ve .NET Framework    Visual Basic ve .NET Framework İle İlgili Paylaşım Kategorisi

Yazar: ByClxon    0 Yorum    72 Görüntüleme
  • 0 Oy - 0 Yüzde

Paylaşım Tarihi: 12.05.2016, 12:29:17 #1
ByClxon SEA !
Efsane Üye
Status: Çevrimdışı Yorum Sayısı:1,020 Konu Sayısı:444 Üyelik Tarihi:07.01.2016 Rep Puanı: 664

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

OptionExplicit
'değişkenleri tanımlıyoruz
Dim otoyedeklead1, yedekle, otoyedekle



PrivateSub MDIForm_Resize()

otoyedeklead1 = GetSetting("huseyin""Settings""otoyedeklead")
If otoyedeklead1 = ""Then
SaveSetting "huseyin""Settings""otoyedeklead""c:/veritabani/" & Date & ".ydk"
EndIf
yedekle = GetSetting("huseyin""Settings""yedekle")
If yedekle = ""Then
SaveSetting "huseyin""Settings""yedekle""c:/veritabani/vt1.ydk"
EndIf

otoyedekle = GetSetting("huseyin""Settings""otoyedekle")
If otoyedekle = ""Then
SaveSetting "huseyin""Settings""otoyedekle"Date
SaveSetting "huseyin""Settings""otoyedeklegun", 10


EndIf
' 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
EndIf

otoyedekle = GetSetting("huseyin""Settings""otoyedekle")
IfCDate(otoyedekle) <= DateThen
otoyedekleme.Show
Else
'MsgBox "Değil"
EndIf

EndSub

PrivateSub mnuayar_Click()
ayarlar.Show
EndSub


ş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

PrivateSub 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
ExitSub
Else
EndIf
SaveSetting "huseyin""Settings""otoyedekle", DateAdd("d", Text1Text, Date)
SaveSetting "huseyin""Settings""otoyedeklegun", Text1.Text
Unload Me
EndSub

PrivateSub Form_Load()
Text1.Text = GetSetting("huseyin""Settings""otoyedeklegun")

EndSub

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 


OptionExplicit
' Fonksiyon ve özellikleri tanımlıyoruz
PrivateDeclareFunction CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName AsStringByVallpNewFileName AsStringByVal bFailIfExists AsLongAsLong

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...
PrivateDeclareSub SetWindowPos Lib "User32" (ByVal hWnd AsLongByVal hWndInsertAfter AsLong, _
ByVal x AsLongByVal y AsLongByVal cx AsLongByVal cy AsLongByVal wFlags AsLong)

PrivateSub Form_Activate()
OnErrorResumeNext
' Eğer veritabanı dizini ve dosyası bulunmazsa formu kapatıyoruz

If Dir$("c:/veritabani/vt1.mdb") = ""Then
Unload Me
ExitSub
Else
EndIf
' 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
EndWith

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
EndWith
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 AsLong
n = CopyFile("c:/veritabani/vt1.mdb", Text1.TextFalse)
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.TextDate)

For i = 0 To 100 Step 0.01

ProgressBar1.Value = i
DoEvents
Next i

Timer1.Enabled = True

ExitSub
Else
otoyedekleme.Visible = False
MsgBox" Dosya Yedekleme Hatası!! Yedekleme Aracını Kulanarak Bir Dizin Belirtin", vbCritical,"Deneme Firması"
frmMain.Enabled = True
Unload Me
EndIf

Timer1.Enabled = True

EndSub

PrivateSub Form_Load()
OnErrorResumeNext
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")

EndSub

PrivateSub Timer1_Timer()
' ana formu kulanıma açıyoruz
frmMain.Enabled = True
Unload Me

EndSub

Kullanıcı İmzası
#fenerbahçeA.A.K.
İmage
İletişim İçin Facebook;

linkleri görmek için giriş yapmanız. Yada üye olmanız gerekir.


Öfkemiz sarsın her yanı, bozkurtlar yürüye yürüye
Dökülsün düşmanın kanı, yaşasın ırkçı TÜRKİYE!

Taşında gözü olanın yurduna MEZAR kazacağız
Hainin, soysuzun, döneğin alnına VATAN yaazcağız
Hainin, soysuzun alnına YAŞASIN TURAN yazacağız!



İmage






 

         










Aradığınızı Bulamadınız Mı ?

Konuyu görüntüleyenler:
1 Misafir