سؤال عن كلمة المرور وسؤال ثاني

| ^ _ ^ _ ^ |

بالنسبة لسؤالك الاول ,,, وهو عدم فتح نموذج ما إلا بعد إدخال كلمة مرور

أخي ضع هذا الكود في النموذج الذي تريد في حدث ( عند الفتح ) للنموذج

Dim t, p
 t = "برنامج تجربة الدخول برقم سري"
 p = "فضلا ،،،،، أدخل كلمة المرور للدخول للبرنامج"
If InputBox(p, t) = "111" Then
MsgBox "الآن... يمكنك الدخول للبرنامج", vbOKOnly, "ترحيب"
Else
MsgBox "لايمكنك الدخول للبرنامج", vbOKOnly, "تحذير"
DoCmd.Quit
End If

عندما تقوم بتفعيل هذا النموذج ( الفورم ) سوف تظهر لك رسالة بوضع الرقم السري وهو ( 111 ) ,,,, عندما تكتب الرقم السري صحيحا ،،، سوف يفتح لك النموذج ، وعندما تكتب رقما غير صحيح مثلا ( 444 ) سوف تظهر لك رسالة بعدم إمكانك بالدخول على البرنامج

شاكر

بالنسبة للسؤال الثاني وهو كيفية حماية برنامجك بعدم التعديل فبإمكانك بعد الانتهاء منه تحويله إلى ملف ( mde ) ،،، بهذه الطريقة تؤمن فقط الوحدات النمطية للبرنامج ككل أي عدم الدخول على لوحة ( الفيجول بيسك ) .

أما عن النماذج فقد خاض بها الكثير من الفطاحل في المنتدى وتمكنوا من التعديل فيها أمثال الاستاذ / المزيني ، والاستاذ / أبو عقيل ، والاستاذ / رضا عقيل وغيرهم من فطاحل المنتدى . أرجو أن لا يزعل الاساتذة الباقون الذين لم أذكر أسمائهم ، فلو أردت أن أذكر أسماء الفطاحل لهذا المنتدى ، لاتكفي ( ؟ ) ساعة لذكر أسمائهم . أرجو المعذرة

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

شاكر

تفضل هذا الرابط

http://www.arabteam2000.com/ib/index.php?s...pic=29890&st=30

وهذا الرابط

http://www.arabteam2000.com/ib/index.php?s...topic=31215&hl=

وهذا الرابط

http://www.arabteam2000.com/ib/index.php?s...topic=18984&hl=

وهذا الرابط

http://www.arabteam2000.com/ib/index.php?s...topic=28219&hl=

وهذا الرابط

http://www.arabteam2000.com/ib/index.php?s...topic=26107&hl=

وتوجد عدة مواضيع عن الحماية

فقط إبحث عن ما تريد سوف تجد ضالتك إن شاء الله تعالى ,,,,,

شاكر

ممتاز الله يعطيك العافيه

شكرًا أيها الإخوة على التفاعل ... والطريقة تمام

لكن يا أخي شاكر الزين ... الباس وورد غير مشفرة ...

انا اريد تكون نجمات ... بدل ما يظهر ارقام كباس وورد المواقع والمسنجرات

اقتباس

اقتباس

شكرًا أيها الإخوة على التفاعل ... والطريقة تمام

من هم هؤلاء الاخوة

اقتباس

اقتباس

لكن يا أخي شاكر الزين ... الباس وورد غير مشفرة ...

انا اريد تكون نجمات ... بدل ما يظهر ارقام كباس وورد المواقع والمسنجرات

؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

شاكر

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

وهذه صورة توضيحية للمطلوب ... ( وآسفين على الطلب ) يقول المثل (اذا كان صاحبك عسل لا تآكله كله ) :)

أخي / منذر ،،،،،، ما هو مفهوم التفاعل في نظرك ،،، هل هو وضع كلمة ممتاز ، عساك على القوة ، وأو ما شابه ذلك من كلمات

هذه الكلمات مطلوبة ولكن أين موقعها ،،،، أي متى تكتب ،،،، عندما يضع شخص ما مشكلة ويقوم عضو بوضع حل لهذه المشكلة ،،،، هنا يكون مكان هذه الكلمات وتكون في محل تفاعل في المشاركة ، وتكون من صاحب المشاركة ، أي تكتب من قبل صاحب المشكلة ، موجهة إلى من قام بوضع حل لمشكلته ، ألا ترى أن الكثير من الاعضاء يبذلون جهدا كبيرا كي يقدموا ما يقدرون عليه من حل للمشاكل التي تحدث لأي عضو من الاعضاء الذين يطرحون مشكلتهم في هذا المنتدى الرائع .

يا عزيزي ،،،

اقتباس

اقتباس

يقول المثل (اذا كان صاحبك عسل لا تآكله كله )

إحنا حاضرين للطيبين أمثالك ولا يصير خاطرك إلا طيب ,,,,,

شاكر

اعمل اجراء مثلا دبل كليك

Private Sub أمر0_Click()
TimerId = SetTimer(0, 0, 1, AddressOf TimerProc)
 str_Title = "كلمة المرور مطلوبة"
 str_Prompt = "ادخل كلمة المرور"
If InputBox(str_Prompt, str_Title) = "كلمة" Then
' اكتب هنا الإجراءات إذا كانت الكلمة صحيحة
Else
' اكتب هنا الإجراءات إذا كانت الكلمة غير صحيحة
End If
End Sub

=============

افتح وحده نمطيه

Option Compare Database

Declare Function SetTimer Lib "user32" (ByVal hWnd _
 As Long, ByVal nIDEvent As Long, ByVal uElapse _
 As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long) _
As Long
Declare Function FindWindowEx Lib "user32" _
 Alias "FindWindowExA" (ByVal hWndParent As _
 Long, ByVal hWndChildAfter As Long, ByVal _
 lpClassName As String, ByVal lpWindowName _
 As String) As Long
Declare Function Sendmessagebynum _
 Lib "user32" Alias "SendMessageA" (ByVal _
 hWnd As Long, ByVal wMsg As Long, ByVal _
 wParam As Long, ByVal lParam As Long) _
 As Long

 Const EM_SETPASSWORDCHAR = &HCC
 Public str_Title$, TimerId&

Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
 ByVal uElapse As Long, ByVal lpTimerFunc As Long)
 KillTimer 0, TimerId
 Dim lng_Hwnd&
 lng_Hwnd = FindWindowEx(0, 0, "#32770", _
  Trim(str_Title))
 lng_Hwnd = FindWindowEx(lng_Hwnd, 0, _
  "Edit", vbNullString)
 If lng_Hwnd Then
  Sendmessagebynum lng_Hwnd, EM_SETPASSWORDCHAR, 42, 0
 End If
End Sub

اخ منزر انا بعتزر

=========

انت طلبت اخ شاكر الزين

ارسل الكود انا شفت الكود

الكود ممتاز الفكره ممتازه

=============

ماعاد في مشكله

كتبت://ممتاز الله يعطيك العافيه

===============

انت عضو جديد مشاركتك رقم 38 رقم دخولك 17142

الك في القصر من مبارح العصر

انا اسمي samir_samir القديم طبعا عدد مشاركه 330

صار اسمي سمير بعلبكي الجديد عدد مشاركه 57+56 اوفيسنا

المجموع يا صاحبي 330+57+56=443 المجموع النهائي

صرت مشارك 443 مشاركه ما في حياتي وجه كلمه الى اخ في المنتدي

انا تعلمت من اخوتي في المنتدي كل الخير والمحبه نحن هنا

ما علموني ازا اخ طلب مساعد في اي شيئ انا ربحو جميله

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

في ناس ونحنا من الناس الي بحاجه للعلم في منطقه الشرق الاوسط

ما بدي احكي اكتر من هيك انا اول مره بحكي هيك

انت بعد ما عملت شئ بعدك في اول الطريق

بعتزر من الاخوه الكرام انا اسف

أخي العزيز / سمير بعلبكي

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

شاكر

أخي العزيز / سمير بعلبكي

لم أتمكن من تغيير الكلمة السرية إلى ( نجوم ) كما طلب الاخ / منذر ،، هل يوجد كود يقوم بعمل ذلك أم لأ ؟؟؟؟ في حال كتابة الكلمة السرية بدلا من ظهور أرقام أو حروف تظهر نجوم ،،،، لا تنسى أن هذا أمر ( InputBox )

وما هو القصد من الوحدة النمطية هذه

Option Compare Database
Declare Function SetTimer Lib "user32" (ByVal hWnd _
As Long, ByVal nIDEvent As Long, ByVal uElapse _
As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long) _
As Long
Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hWndParent As _
Long, ByVal hWndChildAfter As Long, ByVal _
lpClassName As String, ByVal lpWindowName _
As String) As Long
Declare Function Sendmessagebynum _
Lib "user32" Alias "SendMessageA" (ByVal _
hWnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, ByVal lParam As Long) _
As Long

Const EM_SETPASSWORDCHAR = &HCC
Public str_Title$, TimerId&

Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
KillTimer 0, TimerId
Dim lng_Hwnd&
lng_Hwnd = FindWindowEx(0, 0, "#32770", _
 Trim(str_Title))
lng_Hwnd = FindWindowEx(lng_Hwnd, 0, _
 "Edit", vbNullString)
If lng_Hwnd Then
 Sendmessagebynum lng_Hwnd, EM_SETPASSWORDCHAR, 42, 0
End If
End Sub

شاكر

أخي سمير

لم أتمكن من تركيب الكود على الوجه الصحيح ، آمل الشرح لي أكثر .

ولك تحياتي .....

شكرًا أخي سمير على حرصك .... ولدي بعض الإشكالات وهي ...

في رابط الصفحة التي اعطيتني

اضغط هنا للتوجه إليها

وبعد كود الوحدة النمطية قال /

اقتباس

وفي حدث عند نقر زر أمر اكتب :

الإشكال انه عندي في ( حدث نقر زر أمر ) يوجد أمر ماكرو لقتح النموذج (المطلوب الباس وورد له )

* لكن هل من الممكن تعديل الكود الأخير الموجود في الرابط السابق وجعل الإجراء عند كتابة الكلمة صحيحة هو فتح الماكرو .... لعلك فهمت ...صورة توضيحية لها ...

مع اعتذاري على الاشكالات ..... (وأتوقع اني اثقلت عليكم :) )

أخي سمير ... لقد تم تجاوز المشكلة ولله الحمد ... لكن لدي سؤال آخر ...

من الممكن ان يأتي شخص ويضغط على shift ويفتح ملف الاكسس ...

وبكذا يمكنه الوصول إلى الفورم ...

المطلوب / هل بالامكان تركيب الكودين السابقين على حدث (عند الفتح ) للنموذج المطلوب حمايته ؟؟؟؟؟

اتوقع العملية سهلة ...بس ما أدري كيف !!!!!!!!! أحاول انا .... ان شاء الله

7

تحياتي ... منذر

استعمل هزه الاجرات

لا الغاء الشفت

لا تفعيل الشفت

Private Sub أمر0_Click()

' لا تأثير لضغط شفت

ChangeProperty "AllowBypassKey", DB_BOOLEAN, False

' النتيجة تمكين

' خيارات بدء التشغيل

' ماكرو Autoexec

End Sub

' كلا زري الأمر يستدعيان الدالة التالية

Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant)

Dim dbs As Database, prp As Property

Const conPropNotFoundError = 3270

Set dbs = CurrentDb

On Error GoTo Change_err

dbs.Properties(strPropName) = varPropValue

ChangeProperty = True

Change_Bye:

Exit Function

Change_err:

If Err = conPropNotFoundError Then

Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)

dbs.Properties.Append prp

Resume Next

Else

ChangeProperty = False

Resume Change_Bye

End If

End Function

Private Sub أمر1_Click()

' لضغط شفت تأثير

ChangeProperty "AllowBypassKey", DB_BOOLEAN, True

' النتيجة تعطيل

' خيارات بدء التشغيل

' ماكرو Autoexec

End Sub