إخفاء الرقم السري

[gelani]

السلام عليكم ورحمة الله وبركاته 

اريد إخفاء الرقم السري على هيئة نجوم . مع التطبيق على المرفق .

مع اطيب تحيه للجميع.

 

اخفاء الرقم السري.accdb

[محمد أبوعبدالله]

وعليكم السلام ورحمة الله وبركاته

تفضل اخي الكريم

ضع هذا الكود في وحدة نمطية

Option Compare Database

Private Declare Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long
    
Private Declare Function FindWindowEx Lib "user32" Alias _
  "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
   ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
       
Public Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
   lpTimerFunc&)
    
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&)
    
Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long
    
' Constants for API set A
Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&

Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
                          ByVal lIDEvent&, ByVal lDWTime&) As Long

' This function allows for a mask character on an inputbox
'
' Usage (Replace anything between [] with valid names from your project):
'  From a form or module:
'  1. Declare a Long variable
'  2. Call the timer function:  [variable] = SetTimer([form].Hwnd, NV_INPUTBOX, [elapsed time], AddressOf [function name])
'  2b. Example usage from a form: lTemp = SetTimer(Me.Hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
'  3. Create your InputBox as usual

    Dim lEditHwnd As Long

    ' Find a handle to the InputBox window, then to the textbox
    ' the user types in (Known as "Edit")
    '
    ' **This part is VERY important, here is how the FindWindowEx call should look:
    ' **Only change the parameters that are enclosed in [ ] in the following example
    '
    ' [variable] = FindWindowEx(FindWindow("#32770", "[caption of your InputBox]"), 0, "Edit", "")
    '
    lEditHwnd = FindWindowEx(FindWindow("#32770", "Security Dialogue"), 0, "Edit", "")

    ' Send the mask character to the target InputBox when the user types
    ' The mask character in this sample is the Asc("*") - the "*" can be changed
    ' to whatever you like.
    Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)

    ' Destroy the timer object when done (The user clicks OK or Cancel from the InputBox)
    KillTimer lHwnd, lIDEvent

End Function

وهذا الكود في النموذج

    Dim lTemp As Long
    Dim sTemp As String
    Dim X As String
    X = "1234"


    lTemp = SetTimer(Me.hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
    sTemp = InputBox("ادخل الرقم السري", "Security Dialogue")

    If X = sTemp Then
    MsgBox "ok"
    Else
    DoCmd.Close acForm, Me.Form.Name, acSavePrompt
    End If

Up+اخفاء الرقم السري.rar

تحياتي

[jjafferr]

السلام عليكم 🙂 

 

وهذه طريقة اخرى ، للنواتين 32 و 64بت :

 

.

 

او ايش رايك في كلمة سر متغيرة ، يعني مافي داعي تخاف احد يشوفها ، لأنها تتغير دائماً كل دقيقة 🙂 

 

جعفر

[gelani]

السلام عليكم ورحمة الله وبركاته 

عند تشغيل  الكود تظهر معي الرسالة التالية حيث انني استخدم اكسس 64 بت . كيف الخلاص من هذه المشكلة حفظكم الله .

ارجو الاطلاع شاكرا ومقدرا لكم تعاونكم .

[محمد أبوعبدالله]

وعليكم السلام ورحمة الله وبركاته

8 ساعات مضت, gelani said:

عند تشغيل  الكود تظهر معي الرسالة التالية حيث انني استخدم اكسس 64 بت

ليعمل الكود على 32 و 64 بت معاً تعامل مع الكود بالشكل التالي

 #If VBA7 Then 
 Declare PtrSafe Sub... 
 #Else 
 Declare Sub... 
 #EndIf

وبذلك يمكن تعديل الوحدة النمطية كالتالي

Option Compare Database

 #If VBA7 Then
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias _
  "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
   ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
       
Public Declare PtrSafe Function SetTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
   lpTimerFunc&)
    
Private Declare PtrSafe Function KillTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&)
    
Private Declare PtrSafe Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long
 
 #Else
 
Private Declare Function FindWindowEx Lib "user32" Alias _
  "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
   ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
       
Public Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal _
   lpTimerFunc&)
    
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&)
    
Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long
 
 #End If
 
 
 
Private Declare Function FindWindow Lib "user32" Alias _
   "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long
    
    
' Constants for API set A
Const EM_SETPASSWORDCHAR = &HCC
Public Const NV_INPUTBOX As Long = &H5000&

Public Function TimerProc(ByVal lHwnd&, ByVal uMsg&, _
                          ByVal lIDEvent&, ByVal lDWTime&) As Long

' This function allows for a mask character on an inputbox
'
' Usage (Replace anything between [] with valid names from your project):
'  From a form or module:
'  1. Declare a Long variable
'  2. Call the timer function:  [variable] = SetTimer([form].Hwnd, NV_INPUTBOX, [elapsed time], AddressOf [function name])
'  2b. Example usage from a form: lTemp = SetTimer(Me.Hwnd, NV_INPUTBOX, 1, AddressOf TimerProc)
'  3. Create your InputBox as usual

    Dim lEditHwnd As Long

    ' Find a handle to the InputBox window, then to the textbox
    ' the user types in (Known as "Edit")
    '
    ' **This part is VERY important, here is how the FindWindowEx call should look:
    ' **Only change the parameters that are enclosed in [ ] in the following example
    '
    ' [variable] = FindWindowEx(FindWindow("#32770", "[caption of your InputBox]"), 0, "Edit", "")
    '
    lEditHwnd = FindWindowEx(FindWindow("#32770", "Security Dialogue"), 0, "Edit", "")

    ' Send the mask character to the target InputBox when the user types
    ' The mask character in this sample is the Asc("*") - the "*" can be changed
    ' to whatever you like.
    Call SendMessage(lEditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)

    ' Destroy the timer object when done (The user clicks OK or Cancel from the InputBox)
    KillTimer lHwnd, lIDEvent

End Function

 

Up+اخفاء الرقم السري.rar

تحياتي

[gelani]

اشكركم جزيل الشكر على الرد وللأسف عند تشغيل المرفق تظهر الرسالة التالية .

 

[محمد أبوعبدالله]

تفضل اخي الكريم

Up+اخفاء الرقم السري.rar

تحياتي

[د.كاف يار]

مشاركة مع الاخوة

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

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

 

او اقتراح اخر

عرف متغيير من نوع String

و في حدث بعد التحديث اجعل قيمة المتغيير هي عنصر تحكم كلمة المرور

و بعد اعطاء القيمة للمتغيير يتم اعطاء قيمة اخرى لعنصر التحكم كما تريد علامة النجوم

تم تعديل سبتمبر 3, 2020 بواسطه د.كاف يار

[gelani]

مساء الخير 

أشكركما على تعاونكما وأسأل الله لكم التوفيق .

بالنسبة للملف المرفق ظهرت معي الرسالة التالية .

وبالنسبة لقناع الإدخال سأحاول ولو ان خبرتي قليله في هذا الشأن .فهل من شرح  لهذا الموضوع او التطبيق على الملف المرفق .

وحقيقة كانت الأمور ماشية معي تمام الى ان اشتريت الأوفيس النسخة الأصلية 2019  64بت وبدأت اعاني من الكثير من المشاكل .

اكرر شكري لكما مع اطيب تحياتي وتقديري 

[jjafferr]

في ٢‏/٩‏/٢٠٢٠ at 15:58, jjafferr said:

وهذه طريقة اخرى ، للنواتين 32 و 64بت :

هل جربت هذا الموضوع ؟

 

جعفر

[gelani]

مساء الخير

جربت كل الطرق ولم اتوصل الى حل طبعا لقلة خبرتي .

[jjafferr]

تفضل 🙂 

 

جعفر

اخفاء الرقم السري.zip

[gelani]

السلام عليكم ورحمة الله وبركاته 

اشكر تفضلكم بالرد والمثال يعمل بشكل رائع وعند تطبيقه على برامج أخرى ظهرت لي الرسالة التالية واذا حذفت حرفي DK من آخر الكلمة يعمل ويظهر الرقم السري .

قمت باستدعاء جميع الجداول والاستعلامات والنماذج الى الملف المرفق من سعادتكم وتظهر نفس الرسالة .( الأوفيس عندي 64 بت ) 

اكرر شكري للجميع 

[jjafferr]

اخي الفاضل ، لا يكفي ان تنقل هذه الجزئية فقط الى برنامجك ، فهناك وحدة نمطية اسمها  ويجب نقلها كذلك الى برنامجك الآخر 🙂 

 

 

جعفر

[gelani]

حفظك الله .

لم اغفل عن ذلك استوردت الوحدة النمطية وظهرت نفس الرسالة .

وفي محاولة أخرى قمت باستيراد الجداول والاستعلامات والنماذج وكافة محتويات قاعدة البيانات الى ملف الأكسس المرسل من سعادتكم ( وهو يعمل بشكل رائع ) وبعد التشغيل تظهر الرسالة المشار الها سابقا .
وكما أشرت سابقا ان المشكلة بدأت معي بعد شراء نسخة اوفيس اصليه 64 بت .

ارجو ان لا اكون ازعجتكم .

شاكرا ومقدرا لكم اهتمامكم .

[jjafferr]

 

هذه الرسالة لا علاقة لها بأي من انواع الاكسس ، فهي تقول :

 

بأن البرنامج لم يحصل على الوحدة النمطية InputBoxDK في برنامجك !!

 

 اذا ممكن ترفق لنا برنامجك ، او ترفعه الى احد مواقع الرفع واعطاءنا الرابط 🙂

 

جعفر