مساعدة في تعديل على الكود لزيادة الحماية

[Oliver916]

بسم الله الرحمن الرحيم

يوجد لدي الكود التالي

Private Sub CmdLogin_Click()

On Error GoTo Err_CmdLogin_Click

'** At this point you would use your existing user name and password validation

'** routines. for the purposes of this demo the user name and password have been

'** hard coded for brevity.

If Me.TxtUser = "Transport" And Me.TxtPWD = "amstpt" Then

'Switch off the time control by setting the interval to 0

Me.TimerInterval = 0

MsgBox "Login Successed", vbInformation + vbInformation, "Login"

DoCmd.Close

DoCmd.OpenForm "frm Main"

Else

'If this is the first incorrect attempt

'set the interval to one second

If LngInterval = 0 Then

LngInterval = 1000

End If

'notify the user

MsgBox "Incorrect user name or password", vbExclamation + vbOKOnly, "Login Failed"

'turn on the hourglass for delay period

DoCmd.Hourglass True

'This is optional - for testing only

Me.LblWaiting.Visible = True

Me.LblWaiting.Caption = "Waiting " & LngInterval / 1000 & " seconds..."

Me.TxtUser = ""

Me.TxtPWD = ""

'Double the existing waiting time

LngInterval = LngInterval * 2

'Lock the controls for the specified time period

Me.TimerInterval = LngInterval

Me.TxtUser.Locked = True

Me.TxtPWD.Locked = True

Me.TxtUser.SetFocus

Me.CmdLogin.Enabled = False

End If

Exit_CmdLogin_Click:

Exit Sub

Err_CmdLogin_Click:

MsgBox Err.Description

Resume Exit_CmdLogin_Click

End Sub

مثل ما انتو شايفين

انا عملته انه يطلب اسم المستخدم و كلمة المرور عن طريق فورم

انا الي اريده انه بعد مدة معنية من الزمان يتغير الباسسوورد

فقط لا غير

هل ممكن؟

[ابوخليل]

السلام عليكم

بهذه الطريقة لن تستطيع تغيير الباسوورد الابالدخول مرة اخرى والتعديل على الكود ، وقد فهمت من مشاركتك السابقة أنك تريد أن تعطي المستخدم مهلة زمنية لتجربة البرنامج ثم بنهاية هذه المدة يطالبه البرنامج بالتسجيل .

هذا هو الشرط لديك :

If Me.TxtUser = "Transport" And Me.TxtPWD = "amstpt" Then

لو اضفت شرطا للتاريخ قبل هذا فالبرنامج سيفتح ما دام في المدة المحددة دون المرور بفورم التسجيل مثلا :

Dim Ad

Dim bd

Ad = date

bd = datend

if ad < bd then

DoCmd.OpenForm "frm Main

end if

باعتبار datend مربع نص يتم فيه ادخال تاريخ النهاية

[Oliver916]

فعلاً

شكرا لك

ولكن ماذا لو اردت باسسورد آخر من اختياري

يعني بعد انتهاء المدة يطلب رمز آخر اكون قد وضعته في الكود مسبقاً

يعني هذا الرمز لا يعمل لطالما الوقت لم ينتهي

[ابوخليل]

ممكن :

اضف الى شرطك بالرمز الأول شرط التاريخ and ad < bd

else

اضف شرطك بالرمز الثاني مع عكس شرط التاريخ and bd =< ad ويمكنك أيضا بدون شرط التاريخ

ولكن هذه الحماية غير مجدية فيمكن نسخ البرنامج الى اجهزة اخرى وبنفس الرمز

افضل من ذلك الحماية برقم القرص الصلب أو المعالج ونحوه

[Oliver916]

ممكن :

اضف الى شرطك بالرمز الأول شرط التاريخ and ad < bd

else

اضف شرطك بالرمز الثاني مع عكس شرط التاريخ and bd =< ad ويمكنك أيضا بدون شرط التاريخ

ولكن هذه الحماية غير مجدية فيمكن نسخ البرنامج الى اجهزة اخرى وبنفس الرمز

افضل من ذلك الحماية برقم القرص الصلب أو المعالج ونحوه

للأسف لم افهم

اخي انا ضعيف نوعاً ما في البرمجة و الاكواد

ممكن تساعدني اكثر و تريني التعديل ان لم يكن صعباً عليك؟

[Oliver916]

اخي

لقد تعبثت قليلاً بالاكواد حسب ما طلبت مني و صار هكذا

Dim Ad

Dim bd

Ad = Date

bd = datend

If Ad < bd Then

If Me.TxtUser = "Transport" And Me.TxtPWD = "amstpt" And Ad < bd Then

Else

If Me.TxtUser = "Transport" And Me.TxtPWD = "78amstpt54" And bd <= Ad Then

Me.TimerInterval = 0

MsgBox "Login Successed", vbInformation + vbInformation, "Login"

DoCmd.Close

DoCmd.OpenForm "frm Main"

End If

Else

يظهر لي Error يقول لي Else without IF

و يظلل الـelse الاخيرة:

DoCmd.Close

DoCmd.OpenForm "frm Main"

End If

Else

ما الناقص؟

[ابوخليل]

انشء في النموذج مربعي نص منظمين وسمهما : Ad و Bd وطبعا ستجعلهما مخفيين بعد رؤيتك لنجاح التجربة

اكتب في Bd التاريخ اكبر من تاريخ اليوم بـ 15 يوم مثلا أما Ad فكما ترى في الكود التالي فسيأخذ تاريخ اليوم الافتراضي ألياً

الصق الكود التالي ووافني بالنتيجة .

Private Sub Form_Current()

Me.Ad = Date

Me.Refresh

End Sub

Private Sub CmdLogin_Click()

On Error Resume Next

If Me.Bd > Me.Ad And Me.TxtUser = "AA" And Me.TxtPWD = "BB" Then

MsgBox "مرحباً : أنت في الفترة التجريبية لمدة 15 يوما ", vbInformation + vbInformation, "Login"

DoCmd.Close

DoCmd.OpenForm "frm Main"

ElseIf Me.TxtUser = "AA" And Me.TxtPWD = "CC" Then

MsgBox "Login Successed", vbInformation + vbInformation, "Login"

DoCmd.Close

DoCmd.OpenForm "frm Main"

Else

 MsgBox "Incorrect user name or password", vbExclamation + vbOKOnly, "Login Failed"

End If

End Sub

تم تعديل ديسمبر 8, 2009 بواسطه أبو الأنس

[Oliver916]

شكرررررررررررررررررررا جزيلا

لقد قمت بتعديله قليلاً

اضفت شرط me.bd > me.Ad

بعد elseif

[ابوخليل]

لا يمكن لأن bd عند انتهاء الوقت المحدد ستكون أصغر من Ad

وحتى لو قصدك bd < Ad يبقى مالها لزمة لانها هي فعلا اصغر

آمل انها اتضحت المسألة لديك