مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ شخابيط و افكار : مطهر النصوص و افضل حلول مشاكل التشكيل و الحركات

[ابو جودي]

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

اليوم اقدم لك وظيفة :  ( مُطَهَّرُ النُّصُوصِ الْعَرَبِيَّةِ - الإصدار الثانى  )  

باختصار بعد هذا الموضوع : 

 

 

 اداة مطهر النصوص المرنه  - FlexiTextSanitizer

الوصف:
هي أداة تهدف إلى تنظيف النصوص العربية (وغيرها) بكفاءة عالية مع دعم واسع للتخصيص.

توفر الدالة الرئيسية خيارات متعددة لمعالجة النصوص بما في ذلك

•  تطبيع الأحرف العربية
• إزالة الحركات 
• التحكم في الأرقام والأحرف الخاصة 
• إضافة أقواس تلقائية حول الأرقام 
• الاحتفاظ بالرموز الرياضية مثل √ و∑

المميزات الرئيسية:

• دعم اللغات:

1. عربية
2. لاتينية
3. أو كلاهما 

 

• التحكم في الأرقام والرموز:

1. الاحتفاظ بها
2. إزالتها
3. أو إضافة أقواس تلقائية

 

• معالجة علامات الترقيم:

1. الاحتفاظ بها كلها
2. إزالتها
3.  أو الاكتفاء بالفواصل والنقاط

 

• دعم الرموز الرياضية:  الاحتفاظ برموز مثل ∞ و≠ في الحالات المحددة

 

• التطبيع: توحيد الأحرف العربية (مثل تحويل إِ إلى ا).

 

كيف تعمل؟

المدخلات: نص خام مع خيارات اختيارية (تطبيع - لغة - معالجة - ترقيم)

المعالجة:

تطبيع الأحرف (اختياري)

إزالة الحركات

إضافة أقواس حول الأرقام (إذا طُلب)

تنظيف النص بناءً على نمط محدد

تقليص المسافات

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

 

الكود داخل الوحدة النمطية العامة
 

' تعداد لتحديد وضع اللغة
Public Enum LanguageMode
    ArabicOnly = 0      ' اللغة العربية فقط
    ArabicAndLatin = 1  ' اللغة العربية واللاتينية
    LatinOnly = 2       ' اللغة اللاتينية فقط
End Enum

' تعداد لتحديد وضع المعالجة
Public Enum ProcessingMode
    KeepAll = 0         ' الاحتفاظ بالأرقام والأحرف الخاصة
    removeNumbers = 1   ' إزالة الأرقام فقط
    KeepNumbersOnly = 2 ' الاحتفاظ بالأرقام وإزالة الأحرف الخاصة
    CleanAll = 3        ' تنظيف كامل (إزالة الأرقام والأحرف الخاصة)
    KeepBrackets = 4    ' الاحتفاظ بالأرقام والأقواس (مع إضافتها تلقائيًا)
    KeepSpecialSymbols = 5 ' الاحتفاظ بالرموز الرياضية والخاصة
End Enum

' تعداد لتحديد معالجة علامات الترقيم
Public Enum punctuationMode
    KeepAllPunctuation = 0  ' الاحتفاظ بجميع علامات الترقيم
    RemoveAllPunctuation = 1 ' إزالة جميع علامات الترقيم
    KeepBasicPunctuation = 2 ' الاحتفاظ فقط بالفواصل والنقاط (, .)
End Enum

' الدالة الرئيسية: FlexiTextSanitizer
Public Function FlexiTextSanitizer(inputText As String, Optional normalize As Boolean = False, _
                                    Optional langMode As LanguageMode = ArabicOnly, _
                                    Optional processMode As ProcessingMode = KeepAll, _
                                    Optional punctuationMode As punctuationMode = KeepAllPunctuation, _
                                    Optional customSpecialChars As String = "()،؛") As String
    On Error GoTo ErrorHandler
    
    If Nz(inputText, "") = "" Then
        FlexiTextSanitizer = ""
        Exit Function
    End If

    Dim sanitizedText As String
    sanitizedText = Trim(inputText)

    ' الخطوة 1: التطبيع إذا طُلب
    If normalize Then
        Dim charReplacementPairs As Variant
        charReplacementPairs = Array( _
            Array(ChrW(1573), ChrW(1575)), _
            Array(ChrW(1571), ChrW(1575)), _
            Array(ChrW(1570), ChrW(1575)), _
            Array(ChrW(1572), ChrW(1608)), _
            Array(ChrW(1574), ChrW(1609)), _
            Array(ChrW(1609), ChrW(1610)), _
            Array(ChrW(1577), ChrW(1607)), _
            Array(ChrW(1705), ChrW(1603)), _
            Array(ChrW(1670), ChrW(1580)))
        Dim pair As Variant
        For Each pair In charReplacementPairs
            sanitizedText = Replace(sanitizedText, pair(0), pair(1))
        Next
    End If

    ' الخطوة 2: إزالة الحركات باستخدام RegExp
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Global = True
    regEx.Pattern = "[\u064B-\u0652\u0670]" ' نطاق الحركات العربية
    sanitizedText = regEx.Replace(sanitizedText, "")

    ' إزالة علامة السؤال بشكل افتراضي
    sanitizedText = Replace(sanitizedText, "?", "")

    ' الخطوة 3: إضافة أقواس تلقائية حول الأرقام إذا طُلب (KeepBrackets)
    If processMode = KeepBrackets Then
        regEx.Pattern = "(\b[\u0660-\u0669\u0030-\u0039]+\b)" ' الأرقام العربية واللاتينية
        sanitizedText = regEx.Replace(sanitizedText, "($1)")
    End If

    ' الخطوة 4: بناء نمط الأحرف المسموح بها
    Dim allowedPattern As String
    Select Case langMode
        Case ArabicOnly
            allowedPattern = "\u0621-\u064A" ' الأحرف العربية
        Case ArabicAndLatin
            allowedPattern = "\u0621-\u064A\u0041-\u007A" ' العربية واللاتينية (A-Z, a-z)
        Case LatinOnly
            allowedPattern = "\u0041-\u007A" ' اللاتينية فقط
    End Select

    ' إضافة الأرقام والأحرف الخاصة بناءً على وضع المعالجة
    Select Case processMode
        Case KeepAll
            allowedPattern = allowedPattern & "\u0660-\u0669\u0030-\u0039" & EscapeRegExChars(customSpecialChars)
        Case removeNumbers
            allowedPattern = allowedPattern & EscapeRegExChars(customSpecialChars)
        Case KeepNumbersOnly
            allowedPattern = allowedPattern & "\u0660-\u0669\u0030-\u0039"
        Case CleanAll
            ' لا شيء يُضاف (تنظيف كامل)
        Case KeepBrackets
            allowedPattern = allowedPattern & "\u0660-\u0669\u0030-\u0039\(\)" ' الاحتفاظ بالأرقام والأقواس
        Case KeepSpecialSymbols
            allowedPattern = allowedPattern & "\u0660-\u0669\u0030-\u0039\u2200-\u22FF" ' الأرقام والرموز الرياضية
    End Select

    ' إضافة علامات الترقيم بناءً على وضع المعالجة
    Select Case punctuationMode
        Case KeepAllPunctuation
            allowedPattern = allowedPattern & "!""#$%&'()*+,-./:;<=>?@[\\]^_`{|}~،؛"
        Case RemoveAllPunctuation
            ' لا شيء يُضاف (إزالة كل علامات الترقيم)
        Case KeepBasicPunctuation
            allowedPattern = allowedPattern & ",."
    End Select

    ' إضافة المسافة دائمًا وتطبيق النمط
    regEx.Pattern = "[^" & allowedPattern & "\s]" ' إزالة كل ما هو خارج النطاق
    sanitizedText = regEx.Replace(sanitizedText, "")

    ' الخطوة 5: تقليص المسافات المتعددة إلى واحدة
    regEx.Pattern = "\s+"
    sanitizedText = regEx.Replace(sanitizedText, " ")
    sanitizedText = Trim(sanitizedText)

    ' الخطوة 6: إرجاع النتيجة
    If Len(Trim(Nz(sanitizedText, ""))) = 0 Then
        FlexiTextSanitizer = vbNullString
    Else
        FlexiTextSanitizer = sanitizedText
    End If

    Exit Function

ErrorHandler:
    Debug.Print "خطأ في FlexiTextSanitizer: " & Err.Description
    FlexiTextSanitizer = ""
End Function

' دالة مساعدة: EscapeRegExChars
Private Function EscapeRegExChars(chars As String) As String
    Dim specialChars As Variant
    Dim i As Integer
    
    specialChars = Array("^", "$", ".", "*", "+", "?", "(", ")", "[", "]", "{", "}", "|", "\\", "`", "~", "&", "%", "#", "@", "<", ">")
    
    For i = LBound(specialChars) To UBound(specialChars)
        chars = Replace(chars, specialChars(i), "\" & specialChars(i))
    Next i
    
    EscapeRegExChars = chars
End Function

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

' توثيق الموديول:
' الغرض: هذا الموديول يحتوي على دالة FlexiTextSanitizer لتنظيف النصوص بدقة وسرعة مع دعم مرن للغات (العربية واللاتينية)، الأحرف الخاصة، علامات الترقيم، والرموز الرياضية.
' يستخدم تعدادات (Enums) لتسهيل الاستدعاء وتقليل الأخطاء، ويتيح التحكم الكامل في معالجة النصوص.
'
' سيناريوهات الاستدعاء:
' 1. تنظيف النص مع الاحتفاظ بالأرقام والأحرف الخاصة وعلامات الترقيم بدون تطبيع:
'    FlexiTextSanitizer(inputText, False, ArabicOnly, KeepAll, KeepAllPunctuation)
'    - مثال الناتج: "إشراف على بعض الأماكن أو المكان رقم (5 - 5)"
' 2. تنظيف النص مع إزالة الأرقام بدون تطبيع:
'    FlexiTextSanitizer(inputText, False, ArabicOnly, RemoveNumbers, KeepAllPunctuation)
'    - مثال الناتج: "إشراف على بعض الأماكن أو المكان رقم"
' 3. تنظيف النص مع الاحتفاظ بالأرقام فقط مع تطبيع:
'    FlexiTextSanitizer(inputText, True, ArabicOnly, KeepNumbersOnly, KeepAllPunctuation)
'    - مثال الناتج: "اشراف علي بعض الاماكن او المكان رقم 5 - 5"
' 4. تنظيف كامل مع تطبيع وإزالة علامات الترقيم:
'    FlexiTextSanitizer(inputText, True, ArabicOnly, CleanAll, RemoveAllPunctuation)
'    - مثال الناتج: "اشراف علي بعض الاماكن او المكان رقم"
' 5. تنظيف النص مع الاحتفاظ بالأرقام والأقواس (تلقائية) والفواصل والنقاط مع تطبيع:
'    FlexiTextSanitizer(inputText, True, ArabicOnly, KeepBrackets, KeepBasicPunctuation)
'    - مثال الناتج: "اشراف علي, بعض الاماكن او المكان رقم (5).(5)"
' 6. تنظيف النص مع دعم العربية واللاتينية والأحرف الخاصة وعلامات الترقيم:
'    FlexiTextSanitizer(inputText, False, ArabicAndLatin, KeepAll, KeepAllPunctuation, "().,")
'    - مثال الناتج: "إشراف على بعض الأماكن أو المكان رقم (5 - 5) Supervision"
' 7. تنظيف النص مع إزالة جميع علامات الترقيم:
'    FlexiTextSanitizer(inputText, False, ArabicOnly, KeepAll, RemoveAllPunctuation)
'    - مثال الناتج: "إشراف على بعض الأماكن أو المكان رقم 5 5"
' 8. تنظيف النص مع الاحتفاظ بالفواصل والنقاط فقط:
'    FlexiTextSanitizer(inputText, False, ArabicOnly, KeepAll, KeepBasicPunctuation)
'    - مثال الناتج: "إشراف على, بعض الأماكن أو المكان رقم 5.5"
' 9. تنظيف نص يحتوي على علامات ترقيم كثيرة:
'    FlexiTextSanitizer("!!!؟؟؟...،،،:::;;;---___***((()))", False, ArabicOnly, KeepAll, KeepAllPunctuation)
'    - مثال الناتج: "!!!...،،،:::;;;---___***(())"
' 10. تنظيف نص يحتوي على رموز رياضية مع الاحتفاظ بها:
'    FlexiTextSanitizer("√∑∫∏∂∆∞ ≠ ± × ÷", False, ArabicAndLatin, KeepSpecialSymbols, RemoveAllPunctuation)
'    - مثال الناتج: "√∑∫∏∂∆∞ ≠ ± × ÷"
' 11. تطبيع جميع الأشكال الممكنة:
'    FlexiTextSanitizer("إِ، أ، إ، ؤ، ئ، ى، ة، ك، چ", True, ArabicOnly, KeepAll, KeepAllPunctuation)
'    - مثال الناتج: "ا، ا، ا، و، ي، ي، ه، ك، ج"

ولكن ملحوطة صغيرة طبعا وللاسف محرر الاكواد هنا مع الاكسس فقيير جدا بعكس لغات البرمجة الاخرى لا يقبل الرموز لذلك الرموز الرياضية مثل : √∑∫∏∂∆∞ سوف تتغير داخل المحرر الى علامات استفهام

 

والان داله يمكن اضافتها فى نهاية الكود وهى مجرد للتجربة طباعه نتائج التجربه فى النافذة الفوريه ليكون المبرمج مطلعا وملما بالنتائج
 

' اختبار الدالة مع السيناريوهات المطلوبة
Sub TestFlexiTextSanitizer()
    Dim inputText As String
    inputText = "إِشْرَافٍ      عَلَى? بَعْضِ الْأَمَاكِنِ  أَوْ الْمَكَانِ رَقْمٌ  Supervision of some places or place number 5 - 5"

    Debug.Print "النص الأصلي: " & inputText
    Debug.Print "------------------------------------"

    Debug.Print "السيناريو 1 (تنظيف، الاحتفاظ بالأرقام والأحرف الخاصة، بدون تطبيع):"
    Debug.Print FlexiTextSanitizer(inputText, False, ArabicOnly, KeepAll, KeepAllPunctuation)
    Debug.Print "------------------------------------"

    Debug.Print "السيناريو 2 (تنظيف، إزالة الأرقام، بدون تطبيع):"
    Debug.Print FlexiTextSanitizer(inputText, False, ArabicOnly, removeNumbers, KeepAllPunctuation)
    Debug.Print "------------------------------------"

    Debug.Print "السيناريو 3 (تنظيف، الاحتفاظ بالأرقام، مع تطبيع):"
    Debug.Print FlexiTextSanitizer(inputText, True, ArabicOnly, KeepNumbersOnly, KeepAllPunctuation)
    Debug.Print "------------------------------------"

    Debug.Print "السيناريو 4 (تنظيف كامل، مع تطبيع):"
    Debug.Print FlexiTextSanitizer(inputText, True, ArabicOnly, CleanAll, RemoveAllPunctuation)
    Debug.Print "------------------------------------"

    Debug.Print "السيناريو 5 (تنظيف، الاحتفاظ بالأرقام والأقواس، مع تطبيع):"
    Debug.Print FlexiTextSanitizer(inputText, True, ArabicOnly, KeepBrackets, KeepBasicPunctuation)
    Debug.Print "------------------------------------"

    Debug.Print "السيناريو 6 (العربية واللاتينية مع أحرف خاصة مخصصة والاحتفاظ بجميع علامات الترقيم):"
    Debug.Print FlexiTextSanitizer(inputText, False, ArabicAndLatin, KeepAll, KeepAllPunctuation, "().,")
    Debug.Print "------------------------------------"
    
    Debug.Print "السيناريو 7 (العربية فقط، إزالة جميع علامات الترقيم):"
    Debug.Print FlexiTextSanitizer(inputText, False, ArabicOnly, KeepAll, RemoveAllPunctuation)
    Debug.Print "------------------------------------"
    
    Debug.Print "السيناريو 8 (العربية فقط، الاحتفاظ بالفواصل والنقاط فقط):"
    Debug.Print FlexiTextSanitizer(inputText, False, ArabicOnly, KeepAll, KeepBasicPunctuation)
    Debug.Print "------------------------------------"
    
    Debug.Print "السيناريو 9 (نص يحتوي على علامات ترقيم كثيرة جدًا):"
    Debug.Print FlexiTextSanitizer("!!!؟؟؟...،،،:::;;;---___***((()))", False, ArabicOnly, KeepAll, KeepAllPunctuation)
    Debug.Print "------------------------------------"
    
    Debug.Print "السيناريو 10 (نص يحتوي على رموز رياضية ورموز خاصة):"
    Debug.Print FlexiTextSanitizer(ChrW(8730) & ChrW(8721) & ChrW(8747) & ChrW(8719) & ChrW(8706) & ChrW(8710) & ChrW(8734) & ChrW(32) & ChrW(8800) & ChrW(32) & ChrW(177) & ChrW(32) & ChrW(215) & ChrW(32) & ChrW(247), False, ArabicAndLatin, KeepSpecialSymbols, RemoveAllPunctuation)
    Debug.Print "------------------------------------"
    
    Debug.Print "السيناريو 11 (تطبيع جميع الأشكال الممكنة):"
    Debug.Print FlexiTextSanitizer("إِ، أ، إ، ؤ، ئ، ى، ة، ك، چ", True, ArabicOnly, KeepAll, KeepAllPunctuation)
    Debug.Print "------------------------------------"
End Sub