يا اخوة هل لدى احدكم مثال حول كيفية التحقق من اسم المستخدم و كلمة السر في قاعدة البيانات اكسس .......... و اذا كان مثال مصور يكون احسن و شكرا جزيلا .....
شكرا اخي سعود لكن المشكله كلما اقوم بتحميل امثلة او مشاريع و فيها قاعدة بيانات اكسس لا تعمل عندي على جيهازي ما السبب لا اعرف و حتى عندما اقوم بتشغيل الملف الدفعي فانها ايضا لا تعمل و شكرا مرة اخرة .......
Module Module1
Public Function Encrypt(ByVal text As String, ByVal key As String) As String
Try
Dim crp As New TripleDESCryptoServiceProvider
Dim uEncode As New UnicodeEncoding
Dim bytPlainText() As Byte = uEncode.GetBytes(text)
Dim stmCipherText As New MemoryStream
Dim slt() As Byte = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}
Dim pdb As New Rfc2898DeriveBytes(key, slt)
Dim bytDerivedKey() As Byte = pdb.GetBytes(24)
crp.Key = bytDerivedKey
crp.IV = pdb.GetBytes(8)
Dim csEncrypted As New CryptoStream(stmCipherText, crp.CreateEncryptor(), CryptoStreamMode.Write)
csEncrypted.Write(bytPlainText, 0, bytPlainText.Length)
csEncrypted.FlushFinalBlock()
Return Convert.ToBase64String(stmCipherText.ToArray())
Catch ex As Exception
Throw
End Try
End Function
Public str As String = "provider=microsoft.ace.oledb.12.0;data source=|datadirectory|\db.accdb"
Public con As New OleDbConnection(str)
Function isvaliduser(ByVal un As String, ByVal ps As String) As Boolean
Dim k As String = "vb4arabdotcom"
Dim thepassword As String = Encrypt(ps, k)
Dim cm As New OleDbCommand("select count(tid) from tb where un=@un and ps=@ps", con)
cm.Parameters.AddWithValue("@un", un)
cm.Parameters.AddWithValue("@ps", thepassword)
Try
If con.State = ConnectionState.Closed Then
con.Open()
End If
If cm.ExecuteScalar > 0 Then
Return True
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function
Function istaken(ByVal un As String) As Boolean
Dim cm As New OleDbCommand("select count(tid) from tb where un=@un", con)
cm.Parameters.AddWithValue("@un", un)
Try
If con.State = ConnectionState.Closed Then
con.Open()
End If
If cm.ExecuteScalar > 0 Then
Return True
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function
Function addme(ByVal un As String, ByVal ps As String) As Boolean
If istaken(un) Then
Return False
Exit Function
Else
Dim k As String = "vb4arabdotcom"
Dim thepassword As String = Encrypt(ps, k)
Dim cm As New OleDbCommand("insert into tb(un,ps) values(@un,@ps)", con)
cm.Parameters.AddWithValue("@un", un)
cm.Parameters.AddWithValue("@ps", thepassword)
Try
If con.State = ConnectionState.Closed Then
con.Open()
End If
cm.ExecuteNonQuery()
Return True
Catch ex As Exception
Return False
End Try
End If
End Function
End Module
وملف register.vb
ومحتواه
كود :
Public Class register
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Me.Close()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
lbl.Visible = False
If addme(un.Text, ps.Text) Then
lbl.Text = "تم تسجيلك بنجاح"
lbl.ForeColor = Color.Green
lbl.Visible = True
Else
lbl.Text = "لم يتم تسجيلك لسببين اما ان الاسم محجوز او لامر غير معروف ابلغ المسؤول بذلك"
lbl.ForeColor = Color.Red
lbl.Visible = True
End If
End Sub
End Class
وملف login.vb
ومحتواه
كود :
Public Class login
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If us.Text.Trim = "" Or ps.Text.Trim = "" Then Exit Sub
lbl.Visible = False
If isvaliduser(us.Text, ps.Text) Then
lbl.Text = "أهلا وسهلا بك, البيانات صحيحة"
lbl.ForeColor = Color.Green
lbl.Visible = True
Else
lbl.Text = "عفوا البيانات خاطئة"
lbl.ForeColor = Color.Red
lbl.Visible = True
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
register.ShowDialog()
End Sub
شكرا اخي سعود و جزاك الله كل خير و الله يجعلها في ميزان حسناتك ........
اصدار الاكسس لدي هو 2010 اما نسخة الفيجوال بيسك 2013 فانها تظهر لي رساله خطأ كلما اردت ان اشغلها ......
و لكني اعمل ايضا على نسخة 2008 و هي شغاله و الحمد لله ......
و جاري تجريب المثال و شكرا مرة اخرة و تم التقيم .........
رسالة الخطأ بالنسبة للفيجوال بيسك 2013 هي .....