تحويل الارقام الى نجوم

[haider1430]

تحيه طيبه

كيف احول الرقم السري الى شكل نجوم

حماية نموذج.rar

[jjafferr]

وعليكم السلام 

 

احفظ هذه الوحدة النمطية:

Option Compare Database


Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias _
"GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'~~> Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long

    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If

    strClassName = String$(256, " ")
    lngBuffer = 255
    
    If lngCode = HCBT_ACTIVATE Then
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        '~~> Class name of the Inputbox
        If Left$(strClassName, RetVal) = "#32770" Then
            '~~> This changes the edit control so that it display the password character *.
            '~~> You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If

    '~~> This line will ensure that any other hooks that may be in place are
    '~~> called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
    Dim lngModHwnd As Long, lngThreadID As Long
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
End Function

 

ثم استدعها من نموذجك هكذا:

intinput = InputBoxDK("فضلاً ادخل الرقم السري", "دخول")

 

جعفر

وتفضل المرفق بعد اضافة الكود فيه

456.حماية نموذج.mdb.zip

[haider1430]

شكرا لسرعة تجاوبك لكن هل بلامكان ان ان تضيفها بالمرفق اذا ما عليك امر

[jjafferr]

تم اضافة المرفق الى مشاركتي السابقة 

 

جعفر

[haider1430]

ما شالله عليك 

يسلموووووووا

[kamel2711]

سلام عليكم  

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

 هناك طريقة سهلة  لدخول الى قاعدة بيانات مع التشفير  chiffrer une base de donneés

 1_ في بداية  قم بفتخ القاعدة بةاسطة   

2- احتر   Chiffrer avec mot de passe.   ثم ادخل الاسم المراد  سيتحول الى نجوم 

وشكرا لكم   

[haider1430]

هل بالامكان كتابتها بالعربي او الانجليزي

2- احتر   Chiffrer avec mot de passe.   ثم ادخل الاسم المراد  سيتحول الى نجوم 

وشكرا لمرورك

[kamel2711]

سلام عليكم  

تحية  خاصة الى الاستاذو  الاخ جعفر و  الاستاذ على المصري  والى الاصدقاء المنتدى الرائع و المفيد   أما بعد

 محاولتي في  تحويل  الحروف الى   (*****)    في كلمة السر 

الكود يوضح دلك مع انشاء جدول خاص  يتضمن pass   login    في قاعدة  وليكن Table2

ولفتح النمودج table1

 

Private Sub Commande1_Click()            كود خاص بالزر         
Dim db As Database
Dim rs As Recordset
Dim password As String

Set db = CurrentDb
Set rs = db.OpenRecordset("select pass from Table2 where login = '" & Me.login & "'")
With rs
If Not .EOF Then
password = !pass
If password = Me.pass Then
DoCmd.OpenForm ("Table1")
Else
MsgBox ("PASSWORD INCORECT")
Exit Sub
End If
Else
MsgBox ("PASSWORD INCORECT")
Exit Sub
End If
End With
rs.Close
db.Close
End Sub

 

 

[kamel2711]

سلام  عليكم

اليكم  المثال الدي يوضح دلك

 

Nouveau Archive WinRAR ZIP.zip

[فقير ومشتري الدنيه بضحكتي]

يمكنك ذلك وبدون اكواد 

من خصائص حقل مربع النص نختار خاصية بيانات - قناع الادخال - اختر قناع الادخال على شكل كلمة مرور .