تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[مشروع] ادارة بسيطة لملف الاكسس
#1


السلام عليكم ورحمةالله وبركاته
آمل ان يفيد هذا المثال احد كفكرة او تطبيق وهذا نسخة محدثة لفكرة اقل منها عملتها سابقا
المشروع افضل بكثير اضافة ملف قاعدة اكسس جديدة و عدة جداول واعمدة في الاطار الاول الرئيسي
اما الاطار الاخر فهو للتعديلات كما يظهر الصورتين اعلى هذا الكلام
password:-sarab

هذا الموديول به كافة العمليات لمن يحب الاكتفاء بها
PHP كود :
Imports System.Data.Common
Imports System
.Data.OleDb
Imports System
.Runtime.InteropServices
Imports System
.Xml
Module Module1
    Public config 
As String IO.Path.GetDirectoryName(Application.ExecutablePath) & "\config.txt"
 
   Public Sub rep(ByRef frm As Form)
 
       If frm.Left Or frm.Right Screen.PrimaryScreen.Bounds.Right Then frm.Left 0
        If frm
.Top Or frm.Bottom Screen.PrimaryScreen.Bounds.Bottom Then frm.Top 0
    End Sub
    Public 
Function constr(st As StringOptional ByVal password As String "vb4arb") As String
        Return 
"provider=microsoft.ace.oledb.12.0;data source=" st ";jet oledb:database password=" password ""
 
   End Function
 
   Public Function createdb(dbpath As String) As Boolean
        Try
            Dim objConnection 
CreateObject("ADOX.Catalog")
 
           Dim str As String constr(dbpath)
 
           objConnection.Create(str)
 
           Return True
        Catch ex 
As Exception
            Return False
        End 
Try
 
   End Function
 
   Public Function GetTables(dbpath As String) As DataSet
        Dim str 
As String constr(dbpath)
 
       Dim ds As New DataSet
        Dim dt 
As DataTable
        Using conn 
As New OleDbConnection(str)
 
           If conn.State ConnectionState.Closed Then conn.Open()
 
           dt conn.GetSchema("TABLES", {NothingNothingNothing"TABLE"})
 
           For Each dr As DataRow In dt.Rows
                ds
.Tables.Add(dr("TABLE_NAME"))
 
           Next
            If conn
.State ConnectionState.Open Then conn.Close()
 
       End Using
        Return ds
    End 
Function
 
   Public Sub createcolls(dbpath As Stringtbname As Stringcolname As Stringcoltype As String)
 
       Using con As New OleDb.OleDbConnection(constr(dbpath))
 
           Using cm As New OleDb.OleDbCommand(""con)
 
               Dim cn As String ""
 
               Dim ct As String
                cn 
colname
                ct 
coltype
                cm
.CommandText "ALTER TABLE " tbname " ADD " cn " " ct
                If con
.State ConnectionState.Closed Then con.Open()
 
               Try
                    cm
.ExecuteNonQuery()
 
                   MsgBox("تم اضافة عمود: " colname " الى جدول: " tbname " بنجاح "MsgBoxStyle.Information"save colls")
 
               Catch ex As Exception
                    MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
               Finally
                    If con
.State ConnectionState.Open Then con.Close()
 
               End Try
 
               If con.State ConnectionState.Open Then con.Close()
 
           End Using
        End Using
    End Sub
    Public 
Function isdbfount(adbpath As String) As Boolean
        Return IO
.File.ReadAllLines(config).Contains(adbpath)
 
   End Function
 
   Public Function isdbfountreal(dbpath As String) As Boolean
        Return IO
.File.Exists(dbpath)
 
   End Function
 
   Public Function alldbs() As String()
 
       Return IO.File.ReadAllLines(config)
 
   End Function
 
   Function isendwithnewline() As String
        Dim rcount 
As Integer IO.File.ReadAllLines(config).Count
        Dim t 
As String IO.File.ReadLines(config)(rcount)
 
       Return t
    End 
Function
 
   Public Sub create_Table(dbpath As Stringtbname As String)
 
       Using con As New OleDb.OleDbConnection(constr(dbpath))
 
           Using cm As New OleDb.OleDbCommand(""con)
 
               cm.CommandText "create table " tbname
                If con
.State ConnectionState.Closed Then con.Open()
 
               Try
                    cm
.ExecuteNonQuery()
 
                   MsgBox("تم حفظ الجدول"MsgBoxStyle.Information"حفظ جدول")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Catch ex As Exception
                    MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Finally
                    If con
.State ConnectionState.Open Then con.Close()
 
               End Try
 
           End Using
        End Using
    End Sub
    Public Sub renametable
(dbpath As Stringoldtb As Stringnewtb As String)
 
       Try
            Dim con 
As New ADODB.Connection
            con
.ConnectionString constr(dbpath)
 
           con.Open()
 
           Dim ax As New ADOX.Catalog
            ax
.ActiveConnection con
            ax
.Tables(oldtb).Name newtb
            con
.Close()
 
           MsgBox("تم تعديل الاسم بنجاح " oldtb " الى " newtb)
 
       Catch ex As Exception
            MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
       End Try
 
   End Sub
    Public Sub dropColumn
(dbpath As Stringtbname As StringColName As String)
 
       Using con As New OleDb.OleDbConnection(constr(dbpath))
 
           Using cm As New OleDb.OleDbCommand(""con)
 
               cm.CommandText "alter table " tbname " drop Column " ColName
                Try
                    If con
.State ConnectionState.Closed Then con.Open()
 
                   cm.ExecuteNonQuery()
 
                   MsgBox("تم حذف العمود بنجاح"MsgBoxStyle.Information"حذف")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Catch ex As Exception
                    MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Finally
                    If con
.State ConnectionState.Open Then con.Close()
 
               End Try
 
           End Using
        End Using
    End Sub
    Public Sub droptable
(dbpath As Stringtbname As String)
 
       Using con As New OleDb.OleDbConnection(constr(dbpath))
 
           Using cm As New OleDb.OleDbCommand(""con)
 
               cm.CommandText "drop table " tbname ""
 
               Try
                    If con
.State ConnectionState.Closed Then con.Open()
 
                   cm.ExecuteNonQuery()
 
                   MsgBox("تم حذف الجدول بنجاح"MsgBoxStyle.Information"حذف")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Catch ex As Exception
                    MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Finally
                    If con
.State ConnectionState.Open Then con.Close()
 
               End Try
 
           End Using
        End Using
    End Sub
    Public Sub change_column_name
(dbpath As Stringtbname As StringColName As Stringnewcolname As String)
 
       Try
            Dim con 
As New ADODB.Connection
            con
.ConnectionString constr(dbpath)
 
           con.Open()
 
           Dim ax As New ADOX.Catalog
            ax
.ActiveConnection con
            ax
.Tables(tbname).Columns(ColName).Name newcolname
            con
.Close()
 
           MsgBox("تم تعديل الاسم بنجاح " ColName " الى " newcolname)
 
       Catch ex As Exception
            MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
       End Try
 
   End Sub
    Public Sub retypecolumn
(dbpath As Stringtbname As StringColName As Stringcoltype As String)
 
       Using con As New OleDb.OleDbConnection(constr(dbpath))
 
           Using cm As New OleDb.OleDbCommand(""con)
 
               Dim cn As String ""
 
               Dim ct As String
                cn 
ColName
                ct 
coltype
                cm
.CommandText "ALTER TABLE " tbname " ALTER COLUMN " cn " " coltype ""
 
               If con.State ConnectionState.Closed Then con.Open()
 
               Try
                    cm
.ExecuteNonQuery()
 
                   MsgBox("تم تغيير نوع عمود: " ColName " الى نوع: " coltype " بنجاح "MsgBoxStyle.Information"save colls")
 
               Catch ex As Exception
                    MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
               Finally
                    If con
.State ConnectionState.Open Then con.Close()
 
               End Try
 
               If con.State ConnectionState.Open Then con.Close()
 
           End Using
        End Using
    End Sub
    Public 
Function getColls(dbpath As Stringtbname As String) As DataTable
        Using con 
As New OleDb.OleDbConnection(constr(dbpath))
 
           Dim dt As New DataTable
            Using cm 
As New OleDb.OleDbCommand("select * from " tbname ""con)
 
               If con.State ConnectionState.Closed Then con.Open()
 
               Try
                    dt
.Load(cm.ExecuteReader)
 
               Catch ex As Exception
                    MsgBox
(Err.DescriptionMsgBoxStyle.Critical"error")
 
                   If con.State ConnectionState.Open Then con.Close()
 
               Finally
                    If con
.State ConnectionState.Open Then con.Close()
 
               End Try
 
               If con.State ConnectionState.Open Then con.Close()
 
           End Using
            Return dt
        End Using
    End 
Function
End Module 
اول مرة استفيد من هذه الفكرة اذ انه الان ليس لدي اي اوفيس مثبت فيه الاكسس المتوفر عندي يخلو من الاكسس فقلت لن اتخلى عن الاصدار الحديث اللذي امتلكه(اشتريته ظنا مني انه يحتوي الاكسس و ان الفرق فقط الدفع باشتراك او الدفع مرة واحدة) لانه باصدار 64 بت والقديم لدي 2007 32 بت والنظام 64 بت وفيجوال استوديو 64 بت فليس امامي الا هذه الفكرة فاحببت ان تفيد احد كفكرة او تطبيق.
اسال الله ان يغفر لي ولكم 
و كل عام وانتم بخير
هذه عيدية لكل الاعضاء

تنبيه!
عن طريق الخطأ اضفت كلمة المرور لاجراء اسناد مسار ملف القاعدة constr فقم بازالتها واجعلها فارغة ان شئت لانها ستحول ملف الاكسس المفتوح الى مغلق بكلمة مرور vb4arb
تنبيه!


الملفات المرفقة
.zip   CustomAccdbManager.zip (الحجم : 28.71 ك ب / التحميلات : 101)
الرد }}}
تم الشكر بواسطة: Taha Okla , tryold , ابو روضة
#2
ضمن حدث MyApplication_Startup في ملف ApplicationEvents.vb يوجد هذا الكود:
PHP كود :
If IO.File.Exists(config) = False Then
IO
.File.CreateText(config).Close()
End If 
هذا لمن اقتصر على الموديول لانه[الضمير يعود على الكود المسؤول عن  انشاء الملف config.txt] ينشيء الملف بالكود الخاص بحفظ مايتم انشاؤه من ملفات.
كل عام و انتم بخير
الرد }}}
تم الشكر بواسطة: مصمم هاوي , ابو روضة
#3

سبحان الله!
لم انتبه لهذا القصور المعيبSad
ماهي الفائدة اذا لم يتمكن مستخدم البرنامج من ادارة اي ملف اكسس غير ما تم انشاؤه به؟!
تم التعديل
كل عام و انتم بخير.

معذرة باقي كم تعديل ضروري!
الرد }}}
تم الشكر بواسطة: ابو روضة , ابو روضة
#4
الان المشروع يحتوي واجهة الضغط والتحكم بكلمة المرور من حيث اضافتها او ازالتها


الملفات المرفقة
.zip   CustomAccdbManager.zip (الحجم : 100.18 ك ب / التحميلات : 74)
الرد }}}
تم الشكر بواسطة: ابو روضة


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [مشروع] تحديت الاكسس ونجحت بعد الغلبة سعود 0 1,608 10-11-20, 03:36 AM
آخر رد: سعود

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم