Private Sub Form7_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Try
If MsgBox("هل تريد بالتأكيد انهاء البرنامج ؟" & vbCrLf & "سوف يتم عمل نسخة احتياطية من قاعدة البيانات" & vbCrLf & "DataCopy عند الاغلاق ووضعها في مسار البرنامج في المجلد", vbMsgBoxRight + vbExclamation + vbYesNo, "تأكيد انهاء البرنامج") = vbNo Then e.cancel() : Exit Sub
Application.DoEvents()
'اذا وجد نسخة بهذا الاسم يمسحها
If IO.File.Exists(Application.StartupPath & "\Compact.mdb") Then
IO.File.Delete(Application.StartupPath & "\Compact.mdb")
End If
' كود ضغط واصلاح قاعدة البيانات
Dim Engine
Engine = CreateObject("JRO.JetEngine")
Engine.CompactDatabase("provider=microsoft.jet.oledb.4.0;data source=" & Application.StartupPath & "\data.mdb;user id=admin;jet oledb:database password=12345", _
"provider=microsoft.jet.oledb.4.0;data source=" & Application.StartupPath & "\Compact.mdb;user id=admin;jet oledb:database password=12345")
'كود حذف قاعدة البيانات القديمة
Kill(Application.StartupPath & "\data.mdb")
'كود اعادة تسمية قاعدة البيانات التي تم ضغطها واصلاحها
My.Computer.FileSystem.RenameFile(Application.StartupPath & "\Compact.mdb", "data.mdb")
'كود التحقق من وجود المجلد DataCopy
If IO.Directory.Exists(Application.StartupPath & "\DataCopy") = False Then
'ان لم يكن موجد يقوم بانشاء مجلد جديد
IO.Directory.CreateDirectory(Application.StartupPath & "\DataCopy")
''انشاء مجلد جديد في وضع مخفي
' IO.Directory.CreateDirectory(Application.StartupPath & "\DataCopy").Attributes = FileAttributes.Hidden
End If
'كود نسخة قاعدة البيانات باسخدام البروجريس بار والتاريخ
Dim GregorianDTF As System.Globalization.DateTimeFormatInfo = New System.Globalization.CultureInfo("Ar-Sy", True).DateTimeFormat
GregorianDTF.Calendar = New System.Globalization.GregorianCalendar
Dim DToday As String = DateTime.Today.ToString("dd-MM-yyyy", GregorianDTF)
Dim CopyFrom, CopyTo As String
CopyFrom = Application.StartupPath & "\data.mdb"
CopyTo = Application.StartupPath & "\DataCopy\" & DToday & ".mdb"
ProgressBar1.Visible = True
Dim sr As New IO.FileStream(CopyFrom, IO.FileMode.Open)
Dim sw As New IO.FileStream(CopyTo, IO.FileMode.Create)
Dim len As Long = sr.Length - 1
For i As Long = 0 To len
sw.WriteByte(sr.ReadByte)
If i Mod 1000 = 0 Then
Application.DoEvents()
ProgressBar1.Value = i * 100 / len
' Button15.Text = ProgressBar1.Value & "% Completed "
End If
Next
'كود البحث عن قواعد البيانات لغاية قبل شهر من تاريخ اليوم ويقوم بحذفها مع ترك اخر قاعدتين بتاريخ قبل يوم
Dim DAddDays As DateTime = GregorianDTF.Calendar.AddDays(DateTime.Today, -1)
Dim DAddMonths As DateTime = GregorianDTF.Calendar.AddMonths(DateTime.Today, -3)
Dim D_AddDays As String = DAddDays.ToString("dd-MM-yyyy", GregorianDTF)
Dim D_AddMonths As String = DAddMonths.ToString("dd-MM-yyyy", GregorianDTF)
Do Until D_AddMonths = D_AddDays
If IO.File.Exists(Application.StartupPath & "\DataCopy\" & D_AddMonths & ".mdb") = True Then
Kill(Application.StartupPath & "\DataCopy\" & D_AddMonths & ".mdb")
End If
DAddMonths = GregorianDTF.Calendar.AddDays(DAddMonths, 1)
D_AddMonths = DAddMonths.ToString("dd-MM-yyyy", GregorianDTF)
Loop
End
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End
End Try
End Sub