بسم الله الرحمن الرحيم
السلام عليكم ورحمة الله وبركاته.
منذ تسجيلي بهذا المنتدى الطيب وانا اقوم بجمع المعلومات وكان اكثر شيء يشدني مسالة الربط بقاعدة البيانات والاكثر شدا للانتباه هو مسالة الصلاحيات وجمعت معلومات لاباس بها فاحببت ان نبدا سوية خطوة بخطوة لتصميم برنامج يتعامل مع قاعدة بيانات اكسس 2007 باستخدام فيجوال بيسك 2008.
فمن لديه هذه البرامج فهو جاهز للبدء معنا خطوة بخطوة.
لنبدا على بركة الله افتح برنامج
Microsoft Visual Studio 2008
اختر مشروع جديد
WindowsApplication1
اضف عدد 6 نماذج= 6 forms
الاول وليكن اسمه = form1
اضف له الادوات اللازمة كما هو موضع بالصورة التالية:
مزيد من المعلومات
قم بالضغط على زر حفظ الكل ليتم انشاء مجلد للمشروع ..الان قم بفتح مايكروسوفت اكسس 2007
قم بانشاء جدول جديد واسمه wanted انظر الصورة التالية
اضف الحقول كما ترى بالصورة تماما
انشيء جدول اخر واسمه
Fmembers
وجدول اخر اسمه
Fblocked
انظر الصورة التالية
وانشيء جدول ايضا وهو المهم واسمه
Fadmin
استعرض الصور بشكل منفصل عن البرنامج لرؤيتها بشكل اوضح
الان بقي علينا الربط لاننا عرفنا اسم قاعدة البيانات وهو db1.accdb
هذا باستخدام اكسس 2007 اما 2003 فهو
Db1.mdb
الان فنقل بشكل متاخر فكرة برنامجنا وهي
صورة شبيهه بدفتر العناوين واسمينا هذا الجدول المخصص باسم wanted
أي المطلوبين .
نريد الان الربط بهذا الجدول
نضيف موديول جديد وسمه constr ونضيف به الجملة التالية
اعلى اطار الشيفرة اكتب
Imports System.Data.OleDb
ثم داخل الموديول بين جملتي
Module constr
و جملة
End Module
اكتب هذا الكود
Public conn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; data source= |datadirectory|\db1.accdb;Jet OLEDB:Database Password=vb4arab")
Public ds1 As New DataSet
Public sql1 As String = "select * from wanted"
Public da1 As New OleDbDataAdapter(sql1, conn)
الان انتهينا من اهم خطوة بقيت خطوة الربط بالادوات
نذهب لحدث Form1_Load
الخاص بنموذج او فورم اظهار محتوى القاعدة
ونكتب الكود التالي
Try
conn.Open()
da1.Fill(ds1, "wanted")
conn.Close()
Me.txtname.DataBindings.Add("text", ds1, "wanted.txtname")
Me.txtfather.DataBindings.Add("text", ds1, "wanted.txtfather")
Me.txtgrand.DataBindings.Add("text", ds1, "wanted.txtgrand")
Me.txtfamily.DataBindings.Add("text", ds1, "wanted.txtfamily")
Me.txtqabilah.DataBindings.Add("text", ds1, "wanted.txtqabilah")
Me.birthplace.DataBindings.Add("text", ds1, "wanted.birthplace")
Me.birthdate.DataBindings.Add("text", ds1, "wanted.birthdate")
Me.txtrecordno.DataBindings.Add("text", ds1, "wanted.txtrecordno")
Me.txtnoteno.DataBindings.Add("text", ds1, "wanted.txtnoteno")
Me.txtnotesource.DataBindings.Add("text", ds1, "wanted.txtnotesource")
Me.txtnotedate.DataBindings.Add("text", ds1, "wanted.txtnotedate")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
الان قم بتشغيل البرنامج لتجربته اذا كان عملك صحيحا فستظهر محتويات القاعدة ضمن الفورم الاول
اسماء مربعات النص مثل اسماء حقول القاعدة
لاحظها بنفسك
مثلا اردنا ربط مربع نص بحقل اسم نسمي مربع النص اسم txtname يجب ان يكون اسم الحقل بالقاعدة مثل هذا ليعمل الكود بشكل صحيح.
الان قم بالنقر على زر جديد لاضافة صف جديد ماذا يحدث
Button2.Enabled = True
Button3.Enabled = True
Call opentxt()
Button3.Select()
يقوم بتمكين زر الحفظ وزر محو النصوص بالمربعات
ثم يقوم باستدعاء دالة مخصصة opentxt
لنراها الان
Public Sub opentxt()
Form1.txtname.ReadOnly = False
Form1.txtfather.ReadOnly = False
Form1.txtgrand.ReadOnly = False
Form1.txtfamily.ReadOnly = False
Form1.txtqabilah.ReadOnly = False
Form1.birthplace.ReadOnly = False
Form1.birthdate.ReadOnly = False
Form1.txtrecordno.ReadOnly = False
Form1.txtnoteno.ReadOnly = False
Form1.txtnotesource.ReadOnly = False
Form1.txtnotedate.ReadOnly = False
End Sub
والباقي سهل
لننظر الى زر الحفظ
Button2.Enabled = False
Try
Dim dRow As DataRow = ds1.Tables("wanted").NewRow
dRow.Item(0) = txtname.Text
dRow.Item(1) = txtfather.Text
dRow.Item(2) = txtgrand.Text
dRow.Item(3) = txtfamily.Text
dRow.Item(4) = txtqabilah.Text
dRow.Item(5) = birthplace.Text
dRow.Item(6) = birthdate.Text
dRow.Item(7) = txtrecordno.Text
dRow.Item(8) = txtnoteno.Text
dRow.Item(9) = txtnotesource.Text
dRow.Item(10) = txtnotedate.Text
ds1.Tables("wanted").Rows.Add(dRow)
da1.Update(ds1, "wanted")
MsgBox("تمت عملية الاضافة والحفظ في قاعدة البيانات بنجاح")
Dim form1 As New Form1
Me.Hide()
form1.Show()
Call closetxt()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
هذه افضل طريقة للاضافة افضل من insertinto
لننظر الان الى زر الحذف
Try
If MsgBox("هل تريد حذف السجل الحالي", MsgBoxStyle.OkCancel) = MsgBoxResult.Cancel Then
Exit Sub
End If
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "DELETE FROM wanted WHERE txtrecordno='" & txtrecordno.Text & "'"
conn.Open()
SavInto.ExecuteNonQuery()
ds1.Clear()
da1.Fill(ds1, "Tab1")
conn.Close()
MsgBox("تمت عملية الحذف في قاعدة البيانات بنجاح")
Dim frm1 As New Form1
Me.Hide()
frm1.Show()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
هل رايت السهولة
ولننظر الى زر التعديل
Dim frm3 As New form3
frm3.txtname.Text = Me.txtname.Text
frm3.txtfather.Text = Me.txtfather.Text
frm3.txtgrand.Text = Me.txtgrand.Text
frm3.txtfamily.Text = Me.txtfamily.Text
frm3.txtqabilah.Text = Me.txtqabilah.Text
frm3.birthplace.Text = Me.birthplace.Text
frm3.birthdate.Text = Me.birthdate.Text
frm3.txtrecordno.Text = Me.txtrecordno.Text
frm3.txtnoteno.Text = Me.txtnoteno.Text
frm3.txtnotesource.Text = Me.txtnotesource.Text
frm3.txtnotedate.Text = Me.txtnotedate.Text
frm3.lbl.Text = Me.txtrecordno.Text
frm3.Show()
Me.Hide()
فورم التعديل والذي اسميناه form3
انسخ كافة مربعات النص في الفورم الاول والصقها بفورم التعديل واضف زرين حفظ والغاء
بزر الحفظ اكتب
Try
Dim n As String = lbl.Text
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "UPDATE wanted SET txtname = '" & Trim(txtname.Text) & "' , txtfather = '" & Trim(txtfather.Text) & "' , txtgrand= '" & Trim(txtgrand.Text) & "' , txtfamily= '" & Trim(txtfamily.Text) & "' , txtqabilah= '" & Trim(txtqabilah.Text) & "' , birthplace= '" & Trim(birthplace.Text) & "' , birthdate= '" & Trim(birthdate.Text) & "' , txtrecordno= '" & Trim(txtrecordno.Text) & "' , txtnoteno= '" & Trim(txtnoteno.Text) & "' , txtnotesource= '" & Trim(txtnotesource.Text) & "' , txtnotedate= '" & Trim(txtnotedate.Text) & "' WHERE txtrecordno ='" & n & "'"
conn.Open()
SavInto.ExecuteNonQuery()
da1.Update(ds1, "wanted")
conn.Close()
MsgBox("تمت عملية التعديل والحفظ في قاعدة البيانات بنجاح")
frm.Show()
Me.Close()
Catch ex As Exception
conn.Close()
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
End Sub
في الفورم الاول نريد برمجة ازرار التنقل
كود زر الاول
Me.BindingContext(ds1, "wanted").Position = 0
كود زر الاخير
Me.BindingContext(ds1, "wanted").Position = Me.BindingContext(ds1, "wanted").Count - 1
السابق
Me.BindingContext(ds1, "wanted").Position -= 1
التالي
Me.BindingContext(ds1, "wanted").Position += 1
عدد السجلات
MsgBox(Me.BindingContext(ds1, "wanted").Count, MsgBoxStyle.Exclamation)
الان لنقم بالبدء بشغلتنا الرئيسية وهي
المستخدمين وصلاحياتهم
اتذكر ان هناك جدول اسمه
Fmembers
اذا نريد اضافة عضوية بالنقر على اداة تسجيل عضوية جديدة الموجودة ضمن الفورم الاول
انقر عليها نقرا مزدوجا واكتب بحدثها
addmember.Show()
Me.Hide()
اضف فورم وليكن اسمه
Addmember.vb
واضف الادوات اللازمة ليصبح هكذا
اسم المربع الاول
Txtusername
الثاني
Txtpassword
الثالث
Txtpassword1
لنرى زر تسجيل
If txtusername.Text = "" Or txtpassword.Text = "" Or txtpassword1.Text = "" Then
MsgBox("يجب ادخال قيم مقبولة", MsgBoxStyle.Exclamation, "خطأ")
Exit Sub
ElseIf txtpassword.Text <> txtpassword1.Text Then
MsgBox("كلمات المرور غير متوافقة")
Exit Sub
End If
طبعا واضح لايحتاج الى شرح
الكود التالي يقوم بفحص القاعدة وجدول الاعضاء هل الاسم المختار موجود او لا
Dim issql As String = "select * from fmembers where fusername='" & Me.txtusername.Text & "'"
Dim isds As New DataSet
Dim isda As New OleDb.OleDbDataAdapter(issql, conn)
isda.Fill(isds, "fmembers")
If Me.BindingContext(isds, "fmembers").Count > 0 Then
MsgBox("اسم المستخدم قيد الاستخدام جرب آخر", MsgBoxStyle.Critical, "خطا")
Exit Sub
End If
فلنركز على هذا السطر
If Me.BindingContext(isds, "fmembers").Count > 0 Then
انظر لعلامة اكبر من >0 وافهمها
MsgBox("اسم المستخدم قيد الاستخدام جرب آخر", MsgBoxStyle.Critical, "خطا")
Exit Sub
End If
واضحة
بعدها استدعينا دالة الحفظ
doregister()
لنكشفها
Try
Dim regsql As String = "select * from fmembers"
Dim n As String
Dim regds As New DataSet
Dim regda As New OleDb.OleDbDataAdapter(regsql, conn)
Dim CmdB As New OleDb.OleDbCommandBuilder(regda)
regda.Fill(regds, "fmembers")
n = Encrypt(addmember.txtpassword.Text, "85*wqbhtmaswdf654789lop")
Dim dRow As DataRow = regds.Tables("fmembers").NewRow
dRow.Item(0) = addmember.txtusername.Text
dRow.Item(1) = n
regds.Tables("fmembers").Rows.Add(dRow)
regda.Update(regds, "fmembers")
MsgBox("تم التسجيل بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
وبعدها الاجراء العادي
login.Show()
Me.Hide()
بعد الاضافة يقوم بالتوجه الى شاشة الدخول
انظر الصورة التالية
لنرى زر دخول
Dim n As String
Try
n = Encrypt(Me.txtpassword.Text, "85*wqbhtmaswdf654789lop")
Dim sqlstr1 As String = "SELECT * FROM fmembers WHERE fUserName= '" & txtusername.Text & "' and fPassword='" & n & "'"
Dim mblocked As String = "select * from fblocked where fUserName='" & txtusername.Text & "'"
Dim madmin As String = "select * from fadmin where fUserName='" & txtusername.Text & "'"
Dim mblockedds As New DataSet
Dim mblockeddsda As New OleDb.OleDbDataAdapter(mblocked, conn)
mblockeddsda.Fill(mblockedds, "fblocked")
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
Dim dataset1 As New DataSet
Dim dataadapter1 As New OleDb.OleDbDataAdapter(sqlstr1, conn)
dataadapter1.Fill(dataset1, "fmembers")
If Me.BindingContext(dataset1, "fmembers").Count = 0 Then
With lblmsg
.ForeColor = Color.Red
End With
lgist()
lblmsg.Text = "عفوا بيانات دخولك خاطئة ستدخل بصفة ضيف"
Timer1.Enabled = True
Else
If Me.BindingContext(mblockedds, "fblocked").Count > 0 Then
lblmsg.ForeColor = Color.Red
lblmsg.Text = "عفوا قامت الادارة بحظرك.....راجع المدير"
Exit Sub
ElseIf Me.BindingContext(madminds, "fadmin").Count > 0 Then
ladmin()
Form1.Show()
ElseIf Me.BindingContext(dataset1, "fmembers").Count > 0 Then
lmember()
Form1.Show()
End If
End If
Catch ex As Exception
Dim msb As String = "عفوا يوجد خطا ورقم الخطأ هو " & " " & Err.Number & " "
Dim mss As String = "ونص الخطا هو " & Err.Description
MsgBox(msb + mss, MsgBoxStyle.Critical)
End Try
لن اشرح الكود وانما ساشرح الفكرة
الفكرة هي ان الذي يسجل الدخول للبرنامج وقاعدة البيانات
اما ضيف او عضو او محظور او مشرف
الان الكود مرة اخرى كود الدخول
طبعا لايوجد حقل للضيف في القاعدة وانما ان لم يوجد الاسم ضمن الاعضاء fmembers
فمعناه بكل بساطة انه ضيف وهذا الكود
Dim dataset1 As New DataSet
Dim dataadapter1 As New OleDb.OleDbDataAdapter(sqlstr1, conn)
dataadapter1.Fill(dataset1, "fmembers")
If Me.BindingContext(dataset1, "fmembers").Count = 0 Then
With lblmsg
.ForeColor = Color.Red
End With
lgist()
lblmsg.Text = "عفوا بيانات دخولك خاطئة ستدخل بصفة ضيف"
Timer1.Enabled = True
ان كان ضيفا يتم استدعاء دالة
Lgist
لنكشف هذه الدالة
Form1.grtool.Enabled = False
Form1.rcount.Enabled = False
Form1.lmng.Enabled = False
Form1.GroupBox3.Enabled = True
Form1.lregister.Enabled = True
اكتشفها بنفسك
Lmng
هذا يؤدي للادارة وهو ممنوع للضيوف
لايستطيع الا التصفح فقط
وان كان من الاعضاء المحظورين تظهر له رسالة انه تم حظره ويوقف البرنامج
If Me.BindingContext(mblockedds, "fblocked").Count > 0 Then
lblmsg.ForeColor = Color.Red
lblmsg.Text = "عفوا قامت الادارة بحظرك.....راجع المدير"
Exit Sub
وان كان من المدراء او المشرفين
ElseIf Me.BindingContext(madminds, "fadmin").Count > 0 Then
ladmin()
Form1.Show()
يتم استدعاء دالة
Ladmin
لنكشف هذه الدالة
Form1.grtool.Enabled = True
Form1.rcount.Enabled = True
Form1.GroupBox3.Enabled = True
Form1.lmng.Enabled = True
يتم فتح وتمكين كل الازرار
ومن ضمنها زر الادارة
وان كان من الاعضاء
ElseIf Me.BindingContext(dataset1, "fmembers").Count > 0 Then
lmember()
Form1.Show()
يتم استدعاء دالة
Lmember
لنكشف هذه الدالة
Form1.grtool.Enabled = True
Form1.rcount.Enabled = True
Form1.lmng.Enabled = False
Form1.GroupBox3.Enabled = True
Form1.lregister.Enabled = True
Form1.bttnedit.Enabled = False
Form1.bttndelet.Enabled = False
الان انتهينا بحمد الله من تكويد شاشة الدخول
انقر زر الادارة بعد ان تضيف فورم باسم
Mng
اكتب بداخل زر الادارة الكود التالي
MNG.Show()
Me.Hide()
اضف الادوات لفورم الادارة ليصبح هكذا انظر الصورة
Combobox=cb1
Listbox=lb1
ليتم ملء اداة الكمبوبوكس باسماء الجداول اكتب بحدث mng_load
الكود التالي
Try
Dim sql1 As String = "select * from fmembers"
Dim ds1 As New DataSet
Dim da1 As New OleDb.OleDbDataAdapter(sql1, conn)
da1.Fill(ds1, "fmembers") : da1.Fill(ds1, "fadmin") : da1.Fill(ds1, "fblocked")
Dim dt As DataTable
cb1.Items.Clear()
For Each dt In ds1.Tables
cb1.Items.Add(dt.TableName)
Next
If cb1.Items.Count = 0 Then
cb1.Items.Add("<none>")
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
كل مجموعات الاعضاء سيتم اضافتها لاداة الكمبوبوكس اثناء بدء التشغيل
لناتي الى حدث
cb1_SelectedIndexChanged
cb1=combobox1
ونضيف الكود التالي
Try
Select Case cb1.Text
Case "fmembers"
Dim dss As New DataSet
Dim Sql = "select * from fmembers"
Dim daa As New OleDb.OleDbDataAdapter(Sql, conn)
dss.Clear()
daa.Fill(dss, "fmembers")
lb1.DataSource = dss.Tables(0)
lb1.DisplayMember = "fusername"
lb1.ValueMember = "fusername"
Case "fadmin"
Dim dss As New DataSet
Dim Sql = "select * from fadmin"
Dim daa As New OleDb.OleDbDataAdapter(Sql, conn)
dss.Clear()
daa.Fill(dss, "fadmin")
lb1.DataSource = dss.Tables(0)
lb1.DisplayMember = "fusername"
lb1.ValueMember = "fusername"
Case "fblocked"
Dim dss As New DataSet
Dim Sql = "select * from fblocked"
Dim daa As New OleDb.OleDbDataAdapter(Sql, conn)
dss.Clear()
daa.Fill(dss, "fblocked")
lb1.DataSource = dss.Tables(0)
lb1.DisplayMember = "fusername"
lb1.ValueMember = "fusername"
End Select
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
هذه جملة select case
بمعنى اذا تم انتقاء أي بند من البنود يتم ملء اداة القائمة lb1 بمحتويات ذلك البند او الجدول
لناتي الى حدث
lb1_SelectedIndexChanged
lb1=listbox1
لنرى الكود
Try
Select cb1.Text
Case "fmembers"
Dim x As String = lb1.SelectedValue.ToString
Dim sq As String = "select * from fmembers where fusername='" & x & "'"
Dim dapter As New OleDb.OleDbDataAdapter(sq, conn)
Dim ds As New DataSet
dapter.Fill(ds, "fmembers")
TextBox1.DataBindings.Add("text", ds, "fmembers.fusername")
TextBox2.DataBindings.Add("text", ds, "fmembers.fpassword")
TextBox1.DataBindings.Clear()
TextBox2.DataBindings.Clear()
Case "fadmin"
Dim x As String = lb1.SelectedValue.ToString
Dim sq As String = "select * from fadmin where fusername='" & x & "'"
Dim dapter As New OleDb.OleDbDataAdapter(sq, conn)
Dim ds As New DataSet
dapter.Fill(ds, "fadmin")
TextBox1.DataBindings.Add("text", ds, "fadmin.fusername")
TextBox1.DataBindings.Clear()
Case "fblocked"
Dim x As String = lb1.SelectedValue.ToString
Dim sq As String = "select * from fblocked where fusername='" & x & "'"
Dim dapter As New OleDb.OleDbDataAdapter(sq, conn)
Dim ds As New DataSet
dapter.Fill(ds, "fblocked")
TextBox1.DataBindings.Add("text", ds, "fblocked.fusername")
TextBox1.DataBindings.Clear()
End Select
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
الا تلاحظ وجود مربعات نص في فورم الادارة
يوجد مجموعتين مجموعة يظهر فيها كلمة المرور مشفرة
والاخر نقوم بفك التشفير
في حدث مربع النص المخصص لاظهاء اسم المستخدم ضمن حدث
TextBox1_TextChanged
اكتب الكود التالي
TextBox4.Text = TextBox1.Text
ومربع كلمة المرور ايضا نفس الطريقة لكن
هناك مسالة فك التشفير
Dim n As String
n = Decrypt(TextBox2.Text, "85*wqbhtmaswdf654789lop")
TextBox3.Text = n
الازرار الاخرى معروفة
ولكن ساتطرق الى ازرار الحظر وفك الحظر وتعيين مشرف والغاء من الاشراف
انظر الكود التالي كاملا
Dim mblocked As String = "select * from fblocked where fUserName='" & TextBox4.Text & "'"
Dim madmin As String = "select * from fadmin where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
If Me.BindingContext(madminds, "fadmin").Count > 0 Then
If MsgBox("اذا قمت بحذف الاداري هذا فلن تستطيع او هو يستطيع الدخول للادارة...........هل انت متاكد ان لديك عضويات اشراف اخرى وتريد حذف هذا العضو او التعديل سيتم الحفظ اذا اخترت نعم ويغلق البرنامج هل انت موافق؟", MsgBoxStyle.YesNo + MsgBoxStyle.Critical, "تحذير") = MsgBoxResult.No Then Exit Sub
End If
If MsgBox("هل انت متاكد انك تريد حظر هذا العضو؟ بعد الحظر لن يتمكن من استخدام البرنامج", MsgBoxStyle.YesNo + MsgBoxStyle.Critical) = MsgBoxResult.No Then Exit Sub
Try
Dim regsql As String = "select * from fblocked"
Dim regds As New DataSet
Dim regda As New OleDb.OleDbDataAdapter(regsql, conn)
Dim CmdB As New OleDb.OleDbCommandBuilder(regda)
regda.Fill(regds, "fblocked")
Dim doblods As New DataSet
Dim doblocda As New OleDb.OleDbDataAdapter(mblocked, conn)
doblocda.Fill(doblods, "fblocked")
If Me.BindingContext(doblods, "fblocked").Count > 0 Then
MsgBox("هذا العضو قيد الحظر سابقا", MsgBoxStyle.Exclamation)
Exit Sub
End If
Dim dRow As DataRow = regds.Tables("fblocked").NewRow
dRow.Item(0) = Me.TextBox4.Text
regds.Tables("fblocked").Rows.Add(dRow)
regda.Update(regds, "fblocked")
MsgBox("تم حظر هذا الشخص بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
ولالغاء الحظر انظر الكود التالي
Try
Dim madmin As String = "select * from fblocked where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fblocked")
If MsgBox("هل انت متاكد من الغاء حظر هذا العضو؟", MsgBoxStyle.YesNo + MsgBoxStyle.Critical) = MsgBoxResult.No Then Exit Sub
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "DELETE FROM fblocked WHERE fusername='" & TextBox4.Text & "'"
conn.Open()
SavInto.ExecuteNonQuery()
ds1.Clear()
da1.Fill(ds1, "fblocked")
conn.Close()
MsgBox("تم الغاء حضر العضو بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
كود تعيين كمدير
Dim mblockedstr As String = "select * from fblocked where fUserName='" & TextBox4.Text & "'"
Dim mblockedds As New DataSet
Dim mblockedda As New OleDb.OleDbDataAdapter(mblockedstr, conn)
mblockedda.Fill(mblockedds, "fblocked")
If Me.BindingContext(mblockedds, "fblocked").Count > 0 Then
MsgBox("هذا العضو ضمن قائمة الحضر ولايمكن تعيينه كمدير")
Exit Sub
End If
Dim madmin As String = "select * from fadmin where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
If Me.BindingContext(madminds, "fadmin").Count > 0 Then
If MsgBox(" هذا العضو موجود ضمن قسم الادارة سابقا", MsgBoxStyle.YesNo + MsgBoxStyle.Critical, "تحذير") = MsgBoxResult.No Then Exit Sub
Exit Sub
End If
Try
Dim regsql As String = "select * from fadmin"
Dim regds As New DataSet
Dim regda As New OleDb.OleDbDataAdapter(regsql, conn)
Dim CmdB As New OleDb.OleDbCommandBuilder(regda)
regda.Fill(regds, "fadmin")
Dim doblods As New DataSet
Dim doblocda As New OleDb.OleDbDataAdapter(regsql, conn)
doblocda.Fill(doblods, "fadmin")
Dim dRow As DataRow = regds.Tables("fadmin").NewRow
dRow.Item(0) = Me.TextBox4.Text
regds.Tables("fadmin").Rows.Add(dRow)
regda.Update(regds, "fadmin")
MsgBox("تم تعيين هذا العضو كمشرف")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
هذا كود الحذف من الادارة
Try
Dim madmin As String = "select * from fadmin where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
If MsgBox("هل انت متاكد من الغاء هذا العضو من الادارة؟", MsgBoxStyle.YesNo + MsgBoxStyle.Critical) = MsgBoxResult.No Then Exit Sub
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "DELETE FROM fadmin WHERE fusername='" & TextBox4.Text & "'"
conn.Open()
SavInto.ExecuteNonQuery()
ds1.Clear()
da1.Fill(ds1, "fadmin")
da1.Update(ds1, "fadmin")
conn.Close()
MsgBox("تم الغاءالعضو من الادارة بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
تم بحمد الله الانتهاء من الشرح المبسط واليسير................مع خالص تحياتي محبكم / سعود
عضو منتدى فيجوال بيسك العرب
السلام عليكم ورحمة الله وبركاته.
منذ تسجيلي بهذا المنتدى الطيب وانا اقوم بجمع المعلومات وكان اكثر شيء يشدني مسالة الربط بقاعدة البيانات والاكثر شدا للانتباه هو مسالة الصلاحيات وجمعت معلومات لاباس بها فاحببت ان نبدا سوية خطوة بخطوة لتصميم برنامج يتعامل مع قاعدة بيانات اكسس 2007 باستخدام فيجوال بيسك 2008.
فمن لديه هذه البرامج فهو جاهز للبدء معنا خطوة بخطوة.
لنبدا على بركة الله افتح برنامج
Microsoft Visual Studio 2008
اختر مشروع جديد
WindowsApplication1
اضف عدد 6 نماذج= 6 forms
الاول وليكن اسمه = form1
اضف له الادوات اللازمة كما هو موضع بالصورة التالية:
مزيد من المعلومات
قم بالضغط على زر حفظ الكل ليتم انشاء مجلد للمشروع ..الان قم بفتح مايكروسوفت اكسس 2007
قم بانشاء جدول جديد واسمه wanted انظر الصورة التالية
اضف الحقول كما ترى بالصورة تماما
انشيء جدول اخر واسمه
Fmembers
وجدول اخر اسمه
Fblocked
انظر الصورة التالية
وانشيء جدول ايضا وهو المهم واسمه
Fadmin
استعرض الصور بشكل منفصل عن البرنامج لرؤيتها بشكل اوضح
الان بقي علينا الربط لاننا عرفنا اسم قاعدة البيانات وهو db1.accdb
هذا باستخدام اكسس 2007 اما 2003 فهو
Db1.mdb
الان فنقل بشكل متاخر فكرة برنامجنا وهي
صورة شبيهه بدفتر العناوين واسمينا هذا الجدول المخصص باسم wanted
أي المطلوبين .
نريد الان الربط بهذا الجدول
نضيف موديول جديد وسمه constr ونضيف به الجملة التالية
اعلى اطار الشيفرة اكتب
Imports System.Data.OleDb
ثم داخل الموديول بين جملتي
Module constr
و جملة
End Module
اكتب هذا الكود
Public conn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0; data source= |datadirectory|\db1.accdb;Jet OLEDB:Database Password=vb4arab")
Public ds1 As New DataSet
Public sql1 As String = "select * from wanted"
Public da1 As New OleDbDataAdapter(sql1, conn)
الان انتهينا من اهم خطوة بقيت خطوة الربط بالادوات
نذهب لحدث Form1_Load
الخاص بنموذج او فورم اظهار محتوى القاعدة
ونكتب الكود التالي
Try
conn.Open()
da1.Fill(ds1, "wanted")
conn.Close()
Me.txtname.DataBindings.Add("text", ds1, "wanted.txtname")
Me.txtfather.DataBindings.Add("text", ds1, "wanted.txtfather")
Me.txtgrand.DataBindings.Add("text", ds1, "wanted.txtgrand")
Me.txtfamily.DataBindings.Add("text", ds1, "wanted.txtfamily")
Me.txtqabilah.DataBindings.Add("text", ds1, "wanted.txtqabilah")
Me.birthplace.DataBindings.Add("text", ds1, "wanted.birthplace")
Me.birthdate.DataBindings.Add("text", ds1, "wanted.birthdate")
Me.txtrecordno.DataBindings.Add("text", ds1, "wanted.txtrecordno")
Me.txtnoteno.DataBindings.Add("text", ds1, "wanted.txtnoteno")
Me.txtnotesource.DataBindings.Add("text", ds1, "wanted.txtnotesource")
Me.txtnotedate.DataBindings.Add("text", ds1, "wanted.txtnotedate")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
الان قم بتشغيل البرنامج لتجربته اذا كان عملك صحيحا فستظهر محتويات القاعدة ضمن الفورم الاول
اسماء مربعات النص مثل اسماء حقول القاعدة
لاحظها بنفسك
مثلا اردنا ربط مربع نص بحقل اسم نسمي مربع النص اسم txtname يجب ان يكون اسم الحقل بالقاعدة مثل هذا ليعمل الكود بشكل صحيح.
الان قم بالنقر على زر جديد لاضافة صف جديد ماذا يحدث
Button2.Enabled = True
Button3.Enabled = True
Call opentxt()
Button3.Select()
يقوم بتمكين زر الحفظ وزر محو النصوص بالمربعات
ثم يقوم باستدعاء دالة مخصصة opentxt
لنراها الان
Public Sub opentxt()
Form1.txtname.ReadOnly = False
Form1.txtfather.ReadOnly = False
Form1.txtgrand.ReadOnly = False
Form1.txtfamily.ReadOnly = False
Form1.txtqabilah.ReadOnly = False
Form1.birthplace.ReadOnly = False
Form1.birthdate.ReadOnly = False
Form1.txtrecordno.ReadOnly = False
Form1.txtnoteno.ReadOnly = False
Form1.txtnotesource.ReadOnly = False
Form1.txtnotedate.ReadOnly = False
End Sub
والباقي سهل
لننظر الى زر الحفظ
Button2.Enabled = False
Try
Dim dRow As DataRow = ds1.Tables("wanted").NewRow
dRow.Item(0) = txtname.Text
dRow.Item(1) = txtfather.Text
dRow.Item(2) = txtgrand.Text
dRow.Item(3) = txtfamily.Text
dRow.Item(4) = txtqabilah.Text
dRow.Item(5) = birthplace.Text
dRow.Item(6) = birthdate.Text
dRow.Item(7) = txtrecordno.Text
dRow.Item(8) = txtnoteno.Text
dRow.Item(9) = txtnotesource.Text
dRow.Item(10) = txtnotedate.Text
ds1.Tables("wanted").Rows.Add(dRow)
da1.Update(ds1, "wanted")
MsgBox("تمت عملية الاضافة والحفظ في قاعدة البيانات بنجاح")
Dim form1 As New Form1
Me.Hide()
form1.Show()
Call closetxt()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
هذه افضل طريقة للاضافة افضل من insertinto
لننظر الان الى زر الحذف
Try
If MsgBox("هل تريد حذف السجل الحالي", MsgBoxStyle.OkCancel) = MsgBoxResult.Cancel Then
Exit Sub
End If
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "DELETE FROM wanted WHERE txtrecordno='" & txtrecordno.Text & "'"
conn.Open()
SavInto.ExecuteNonQuery()
ds1.Clear()
da1.Fill(ds1, "Tab1")
conn.Close()
MsgBox("تمت عملية الحذف في قاعدة البيانات بنجاح")
Dim frm1 As New Form1
Me.Hide()
frm1.Show()
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
هل رايت السهولة
ولننظر الى زر التعديل
Dim frm3 As New form3
frm3.txtname.Text = Me.txtname.Text
frm3.txtfather.Text = Me.txtfather.Text
frm3.txtgrand.Text = Me.txtgrand.Text
frm3.txtfamily.Text = Me.txtfamily.Text
frm3.txtqabilah.Text = Me.txtqabilah.Text
frm3.birthplace.Text = Me.birthplace.Text
frm3.birthdate.Text = Me.birthdate.Text
frm3.txtrecordno.Text = Me.txtrecordno.Text
frm3.txtnoteno.Text = Me.txtnoteno.Text
frm3.txtnotesource.Text = Me.txtnotesource.Text
frm3.txtnotedate.Text = Me.txtnotedate.Text
frm3.lbl.Text = Me.txtrecordno.Text
frm3.Show()
Me.Hide()
فورم التعديل والذي اسميناه form3
انسخ كافة مربعات النص في الفورم الاول والصقها بفورم التعديل واضف زرين حفظ والغاء
بزر الحفظ اكتب
Try
Dim n As String = lbl.Text
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "UPDATE wanted SET txtname = '" & Trim(txtname.Text) & "' , txtfather = '" & Trim(txtfather.Text) & "' , txtgrand= '" & Trim(txtgrand.Text) & "' , txtfamily= '" & Trim(txtfamily.Text) & "' , txtqabilah= '" & Trim(txtqabilah.Text) & "' , birthplace= '" & Trim(birthplace.Text) & "' , birthdate= '" & Trim(birthdate.Text) & "' , txtrecordno= '" & Trim(txtrecordno.Text) & "' , txtnoteno= '" & Trim(txtnoteno.Text) & "' , txtnotesource= '" & Trim(txtnotesource.Text) & "' , txtnotedate= '" & Trim(txtnotedate.Text) & "' WHERE txtrecordno ='" & n & "'"
conn.Open()
SavInto.ExecuteNonQuery()
da1.Update(ds1, "wanted")
conn.Close()
MsgBox("تمت عملية التعديل والحفظ في قاعدة البيانات بنجاح")
frm.Show()
Me.Close()
Catch ex As Exception
conn.Close()
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
End Sub
في الفورم الاول نريد برمجة ازرار التنقل
كود زر الاول
Me.BindingContext(ds1, "wanted").Position = 0
كود زر الاخير
Me.BindingContext(ds1, "wanted").Position = Me.BindingContext(ds1, "wanted").Count - 1
السابق
Me.BindingContext(ds1, "wanted").Position -= 1
التالي
Me.BindingContext(ds1, "wanted").Position += 1
عدد السجلات
MsgBox(Me.BindingContext(ds1, "wanted").Count, MsgBoxStyle.Exclamation)
الان لنقم بالبدء بشغلتنا الرئيسية وهي
المستخدمين وصلاحياتهم
اتذكر ان هناك جدول اسمه
Fmembers
اذا نريد اضافة عضوية بالنقر على اداة تسجيل عضوية جديدة الموجودة ضمن الفورم الاول
انقر عليها نقرا مزدوجا واكتب بحدثها
addmember.Show()
Me.Hide()
اضف فورم وليكن اسمه
Addmember.vb
واضف الادوات اللازمة ليصبح هكذا
اسم المربع الاول
Txtusername
الثاني
Txtpassword
الثالث
Txtpassword1
لنرى زر تسجيل
If txtusername.Text = "" Or txtpassword.Text = "" Or txtpassword1.Text = "" Then
MsgBox("يجب ادخال قيم مقبولة", MsgBoxStyle.Exclamation, "خطأ")
Exit Sub
ElseIf txtpassword.Text <> txtpassword1.Text Then
MsgBox("كلمات المرور غير متوافقة")
Exit Sub
End If
طبعا واضح لايحتاج الى شرح
الكود التالي يقوم بفحص القاعدة وجدول الاعضاء هل الاسم المختار موجود او لا
Dim issql As String = "select * from fmembers where fusername='" & Me.txtusername.Text & "'"
Dim isds As New DataSet
Dim isda As New OleDb.OleDbDataAdapter(issql, conn)
isda.Fill(isds, "fmembers")
If Me.BindingContext(isds, "fmembers").Count > 0 Then
MsgBox("اسم المستخدم قيد الاستخدام جرب آخر", MsgBoxStyle.Critical, "خطا")
Exit Sub
End If
فلنركز على هذا السطر
If Me.BindingContext(isds, "fmembers").Count > 0 Then
انظر لعلامة اكبر من >0 وافهمها
MsgBox("اسم المستخدم قيد الاستخدام جرب آخر", MsgBoxStyle.Critical, "خطا")
Exit Sub
End If
واضحة
بعدها استدعينا دالة الحفظ
doregister()
لنكشفها
Try
Dim regsql As String = "select * from fmembers"
Dim n As String
Dim regds As New DataSet
Dim regda As New OleDb.OleDbDataAdapter(regsql, conn)
Dim CmdB As New OleDb.OleDbCommandBuilder(regda)
regda.Fill(regds, "fmembers")
n = Encrypt(addmember.txtpassword.Text, "85*wqbhtmaswdf654789lop")
Dim dRow As DataRow = regds.Tables("fmembers").NewRow
dRow.Item(0) = addmember.txtusername.Text
dRow.Item(1) = n
regds.Tables("fmembers").Rows.Add(dRow)
regda.Update(regds, "fmembers")
MsgBox("تم التسجيل بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
وبعدها الاجراء العادي
login.Show()
Me.Hide()
بعد الاضافة يقوم بالتوجه الى شاشة الدخول
انظر الصورة التالية
لنرى زر دخول
Dim n As String
Try
n = Encrypt(Me.txtpassword.Text, "85*wqbhtmaswdf654789lop")
Dim sqlstr1 As String = "SELECT * FROM fmembers WHERE fUserName= '" & txtusername.Text & "' and fPassword='" & n & "'"
Dim mblocked As String = "select * from fblocked where fUserName='" & txtusername.Text & "'"
Dim madmin As String = "select * from fadmin where fUserName='" & txtusername.Text & "'"
Dim mblockedds As New DataSet
Dim mblockeddsda As New OleDb.OleDbDataAdapter(mblocked, conn)
mblockeddsda.Fill(mblockedds, "fblocked")
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
Dim dataset1 As New DataSet
Dim dataadapter1 As New OleDb.OleDbDataAdapter(sqlstr1, conn)
dataadapter1.Fill(dataset1, "fmembers")
If Me.BindingContext(dataset1, "fmembers").Count = 0 Then
With lblmsg
.ForeColor = Color.Red
End With
lgist()
lblmsg.Text = "عفوا بيانات دخولك خاطئة ستدخل بصفة ضيف"
Timer1.Enabled = True
Else
If Me.BindingContext(mblockedds, "fblocked").Count > 0 Then
lblmsg.ForeColor = Color.Red
lblmsg.Text = "عفوا قامت الادارة بحظرك.....راجع المدير"
Exit Sub
ElseIf Me.BindingContext(madminds, "fadmin").Count > 0 Then
ladmin()
Form1.Show()
ElseIf Me.BindingContext(dataset1, "fmembers").Count > 0 Then
lmember()
Form1.Show()
End If
End If
Catch ex As Exception
Dim msb As String = "عفوا يوجد خطا ورقم الخطأ هو " & " " & Err.Number & " "
Dim mss As String = "ونص الخطا هو " & Err.Description
MsgBox(msb + mss, MsgBoxStyle.Critical)
End Try
لن اشرح الكود وانما ساشرح الفكرة
الفكرة هي ان الذي يسجل الدخول للبرنامج وقاعدة البيانات
اما ضيف او عضو او محظور او مشرف
الان الكود مرة اخرى كود الدخول
طبعا لايوجد حقل للضيف في القاعدة وانما ان لم يوجد الاسم ضمن الاعضاء fmembers
فمعناه بكل بساطة انه ضيف وهذا الكود
Dim dataset1 As New DataSet
Dim dataadapter1 As New OleDb.OleDbDataAdapter(sqlstr1, conn)
dataadapter1.Fill(dataset1, "fmembers")
If Me.BindingContext(dataset1, "fmembers").Count = 0 Then
With lblmsg
.ForeColor = Color.Red
End With
lgist()
lblmsg.Text = "عفوا بيانات دخولك خاطئة ستدخل بصفة ضيف"
Timer1.Enabled = True
ان كان ضيفا يتم استدعاء دالة
Lgist
لنكشف هذه الدالة
Form1.grtool.Enabled = False
Form1.rcount.Enabled = False
Form1.lmng.Enabled = False
Form1.GroupBox3.Enabled = True
Form1.lregister.Enabled = True
اكتشفها بنفسك
Lmng
هذا يؤدي للادارة وهو ممنوع للضيوف
لايستطيع الا التصفح فقط
وان كان من الاعضاء المحظورين تظهر له رسالة انه تم حظره ويوقف البرنامج
If Me.BindingContext(mblockedds, "fblocked").Count > 0 Then
lblmsg.ForeColor = Color.Red
lblmsg.Text = "عفوا قامت الادارة بحظرك.....راجع المدير"
Exit Sub
وان كان من المدراء او المشرفين
ElseIf Me.BindingContext(madminds, "fadmin").Count > 0 Then
ladmin()
Form1.Show()
يتم استدعاء دالة
Ladmin
لنكشف هذه الدالة
Form1.grtool.Enabled = True
Form1.rcount.Enabled = True
Form1.GroupBox3.Enabled = True
Form1.lmng.Enabled = True
يتم فتح وتمكين كل الازرار
ومن ضمنها زر الادارة
وان كان من الاعضاء
ElseIf Me.BindingContext(dataset1, "fmembers").Count > 0 Then
lmember()
Form1.Show()
يتم استدعاء دالة
Lmember
لنكشف هذه الدالة
Form1.grtool.Enabled = True
Form1.rcount.Enabled = True
Form1.lmng.Enabled = False
Form1.GroupBox3.Enabled = True
Form1.lregister.Enabled = True
Form1.bttnedit.Enabled = False
Form1.bttndelet.Enabled = False
الان انتهينا بحمد الله من تكويد شاشة الدخول
انقر زر الادارة بعد ان تضيف فورم باسم
Mng
اكتب بداخل زر الادارة الكود التالي
MNG.Show()
Me.Hide()
اضف الادوات لفورم الادارة ليصبح هكذا انظر الصورة
Combobox=cb1
Listbox=lb1
ليتم ملء اداة الكمبوبوكس باسماء الجداول اكتب بحدث mng_load
الكود التالي
Try
Dim sql1 As String = "select * from fmembers"
Dim ds1 As New DataSet
Dim da1 As New OleDb.OleDbDataAdapter(sql1, conn)
da1.Fill(ds1, "fmembers") : da1.Fill(ds1, "fadmin") : da1.Fill(ds1, "fblocked")
Dim dt As DataTable
cb1.Items.Clear()
For Each dt In ds1.Tables
cb1.Items.Add(dt.TableName)
Next
If cb1.Items.Count = 0 Then
cb1.Items.Add("<none>")
End If
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
كل مجموعات الاعضاء سيتم اضافتها لاداة الكمبوبوكس اثناء بدء التشغيل
لناتي الى حدث
cb1_SelectedIndexChanged
cb1=combobox1
ونضيف الكود التالي
Try
Select Case cb1.Text
Case "fmembers"
Dim dss As New DataSet
Dim Sql = "select * from fmembers"
Dim daa As New OleDb.OleDbDataAdapter(Sql, conn)
dss.Clear()
daa.Fill(dss, "fmembers")
lb1.DataSource = dss.Tables(0)
lb1.DisplayMember = "fusername"
lb1.ValueMember = "fusername"
Case "fadmin"
Dim dss As New DataSet
Dim Sql = "select * from fadmin"
Dim daa As New OleDb.OleDbDataAdapter(Sql, conn)
dss.Clear()
daa.Fill(dss, "fadmin")
lb1.DataSource = dss.Tables(0)
lb1.DisplayMember = "fusername"
lb1.ValueMember = "fusername"
Case "fblocked"
Dim dss As New DataSet
Dim Sql = "select * from fblocked"
Dim daa As New OleDb.OleDbDataAdapter(Sql, conn)
dss.Clear()
daa.Fill(dss, "fblocked")
lb1.DataSource = dss.Tables(0)
lb1.DisplayMember = "fusername"
lb1.ValueMember = "fusername"
End Select
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
هذه جملة select case
بمعنى اذا تم انتقاء أي بند من البنود يتم ملء اداة القائمة lb1 بمحتويات ذلك البند او الجدول
لناتي الى حدث
lb1_SelectedIndexChanged
lb1=listbox1
لنرى الكود
Try
Select cb1.Text
Case "fmembers"
Dim x As String = lb1.SelectedValue.ToString
Dim sq As String = "select * from fmembers where fusername='" & x & "'"
Dim dapter As New OleDb.OleDbDataAdapter(sq, conn)
Dim ds As New DataSet
dapter.Fill(ds, "fmembers")
TextBox1.DataBindings.Add("text", ds, "fmembers.fusername")
TextBox2.DataBindings.Add("text", ds, "fmembers.fpassword")
TextBox1.DataBindings.Clear()
TextBox2.DataBindings.Clear()
Case "fadmin"
Dim x As String = lb1.SelectedValue.ToString
Dim sq As String = "select * from fadmin where fusername='" & x & "'"
Dim dapter As New OleDb.OleDbDataAdapter(sq, conn)
Dim ds As New DataSet
dapter.Fill(ds, "fadmin")
TextBox1.DataBindings.Add("text", ds, "fadmin.fusername")
TextBox1.DataBindings.Clear()
Case "fblocked"
Dim x As String = lb1.SelectedValue.ToString
Dim sq As String = "select * from fblocked where fusername='" & x & "'"
Dim dapter As New OleDb.OleDbDataAdapter(sq, conn)
Dim ds As New DataSet
dapter.Fill(ds, "fblocked")
TextBox1.DataBindings.Add("text", ds, "fblocked.fusername")
TextBox1.DataBindings.Clear()
End Select
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
الا تلاحظ وجود مربعات نص في فورم الادارة
يوجد مجموعتين مجموعة يظهر فيها كلمة المرور مشفرة
والاخر نقوم بفك التشفير
في حدث مربع النص المخصص لاظهاء اسم المستخدم ضمن حدث
TextBox1_TextChanged
اكتب الكود التالي
TextBox4.Text = TextBox1.Text
ومربع كلمة المرور ايضا نفس الطريقة لكن
هناك مسالة فك التشفير
Dim n As String
n = Decrypt(TextBox2.Text, "85*wqbhtmaswdf654789lop")
TextBox3.Text = n
الازرار الاخرى معروفة
ولكن ساتطرق الى ازرار الحظر وفك الحظر وتعيين مشرف والغاء من الاشراف
انظر الكود التالي كاملا
Dim mblocked As String = "select * from fblocked where fUserName='" & TextBox4.Text & "'"
Dim madmin As String = "select * from fadmin where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
If Me.BindingContext(madminds, "fadmin").Count > 0 Then
If MsgBox("اذا قمت بحذف الاداري هذا فلن تستطيع او هو يستطيع الدخول للادارة...........هل انت متاكد ان لديك عضويات اشراف اخرى وتريد حذف هذا العضو او التعديل سيتم الحفظ اذا اخترت نعم ويغلق البرنامج هل انت موافق؟", MsgBoxStyle.YesNo + MsgBoxStyle.Critical, "تحذير") = MsgBoxResult.No Then Exit Sub
End If
If MsgBox("هل انت متاكد انك تريد حظر هذا العضو؟ بعد الحظر لن يتمكن من استخدام البرنامج", MsgBoxStyle.YesNo + MsgBoxStyle.Critical) = MsgBoxResult.No Then Exit Sub
Try
Dim regsql As String = "select * from fblocked"
Dim regds As New DataSet
Dim regda As New OleDb.OleDbDataAdapter(regsql, conn)
Dim CmdB As New OleDb.OleDbCommandBuilder(regda)
regda.Fill(regds, "fblocked")
Dim doblods As New DataSet
Dim doblocda As New OleDb.OleDbDataAdapter(mblocked, conn)
doblocda.Fill(doblods, "fblocked")
If Me.BindingContext(doblods, "fblocked").Count > 0 Then
MsgBox("هذا العضو قيد الحظر سابقا", MsgBoxStyle.Exclamation)
Exit Sub
End If
Dim dRow As DataRow = regds.Tables("fblocked").NewRow
dRow.Item(0) = Me.TextBox4.Text
regds.Tables("fblocked").Rows.Add(dRow)
regda.Update(regds, "fblocked")
MsgBox("تم حظر هذا الشخص بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
ولالغاء الحظر انظر الكود التالي
Try
Dim madmin As String = "select * from fblocked where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fblocked")
If MsgBox("هل انت متاكد من الغاء حظر هذا العضو؟", MsgBoxStyle.YesNo + MsgBoxStyle.Critical) = MsgBoxResult.No Then Exit Sub
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "DELETE FROM fblocked WHERE fusername='" & TextBox4.Text & "'"
conn.Open()
SavInto.ExecuteNonQuery()
ds1.Clear()
da1.Fill(ds1, "fblocked")
conn.Close()
MsgBox("تم الغاء حضر العضو بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
كود تعيين كمدير
Dim mblockedstr As String = "select * from fblocked where fUserName='" & TextBox4.Text & "'"
Dim mblockedds As New DataSet
Dim mblockedda As New OleDb.OleDbDataAdapter(mblockedstr, conn)
mblockedda.Fill(mblockedds, "fblocked")
If Me.BindingContext(mblockedds, "fblocked").Count > 0 Then
MsgBox("هذا العضو ضمن قائمة الحضر ولايمكن تعيينه كمدير")
Exit Sub
End If
Dim madmin As String = "select * from fadmin where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
If Me.BindingContext(madminds, "fadmin").Count > 0 Then
If MsgBox(" هذا العضو موجود ضمن قسم الادارة سابقا", MsgBoxStyle.YesNo + MsgBoxStyle.Critical, "تحذير") = MsgBoxResult.No Then Exit Sub
Exit Sub
End If
Try
Dim regsql As String = "select * from fadmin"
Dim regds As New DataSet
Dim regda As New OleDb.OleDbDataAdapter(regsql, conn)
Dim CmdB As New OleDb.OleDbCommandBuilder(regda)
regda.Fill(regds, "fadmin")
Dim doblods As New DataSet
Dim doblocda As New OleDb.OleDbDataAdapter(regsql, conn)
doblocda.Fill(doblods, "fadmin")
Dim dRow As DataRow = regds.Tables("fadmin").NewRow
dRow.Item(0) = Me.TextBox4.Text
regds.Tables("fadmin").Rows.Add(dRow)
regda.Update(regds, "fadmin")
MsgBox("تم تعيين هذا العضو كمشرف")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical, "error")
End Try
هذا كود الحذف من الادارة
Try
Dim madmin As String = "select * from fadmin where fUserName='" & TextBox4.Text & "'"
Dim madminds As New DataSet
Dim madminda As New OleDb.OleDbDataAdapter(madmin, conn)
madminda.Fill(madminds, "fadmin")
If MsgBox("هل انت متاكد من الغاء هذا العضو من الادارة؟", MsgBoxStyle.YesNo + MsgBoxStyle.Critical) = MsgBoxResult.No Then Exit Sub
Dim SavInto As New OleDb.OleDbCommand
SavInto.Connection = conn
SavInto.CommandType = CommandType.Text
SavInto.CommandText = "DELETE FROM fadmin WHERE fusername='" & TextBox4.Text & "'"
conn.Open()
SavInto.ExecuteNonQuery()
ds1.Clear()
da1.Fill(ds1, "fadmin")
da1.Update(ds1, "fadmin")
conn.Close()
MsgBox("تم الغاءالعضو من الادارة بنجاح")
Catch ex As Exception
MsgBox(Err.Description, MsgBoxStyle.Critical)
End Try
تم بحمد الله الانتهاء من الشرح المبسط واليسير................مع خالص تحياتي محبكم / سعود
عضو منتدى فيجوال بيسك العرب
0 التعليقات:
إرسال تعليق