توليد ارقام وحروف عشوائية فريد لكل سجل عند تحديث التاريخ

**محمد التميمي** · ديسمبر 30, 2024

السلام عليكم:

طيب الله اوقاتكم بكل خير .....

في الملف المرفق لدي مربعين نص مخصصين الاول لتاريخ الاصدار والثاني لتاريخ النفاد (الانتهاء) وضعت كود بسيط بعد التحديث في تاريخ الاصدار ليصنع لي تاريخ نفاد بعد سنة بشكل تلقائي بمجرد ادخال تاريخ اصدار.

المطلوب اخواني الكرام::

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

علما اني بحثت في المنتدى ووجت امثلة ولكن لاتتطابق مع ما اوريد.

مع فائق الشكر والتقدير ...

New.accdbFetching info...

تم تعديل ديسمبر 30, 2024 بواسطه محمد التميمي

**ابو جودي** · ديسمبر 30, 2024

طلبك موجود هنا وأكثر

**محمد التميمي** · ديسمبر 30, 2024

في 30‏/12‏/2024 at 17:33, ابو جودي said:

طلبك موجود هنا وأكثر

Expand

السلام عليكم ابا جودي الغالي

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

تم تعديل ديسمبر 30, 2024 بواسطه محمد التميمي

**ابو جودي** · ديسمبر 30, 2024

للاسف لن استطيع فتح او التعامل مع اى قواعد بيانات فى الوقت الراهن

بس ان شاء الله ابشر

**محمد التميمي** · ديسمبر 30, 2024

في 30‏/12‏/2024 at 18:46, ابو جودي said:

للاسف لن استطيع فتح او التعامل مع اى قواعد بيانات فى الوقت الراهن

بس ان شاء الله ابشر

Expand

تسلم ياغالي ماقصرت

**ابو جودي** · ديسمبر 30, 2024

في 30‏/12‏/2024 at 18:47, محمد التميمي said:

تسلم ياغالي ماقصرت

Expand

الله يسلمك

شوف نظريا كده دى الاجابة

اعمل وحدة نمطية جديدة فى قاعدة البيانات بتاعتك واعطها مثلا الاسم : basGeneratorPassword
وضع بها الاكواد الاتية ...

Public Const DefaultLength As Integer = 10
Public Const DefaultSpecialChars As String = "'?,./<>|\[]{}:;#$%&()*+-@_""" & "!`~@#$%^&*()=€¥»«©®™°¢£•÷×¶"


Public Function GeneratePassword( _
                                    Optional Length As Integer = DefaultLength, _
                                    Optional bNumeric As Boolean = True, _
                                    Optional bUpperAlpha As Boolean = True, _
                                    Optional bLowerAlpha As Boolean = True, _
                                    Optional bSpecialChr As Boolean = True, _
                                    Optional sSpecialChr As String = DefaultSpecialChars) 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
    Dim sGeneratedPwd As String
    Const sModName = "modGeneratorPassword"

    ' Initialize array
    ReDim AllowedChars(0)

    ' Numeric
    If bNumeric Then
        For i = 48 To 57
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Uppercase Alphabet
    If bUpperAlpha Then
        For i = 65 To 90
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Lowercase Alphabet
    If bLowerAlpha Then
        For i = 97 To 122
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Special Characters
    If bSpecialChr And Trim(sSpecialChr) <> "" Then
        For i = 1 To Len(sSpecialChr)
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = Asc(Mid$(sSpecialChr, i, 1))
        Next i
    End If

    ' Generate Password
    Randomize
    iNoAllowedChars = UBound(AllowedChars)
    For i = 1 To DefaultLength
        iRndChar = Int((iNoAllowedChars - 1) * Rnd + 1)
        sGeneratedPwd = sGeneratedPwd & Replace(Chr(AllowedChars(iRndChar)), "'", "''")
    Next i

    GeneratePassword = sGeneratedPwd

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

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

End Function

الان انظر فى الحدث الذى تريد استدعاء الداله فيه وليكن مثلا بعد تحديث التاريخ حقل التاريخ ضع اسفل الاكواد التى استخدمتها هذه الاكواد

    If IsNull(Me.TextBoxNameOnForm) Or Me.TextBoxNameOnForm = "" Then
        Dim strRandomNumber As String
        strRandomNumber = GeneratePassword(8, True, True, True, False)
    
        Dim intRandomNumber As Integer
        intRandomNumber = DCount("FieldNameInTable", "TableName", "FieldNameInTable = '" & Replace(strRandomNumber, "'", "''") & "'")
        
        If intRandomNumber > 0 Then
            strRandomNumber = GeneratePassword(8, True, True, True, False)
        End If
    
        Me.TextBoxNameOnForm = strRandomNumber
    Else
    End If

الان فقط غير فى كود الاستدعاء التالى :

اسم مربع النص والذى تريد اظهار الرموز العشوائية بداخله و الموجود على النموذج بدلا من: Me.TextBoxNameOnForm
وغير اسم الجدول بدلا من : TableName
وغير اسم الحقل داخل الجدول والخاص بالرموز العشوائية بدلا من : FieldNameInTable

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

ملاحظة اضافيه ان اردت الرموز العشوائية تحتوى على رموز بجانب الارقام والاحرف الكبيرة والصغيرة فقط استدع الدالة بالشكل التالى

strRandomNumber = GeneratePassword(8, True, True, True, True)

**Foksh** · ديسمبر 30, 2024

في 30‏/12‏/2024 at 18:46, ابو جودي said:

للاسف لن استطيع فتح او التعامل مع اى قواعد بيانات فى الوقت الراهن

Expand

بعد أذن صاحب السعادة .. :wub:

مشاركة جانبية ، لكنها ليست بحجم مشاركة الهندسة @ابو جودي ..

جرب هذا الكود مع الدالة :-

Private Sub Date1_AfterUpdate()
Date2 = DateAdd("yyyy", 1, Date1)
    Dim expirationDate As Date
    Dim randomString As String
    expirationDate = DateAdd("yyyy", 1, Me.Date1.Value)
    Me.Date2.Value = expirationDate
    randomString = GenerateRandomString(8)
    Me.random_number = randomString
    Me.Dirty = False
End Sub

Private Function GenerateRandomString(length As Integer) As String
    Dim chars As String
    Dim i As Integer
    Dim result As String
    chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    result = ""
    For i = 1 To length
        result = result & Mid(chars, Int((Len(chars) * Rnd) + 1), 1)
    Next i
    GenerateRandomString = result
End Function

وجرب غير السنة في الحقل تاريخ الاصدار

New.accdbFetching info...

**محمد التميمي** · ديسمبر 30, 2024

في 30‏/12‏/2024 at 19:20, ابو جودي said:
الله يسلمك

شوف نظريا كده دى الاجابة

اعمل وحدة نمطية جديدة فى قاعدة البيانات بتاعتك واعطها مثلا الاسم : basGeneratorPassword
وضع بها الاكواد الاتية ...
Public Const DefaultLength As Integer = 10
Public Const DefaultSpecialChars As String = "'?,./<>|\[]{}:;#$%&()*+-@_""" & "!`~@#$%^&*()=€¥»«©®™°¢£•÷×¶"


Public Function GeneratePassword( _
                                    Optional Length As Integer = DefaultLength, _
                                    Optional bNumeric As Boolean = True, _
                                    Optional bUpperAlpha As Boolean = True, _
                                    Optional bLowerAlpha As Boolean = True, _
                                    Optional bSpecialChr As Boolean = True, _
                                    Optional sSpecialChr As String = DefaultSpecialChars) 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
    Dim sGeneratedPwd As String
    Const sModName = "modGeneratorPassword"

    ' Initialize array
    ReDim AllowedChars(0)

    ' Numeric
    If bNumeric Then
        For i = 48 To 57
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Uppercase Alphabet
    If bUpperAlpha Then
        For i = 65 To 90
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Lowercase Alphabet
    If bLowerAlpha Then
        For i = 97 To 122
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = i
        Next i
    End If

    ' Special Characters
    If bSpecialChr And Trim(sSpecialChr) <> "" Then
        For i = 1 To Len(sSpecialChr)
            ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
            AllowedChars(UBound(AllowedChars)) = Asc(Mid$(sSpecialChr, i, 1))
        Next i
    End If

    ' Generate Password
    Randomize
    iNoAllowedChars = UBound(AllowedChars)
    For i = 1 To DefaultLength
        iRndChar = Int((iNoAllowedChars - 1) * Rnd + 1)
        sGeneratedPwd = sGeneratedPwd & Replace(Chr(AllowedChars(iRndChar)), "'", "''")
    Next i

    GeneratePassword = sGeneratedPwd

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

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

End Function
الان انظر فى الحدث الذى تريد استدعاء الداله فيه وليكن مثلا بعد تحديث التاريخ حقل التاريخ ضع اسفل الاكواد التى استخدمتها هذه الاكواد
    If IsNull(Me.TextBoxNameOnForm) Or Me.TextBoxNameOnForm = "" Then
        Dim strRandomNumber As String
        strRandomNumber = GeneratePassword(8, True, True, True, False)
    
        Dim intRandomNumber As Integer
        intRandomNumber = DCount("FieldNameInTable", "TableName", "FieldNameInTable = '" & Replace(strRandomNumber, "'", "''") & "'")
        
        If intRandomNumber > 0 Then
            strRandomNumber = GeneratePassword(8, True, True, True, False)
        End If
    
        Me.TextBoxNameOnForm = strRandomNumber
    Else
    End If
الان فقط غير فى كود الاستدعاء التالى :

اسم مربع النص والذى تريد اظهار الرموز العشوائية بداخله و الموجود على النموذج بدلا من: Me.TextBoxNameOnForm
وغير اسم الجدول بدلا من : TableName
وغير اسم الحقل داخل الجدول والخاص بالرموز العشوائية بدلا من : FieldNameInTable

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

ملاحظة اضافيه ان اردت الرموز العشوائية تحتوى على رموز بجانب الارقام والاحرف الكبيرة والصغيرة فقط استدع الدالة بالشكل التالى
strRandomNumber = GeneratePassword(8, True, True, True, True)
احسنت احسنت استاذي الغالي ابا جودي بارك الله بك وجعله الله في ميزان حسناتك

اشتغل الكود بشكل جيد بعد ما وضعته مستقل في زر امر ..... شكرا شكرا
Expand

New.accdbFetching info...

في 30‏/12‏/2024 at 19:43, Foksh said:
بعد أذن صاحب السعادة ..

مشاركة جانبية ، لكنها ليست بحجم مشاركة الهندسة @ابو جودي ..

جرب هذا الكود مع الدالة :-
Private Sub Date1_AfterUpdate()
Date2 = DateAdd("yyyy", 1, Date1)
    Dim expirationDate As Date
    Dim randomString As String
    expirationDate = DateAdd("yyyy", 1, Me.Date1.Value)
    Me.Date2.Value = expirationDate
    randomString = GenerateRandomString(8)
    Me.random_number = randomString
    Me.Dirty = False
End Sub

Private Function GenerateRandomString(length As Integer) As String
    Dim chars As String
    Dim i As Integer
    Dim result As String
    chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    result = ""
    For i = 1 To length
        result = result & Mid(chars, Int((Len(chars) * Rnd) + 1), 1)
    Next i
    GenerateRandomString = result
End Function
وجرب غير السنة في الحقل تاريخ الاصدار

New.accdb 476 kB · 2 downloads
Expand

شكرا جزيلا اخي الكريم Foksh ر على المرور اجابة الاستاذ ابا جودي مبهرة

**Foksh** · ديسمبر 30, 2024

في 30‏/12‏/2024 at 19:55, محمد التميمي said:

اجابة الاستاذ ابا جودي مبهرة

Expand

لا شك في ذلك يا صديقي ، ولهذا السبب ارجو ان تنسب افضل إجابة للمشاركة التي حلت المشكلة وليس تعليقك السابق :wink2:

تسجيل الدخول

توليد ارقام وحروف عشوائية فريد لكل سجل عند تحديث التاريخ

الردود الموصى بها

محمد التميمي

ابو جودي

محمد التميمي

ابو جودي

محمد التميمي

ابو جودي

Foksh

محمد التميمي

Foksh

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information