برنامج لانشاء كلمات سر

[أبو امين]

السلام عليكم و رحمة الله و بركاته استذتي الافاضل : 

هل بالامكان انشاء برنامج بالاكساس لتكوين كلمات سر .

[ابو جودي]

اتفضل استخدم الكود الاتى فى وحدة نمطية

Public Function OfficenaGeneratePwd(Optional iNoChars As Integer = 10, _
                                    Optional bNumeric As Boolean = True, _
                                    Optional bUpperAlpha As Boolean = True, _
                                    Optional bLowerAlpha As Boolean = True, _
                                    Optional bSpecialChr As Boolean = True, _
                                    Optional sSpecialChr As String = "'?,./<>|\[]{}:;#$%&()*+-@_""" & "!`~@#$%^&*()=€¥»«©®™°¢£•÷׶")

On Error GoTo Error_Handler

  Dim AllowedChars()  As Variant
  Dim iCounter        As Integer
  Dim i               As Integer
  Dim iRndChar        As Integer
  Dim iNoAllowedChars As Long
  Const sModName = "modGeneratorPassword"
  
  'Initialize our array otherwise it throws an error
  ReDim Preserve AllowedChars(0)
  AllowedChars(0) = ""
  
  'Numeric
  If bNumeric = True Then
    For i = 48 To 57
      iCounter = UBound(AllowedChars)
      ReDim Preserve AllowedChars(iCounter + 1)
      AllowedChars(iCounter + 1) = i
    Next i
  End If
  
  'Uppercase Alphabet
  If bUpperAlpha = True Then
    For i = 65 To 90
      ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
      iCounter = UBound(AllowedChars)
      AllowedChars(iCounter) = i
    Next i
  End If
  
  'Lowercase Alphabet
  If bLowerAlpha = True Then
    For i = 97 To 122
      ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
      iCounter = UBound(AllowedChars)
      AllowedChars(iCounter) = i
    Next i
  End If
  
  'Special Characters
  If bSpecialChr = True Then
    If Trim(sSpecialChr) <> "" Then
      For i = 1 To Len(sSpecialChr)
        ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
        iCounter = UBound(AllowedChars)
        AllowedChars(iCounter) = Asc(Mid$(sSpecialChr, i, 1))
      Next i
    End If
  End If
  
  'Generate Password
  iNoAllowedChars = UBound(AllowedChars)
  For i = 1 To iNoChars
    iRndChar = Int((iNoAllowedChars * Rnd) + 1)
    OfficenaGeneratePwd = OfficenaGeneratePwd & Replace(Chr(AllowedChars(iRndChar)), "'", "''")
  Next i


Error_Handler_Exit:
  On Error Resume Next
Exit Function

Error_Handler:
  MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
  "Error Number: " & Err.Number & vbCrLf & _
  "Error Source: " & sModName & "/OfficenaGeneratePwd" & vbCrLf & _
  "Error Description: " & Err.Description, _
  vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit

End Function

 

يتم استدعاء الكود كالاتى 

OfficenaGeneratePwd(10, true, true,True,True)

الرقم 10 طول السلسلة النصية المكونة للباسورد >>---> طبعا يمكن تغيره حسب حاجتكم
الـ True  الاولى لاستخدام الأرقام لو لا تريد استخدام الأرقام اجعلها False
الـ True  الثانية لاستخدام الحروف الكابيتال لو لا تريد استخدام الحروف الكابيتال اجعلها False
الـ True  الثالثة لاستخدام الحروف الاسمول لو لا تريد استخدام الحروف الاسمول اجعلها False
الـ True  الرابعة لاستخدام الرموز الخاصة لو لا تريد استخدام الرموز الخاصة اجعلها False
انا وضعت بالكود الرموز الخاصة جاهزة والتى تناسبنى ولكن انا لا اجبر المستخدم على استخدام الكود كما هو جعلت مرونة فى الكود بحيث يمكن للمستخدم وضع الرموز فقط التى يفضلها 
على سبيل المثال نريد استخدام الرموز الاتية فقط -+*/ يكون استدعاء الكود بالشكل الاتى 

OfficenaGeneratePwd(10, true, true, True, True, "-+*/")

 

[ابو جودي]

وهذا تطبيق مبدئى 

GeneratorPassword.accdb

[أبو امين]

جعله الله في ميزان حسناتك استاذ 

[Moosak]

9 ساعات مضت, ابو جودي said:

اتفضل استخدم الكود الاتى فى وحدة نمطية

الحمدلله على سلامتك حبيبنا @ابو جودي 🙂 🌹

عودا حميدا .. ومطول الغيبات جايب الغنايم 😄

 

ورجعت معاك الحياة للمكتبة الغانمة ☺️👌🏼

[ابو جودي]

15 دقائق مضت, derbali ammar said:

جعله الله في ميزان حسناتك استاذ 

جزاكم الله خيــرا 

انتظر قريبا ان شاء الله اهديكم تطبيق بأفكار عديده متنوعه

1 دقيقه مضت, Moosak said:

الحمدلله على سلامتك حبيبنا @ابو جودي 🙂 🌹

عودا حميدا .. ومطول الغيبات جايب الغنايم 😄

ورجعت معاك الحياة للمكتبة الغانمة ☺️👌🏼

الله يسلمكم ويحفظكم ويبارك بأعماركم 
اعتذر كثيرا على غيابى... ولكنها ظرزف خراج إرادتى 

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

[Moosak]

8 دقائق مضت, ابو جودي said:

اعتذر كثيرا على غيابى... ولكنها ظرزف خراج إرادتى 

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

عذرك معك حبيب الملايين 🙂 وكلنا مقدرين ..

 

وبانتظار مفاجآتك الحلوة اللي عودتنا عليها ☺️