[مثال] طريقة إنشاء قاعدة sql بواسطة script برمجيا وكتابة أسمها بواسطة العميل

http://vb4arb.com/vb/showthread.php?tid=25879

ثانيا
قم بإنشاء مشروع جديد في الفيجوال بيسك
وقم بإضافة الأدوات التالية

1- ComboBox وقم يتسميتها Comb_Server_Name
2- ComboBox وقم يتسميتها Comb_Win_Auth
3- ComboBox وقم يتسميتها Comb_Av_Db

4- TextBox وقم بتسميته Txt_Login
5- TextBox وقم بتسميته Txt_Password
6- TextBox وقم بتسميته Txt_NewDataBase

7- Button وقم بتسميته Btn_Test_Con
8- Button وقم بتسميته Btn_Create_DB

وعدد 6 label توضع أمامهم كما في الصورة التالية

ثالثا نأتى لمرحلة الأكواد

الكود الأول
سننشأ موديل ونسميه " Mod_Info "
وسيكون خاص بتعريف أسماء مجلد الأتصال ويحتوي على
ملف أتصال القاعدة وملف أتصال السيرفر
وملف أسكربت القاعدة
وهو كالتالي

كود :

Module Mod_Info

    Public SqlConnStr As String

    Public IsOk_ As Boolean

    Public Txt_Conn_Folder As String = "CONN" ' أكتب أسم الملجد الذي سيكون بجوار ملف تشغيل البرنامج وسيحتوى على ملفات الأتصال وملف أسكربت القاعدة

    Public Txt_CONN As String = "CONN.txt" 'سيحتوى على نص أتصال قاعدة البيانات وستستخدمه عن طريق قراءة الملف

    Public Txt_CONN_SERVER As String = "CONN_SERVER.txt" 'سيحتوى على نص أتصال السيرفر

    Public SqlDB_SCR_DB_Name__ As String = "datascript.sql" ' أكتب أسم أسكربت قاعدة البيانات وضع الأسكربت بجوار ملف التشغيل للبرنامج

    ' سيقوم البرنامج بإنشاء المجلد والملفين السابقين في حالة عدم وجودهم  وسينسخ ملف الأسكربت لداخل المجلد

    ' أما في حالة وجودهم فسيتجاهل أوامر الأنشاء وسيقوم بالأجراءات التي تليه

End Module

الكود الثاني
سننشأ كلاس ونسميه " CLS_Files "
وسيكون خاص بالتأكد من وجود مجلد الملفات الخاصة بالأتصال وملف أسكربت القاعدة
وهو كالتالي

كود :

Public Class CLS_Files

    Public Sub check_Folder__(ByVal Folder_Name__ As String)

        Dim folderExists As Boolean

        folderExists = My.Computer.FileSystem.DirectoryExists(Application.StartupPath & "\" & Folder_Name__ & "")

        If folderExists = False Then

            My.Computer.FileSystem.CreateDirectory(Application.StartupPath & "\" & Folder_Name__ & "")

        Else

        End If

    End Sub

    Public Sub check_file__(ByVal File_Name__ As String)

        Dim fileExists As Boolean

        fileExists = My.Computer.FileSystem.FileExists(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & File_Name__ & "")

        If fileExists = False Then

            My.Computer.FileSystem.WriteAllText(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & File_Name__ & "", String.Empty, False)

        Else

        End If

    End Sub

    Public Sub DBinCONN(ByVal SqlDB_Script_Name__ As String)

        Dim fileExists1 As Boolean

        fileExists1 = My.Computer.FileSystem.FileExists(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & SqlDB_Script_Name__ & "")

        Try

            If fileExists1 = False Then

                My.Computer.FileSystem.CopyFile(Application.StartupPath & "\" & SqlDB_Script_Name__ & "", Application.StartupPath & "\" & Txt_Conn_Folder & "\" & SqlDB_Script_Name__ & "")

            Else

            End If

        Catch ex As Exception

                       Dim msg As String = ""

            msg &= "تأكد من وجود ملف القاعدة في مجلد البرنامج" & vbNewLine

            msg &= "أو قم بنسخة يدويا إلى مجلد Conn" & vbNewLine

            msg &= "من فضلك أعد المحاولة مرة أخرى ..." & vbNewLine

            msg &= "" & vbNewLine

            msg &= (ex.Message)

            MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

            Exit Sub

        End Try

    End Sub

End Class

الكود الثالث
سننشأ كلاس ونسميه " CLS_CONN_SERVER "
وسيكون مسئول عن جلب أسماء السيرفرات المثبته على الجهاز
وإنشاء قاعدة البيانات الخاصة بنا
وهو كالتالي

كود :

Imports Microsoft.Win32

Imports System.Data.SqlClient

Imports Microsoft.VisualBasic

Imports System

Imports System.Data

Public Class CLS_CONN_SERVER

#Region "Load Data"

    'تحميل السيرفرات الموجودة على الجهاز

    Public Sub LoadServer(ByVal Combo As ComboBox)

        Try

            Dim LocalMachine = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry64)

            Dim Rk = LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Microsoft SQL Server")

            Dim Instance = CType(Rk.GetValue("InstalledInstances"), String())

            If Instance.Length > 0 Then

                For Each Element As String In Instance

                    If Element = "MSSQLSERVER" Then

                        Combo.Items.Add(System.Environment.MachineName)

                    Else

                        Combo.Items.Add(System.Environment.MachineName + "\" + Element)

                    End If

                Next Element

            End If

        Catch ex As Exception

            Dim msg As String = ""

            msg &= "تأكد من وجود برنامج" & vbNewLine

            msg &= "Microsoft sql sever" & vbNewLine

            msg &= "مثبت على جهازك وأن السيرفر يعمل بالفعل" & vbNewLine

            msg &= "ثم من فضلك أعد المحاولة مرة أخرى ..." & vbNewLine

            msg &= "" & vbNewLine

            msg &= (ex.Message)

            MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

        End Try

    End Sub

#End Region

    Public Sub ADD_Database(ByVal Database_ As String)

        If (CLS_R.Con_SERVER.State = ConnectionState.Open) Then

            CLS_R.Con_SERVER.Close()

        End If

        CLS_R.Con_SERVER.Open()

        Dim cmdd As New SqlCommand(("Create Database " & Strings.Trim(Database_) & ""), CLS_R.Con_SERVER)

        cmdd.ExecuteNonQuery()

        CLS_R.Con_SERVER.Close()

    End Sub

End Class

الكود الرابع
سننشأ كلاس ونسميه " CLS_R "
وسيكون مسئول عن قراءة ملفين الأتصال
وهو كالتالي

كود :

Imports Microsoft.VisualBasic.CompilerServices

Imports System

Imports System.Data.SqlClient

Imports System.IO

Friend NotInheritable Class CLS_R

    Public Shared TXT_CON___ As String = (File.ReadAllText(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & Txt_CONN_SERVER & ""))

    Public Shared Con_SERVER As SqlConnection = New SqlConnection(CLS_R.TXT_CON___)

End Class

الكود الخامس
في الفورم الرئيسي للمثال
سنضع الكود التالي

كود :

Imports System.IO

Imports System.Data.SqlClient

Imports System.Text.RegularExpressions

Public Class FrmMainCRDB

    Private CLS_CONN_SERVER_ As CLS_CONN_SERVER

    Private STR____ As String

    Private CLS_Files__ As CLS_Files

    Public Sub New()

        IsOk_ = False

        CLS_CONN_SERVER_ = New CLS_CONN_SERVER

        CLS_Files__ = New CLS_Files

        Me.InitializeComponent()

    End Sub

    Private Sub FrmMainCRDB_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

        Check_FF__()

        CLS_CONN_SERVER_.LoadServer(Comb_Server_Name)

        With Comb_Win_Auth

            .Items.Add("Windows Authentication")

            .Items.Add("SQL Server Authentication")

        End With

    End Sub

    Private Sub Fill_Combo_Database()

        On Error Resume Next

        Comb_Av_Db.Items.Clear()

        Dim DS As New DataSet

        Dim SqlConnection1 As SqlClient.SqlConnection = New SqlClient.SqlConnection("Data Source=" & Comb_Server_Name.Text & ";Initial Catalog=tempdb;Integrated Security=SSPI;")

        Dim str As String = "Select DISTINCT name from master.dbo.sysdatabases where name not IN('master','msdb','tempdb' ,'model') and has_dbaccess(Name) = 1 order by name "

        Dim ADP As SqlClient.SqlDataAdapter

        ADP = New SqlClient.SqlDataAdapter(str, SqlConnection1)

        DS.Clear()

        ADP.Fill(DS)

        Comb_Av_Db.Items.Clear()

        Dim i As Integer

        For i = 0 To DS.Tables(0).Rows.Count - 1

            Comb_Av_Db.Items.Add(DS.Tables(0).Rows(i).Item(0))

        Next

        ADP.Dispose()

        SqlConnection1.Dispose()

    End Sub

    Private Sub Check_FF__()

        Try

            'دالة إنشاء المجلد

            CLS_Files__.check_Folder__(Txt_Conn_Folder)

            'دالة إنشاء الملفات

            CLS_Files__.check_file__(Txt_CONN)

            CLS_Files__.check_file__(Txt_CONN_SERVER)

            CLS_Files__.DBinCONN(SqlDB_SCR_DB_Name__)

            ' MsgBox("Done")

        Catch ex As Exception

            Dim msg As String = ""

            msg &= "فشل الأتصال بالسيرفر" & vbNewLine

            msg &= "من فضلك أعد المحاولة مرة أخرى" & vbNewLine

            msg &= "" & vbNewLine

            msg &= (ex.Message)

            MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

        End Try

    End Sub

    Private Sub checker__()

        IsOk_ = True

        If Comb_Server_Name.Text = "" Then

            Dim msg As String = ""

            msg &= "يجب إختيار اسم السيرفر" & vbNewLine

            msg &= "من فضلك أعد المحاولة مرة أخرى" & vbNewLine

            MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

            Comb_Server_Name.Focus()

            IsOk_ = False

            Exit Sub

        End If

        If Comb_Win_Auth.SelectedIndex = -1 Then

            Dim msg As String = ""

            msg &= "يجب إختيار طريقة الولوج للسيرفر" & vbNewLine

            msg &= "من فضلك أعد المحاولة مرة أخرى" & vbNewLine

            MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

            Comb_Win_Auth.Focus()

            IsOk_ = False

            Exit Sub

        End If

        If Comb_Win_Auth.SelectedIndex = 1 Then

            If Txt_Login.Text.Length = 0 Then

                Dim msg As String = ""

                msg &= "يجب كتابة اسم المستخدم" & vbNewLine

                msg &= "من فضلك أعد المحاولة مرة أخرى" & vbNewLine

                MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                Txt_Login.Focus()

                IsOk_ = False

                Exit Sub

            End If

            If Txt_Password.Text.Length = 0 Then

                Dim msg As String = ""

                msg &= "يجب كتابة  كلمة المرور" & vbNewLine

                msg &= "من فضلك أعد المحاولة مرة أخرى" & vbNewLine

                MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                Txt_Password.Focus()

                IsOk_ = False

                Exit Sub

            End If

        End If

        IsOk_ = True

    End Sub

    Private Sub Btn_Test_Con_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_Test_Con.Click

        checker__()

        If IsOk_ = True Then

            Dim SqlConn As New SqlConnection

            If Comb_Win_Auth.SelectedIndex = 0 Then

                SqlConnStr = "Data Source=" & Comb_Server_Name.Text.Trim & ";Initial Catalog=master;Integrated Security=True"

            End If

            If Comb_Win_Auth.SelectedIndex = 1 Then

                SqlConnStr = "Data Source=" & Comb_Server_Name.Text.Trim & ";Initial Catalog=master;User ID=" & Txt_Login.Text.Trim & ";Password=" & Txt_Password.Text & ""

            End If

            If SqlConn.State = ConnectionState.Closed Then

                SqlConn.ConnectionString = SqlConnStr

                Try

                    SqlConn.Open()

                    Dim msg As String = ""

                    msg &= "تم الأتصال بالسيرفر بنجاح" & vbNewLine

                    MsgBox(msg, CType(vbOKOnly + vbInformation + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                Catch ex As Exception

                    Dim msg As String = ""

                    msg &= "فشل الأتصال بالسيرفر" & vbNewLine

                    msg &= "من فضلك أعد المحاولة مرة أخرى" & vbNewLine

                    msg &= "" & vbNewLine

                    msg &= (ex.Message)

                    MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                End Try

            End If

        Else

            Exit Sub

        End If

    End Sub

    Public Sub CONN_SERVER()

        Dim str As String

        If Comb_Win_Auth.SelectedIndex = 1 Then

            str = String.Concat(New String() {"Data Source=", Strings.Trim(Me.Comb_Server_Name.Text), ";User ID=", Strings.Trim(Me.Txt_Login.Text), ";password=", Strings.Trim(Me.Txt_Password.Text), ";Integrated Security=false"})

        Else

            str = (" Data Source=" & Strings.Trim(Me.Comb_Server_Name.Text) & ";Integrated Security=True")

        End If

        File.WriteAllText(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & Txt_CONN_SERVER & "", str)

    End Sub

    Public Sub CREATE_TB_NEWDATAG()

        Dim str As String

        Me.CLS_CONN_SERVER_.ADD_DATABASE(Me.Txt_NewDataBase.Text)

        If Comb_Win_Auth.SelectedIndex = 0 Then

            str = String.Concat(New String() {" Data Source=", Me.Comb_Server_Name.Text, ";Initial Catalog=", Me.Txt_NewDataBase.Text, ";Integrated Security=True"})

        Else

            str = String.Concat(New String() {"Data Source=", Me.Comb_Server_Name.Text, ";Initial Catalog=", Me.Txt_NewDataBase.Text, ";User ID=", Me.Txt_Login.Text, ";password=", Me.Txt_Password.Text, ";Integrated Security=false"})

        End If

        Me.STR____ = str

        File.WriteAllText(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & Txt_CONN & "", str)

        Dim connection As New SqlConnection(File.ReadAllText(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & Txt_CONN & ""))

        If (connection.State = ConnectionState.Open) Then

            connection.Close()

        End If

        connection.Open()

        Dim enumerable As IEnumerable(Of String) = Regex.Split(File.ReadAllText(Application.StartupPath & "\" & Txt_Conn_Folder & "\" & SqlDB_SCR_DB_Name__ & ""), "^\s*GO\s*$", (RegexOptions.Multiline Or RegexOptions.IgnoreCase))

        Dim str3 As String

        For Each str3 In enumerable

            If (str3.Trim <> "") Then

                Dim cmdd As New SqlCommand(str3, connection)

                cmdd.ExecuteNonQuery()

            End If

        Next

        connection.Close()

    End Sub

    Private Sub Comb_Win_Auth_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Comb_Win_Auth.SelectedIndexChanged

        If Comb_Win_Auth.SelectedIndex = 0 Then

            Txt_Login.ReadOnly = True

            Txt_Password.ReadOnly = True

        Else

            Txt_Login.ReadOnly = False

            Txt_Password.ReadOnly = False

        End If

    End Sub

    Private Sub Comb_Server_Name_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Comb_Server_Name.SelectedIndexChanged

        Fill_Combo_Database()

    End Sub

    Private Sub Btn_Create_DB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Btn_Create_DB.Click

        checker__()

        If IsOk_ = False Then

            Exit Sub

        Else

            Try

                If (Me.Txt_NewDataBase.Text = Nothing) Then

                    Dim msg As String = ""

                    msg &= "يجب إدخال أسم قاعدة البيانات الجديدة" & vbNewLine

                    msg &= "" & vbNewLine

                    MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                    Exit Sub

                ElseIf Comb_Av_Db.Items.Contains(Txt_NewDataBase.Text) = True Then

                    Dim msg As String = ""

                    msg &= "أسم القاعدة الذي أدختله موجود مسبقأ" & vbNewLine

                    msg &= "رجاء إدخال أسم مختلف ." & vbNewLine

                    MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                    Exit Sub

                Else

                    Me.CONN_SERVER()

                    Me.CREATE_TB_NEWDATAG()

                    Dim msg As String = ""

                    msg &= "تمت عملية إنشاء القاعدة بنجاح" & vbNewLine

                    msg &= "سيتم إعادة تشغيل البرنامج " & vbNewLine

                    msg &= "من فضلك إنتظر لحظات ..." & vbNewLine

                    MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

                    Application.Restart()

                    ' Me.Close()

                End If

            Catch ex As Exception

                Dim msg As String = ""

                msg &= "تأكد من بيانات الأتصال بالسيرفر" & vbNewLine

                msg &= "تأكد من وجود ملف القاعدة في مجلد Conn" & vbNewLine

                msg &= "من فضلك أعد المحاولة مرة أخرى ..." & vbNewLine

                msg &= "" & vbNewLine

                msg &= (ex.Message)

                MsgBox(msg, CType(vbOKOnly + vbCritical + vbDefaultButton1 + vbMsgBoxRight + vbMsgBoxRtlReading + vbApplicationModal, MsgBoxStyle), "رسالة تنبيه")

            End Try

        End If

    End Sub

End Class

وأخيرا مرحلة التطبيق runTime

عند فتح البرنامج لأول مرة يجب وجود ملف أسكربت القاعدة بجوار ملف التشغيل للبرنامج

سيقوم البرنامج بإنشاء المجلد والملفين اللذين سيتم حفظ نصوص الأتصال بداخلهم
وسينسخ ملف الأسكربت لداخل المجلد

أما في حالة وجودهم فسيتجاهل أوامر الأنشاء وسيقوم بالأجراءات التي تليه
وهو جلب أسماء السيرفرات
وجلب قواعد البيانات المخزنة في السيرفر
وسنستغل هذة الخاصية
في مقارنة الأسم الذى سيكتبه المستخدم بالقواعد الموجودة فإذا وجد تشابه فسيتوقف البرنامج
وإن لم يجد فسيتم إنشاء القاعدة

وبكده أنتهينا من المثال
وأسف على الأطالة
وأتمنى أن ينال إعجابكم أول مثال لي في المنتدى

ولا تنسوني من صالح دعائكم

**************************
مثال جيد أخر على نفس الفكرة ولكن بإستخدام ملفات القاعدة نفسها
وهو من كتابة الأخ الفاضل " mero5000 "
الرابط
http://vb4arb.com/vb/showthread.php?tid=26315
**************************

تنويه هام
* أستخدمت في هذا المثال
بعض من أكواد من سورسات لأمثلة متفرقة

* المثال قابل للتطوير
* أي ملاحظات أو أي توجيه أتقبله بصدر رحب

أقدم جزيل الشكر
للأخ الفاضل يوسف حداد صاحب الفكرة التى رأيتها
وأقتبست منها المثال

وللأخ الكريم والأستاذ الفاضل " eljokr "
وللأخ الكريم والأستاذ الفاضل " mero5000 "
وللأخ الكريم والأستاذ الفاضل " عبد العزيز البسكري "
لما يقدموه من مساعدة ومعلومات تفيدني وتفيد الجميع
ولكل الأخوة الكرام في المنتدى من إدارة وأعضاء
جزيل الشكر والأحترام

أنتهيت بفضل الله
إن كان صواباً فمن الله وحده وإن كان فيه من خطأ فمني ومن الشيطان
والسلام عليكم ورحمة الله وبركاته