أتمتة عمليات الضغط شخابيط و أفكار :أتمتة عمليات الضغط وفك الضغط للملفات و المجلدات (WinRAR / Seven Zip )

[ابو جودي]

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

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

باستخدام أدوات شائعة مثل WinRAR و7-Zip  لأتمتة عمليات الضغط وفك الضغط للملفات و المجلدات بإحترافيه ومرونه وتحكم شامل

فيما يلي نبذة عن الخصائص والمميزات والإمكانيات العامة للكود :

• يدعم ضغط الملفات وفك ضغطها باستخدام كل من WinRAR و7-Zip مما يتيح للمستخدم اختيار الأداة المناسبة بناء على احتياجاته
• يقبل المدخلات على شكل سلسلة نصية واحدة أو مصفوفة تحتوي على عدة ملفات أو مجلدات
• يحدد تلقائيا مسارات البرامج من سجل النظام أو المسارات الافتراضية مع خيار يدوي كبديل
• يستخدم ترميز Unicode في ملفات التعليق لدعم النصوص العربية وغيرها من اللغات
• يوفر 6 مستويات (من بدون ضغط إلى أقصى ضغط ) للتحكم في التوازن بين السرعة وحجم الملف
• يدعم تقسيم الأرشيف إلى أجزاء بأحجام مختلفة (50 ميجابايت إلى 2 جيجابايت)
• يتيح إضافة كلمة مرور للأرشيفات مع تشفير أسماء الملفات
• أرشيفات ذاتية الاستخراج (SFX): يمكن إنشاء ملفات تنفيذية (exe) لا تحتاج إلى برنامج لفك الضغط
• التعليقات: يدعم إضافة تعليقات نصية للأرشيفات في WinRAR
• إدارة عمليات متعددة: ضغط وفك ضغط عدة ملفات في استدعاء واحد أو عبر حلقات ( مصفوفات )
• يحتوي على معالجة أخطاء شاملة مع رسائل توضيحية (مثل أخطاء المعاملات أو الملفات غير الموجودة)
• التخصيص:يسمح بتحديد اسم الأرشيف - المسار الهدف - ونوع الأرشيف (RAR/ZIP/7z) حسب رغبة المستخدم

سيناريوهات الاستخدام

 

• ضغط التقارير أو المستندات الكبيرة وتوزيعها بسهولة
• إنشاء أرشيفات محمية بكلمة مرور أو ذاتية الاستخراج لمشاركة الملفات
• دمج الكود في تطبيقات إدارية لتبسيط عمليات النسخ الاحتياطي أو الأرشفة

نقاط القوة

• سهولة الاستخدام: يمكن تصميم واجهة بسيطة مع معاملات اختيارية ذات قيم افتراضية منطقية
• الأداء: يعتمد على أدوات مثبتة مثل WinRAR و7-Zip لضمان السرعة والكفاءة
• التوثيق: الاهتمام بالتعليقات الشاملة داخل الكود لتسهيل فهم الكود وصيانته

القيود النظرية

• يتطلب تثبيت WinRAR أو 7-Zip مسبقا
• بعض الميزات (مثل التعليقات) مدعومة فقط في WinRAR

 

مبدئيا الأفكار والأكواد حتى الآن قيد التجربــــــه 
من أجل ذلك : فى حال وقوع اى مشاكل عند التجارب برجاء إخبارى فورا .. ولكم جزيل الشكر 

وأخيـــــــــرا الكــــــــــــــود
الكود داخل وحده نمطية عامة باسم : basArchiveUtility

' يضمن مقارنة النصوص بناءً على إعدادات قاعدة البيانات (مثل ترتيب الحروف واللغة)
Option Compare Database
' يجبر على تعريف المتغيرات صراحة قبل استخدامها، مما يمنع الأخطاء الناتجة عن الأسماء الخاطئة
Option Explicit

' تعريف تعداد لمستويات الضغط المدعومة
Enum EnumCompressionLevel
    CompressionNone = 0     ' بدون ضغط (تخزين فقط)
    CompressionFastest = 1  ' أسرع ضغط (حجم أكبر، سرعة عالية)
    CompressionFast = 3     ' ضغط سريع (توازن بين السرعة والحجم)
    CompressionNormal = 5   ' ضغط عادي (الافتراضي في معظم الأدوات)
    CompressionMaximum = 7  ' ضغط أقصى (حجم أصغر، أبطأ)
    CompressionUltra = 9    ' ضغط فائق (أقصى تقليص للحجم، أبطأ جدًا)
End Enum

' تعريف تعداد لخيارات تقسيم حجم الأرشيف لدعم تقسيم الملفات الكبيرة
Enum EnumSplitSizeOption
    ' بدون تقسيم (أرشيف واحد)
    SplitNone = 0
    ' تقسيم إلى أجزاء بحجم 50 ميجابايت
    Split50MB = 50
    ' تقسيم إلى أجزاء بحجم 100 ميجابايت
    Split100MB = 100
    ' تقسيم إلى أجزاء بحجم 200 ميجابايت
    Split200MB = 200
    ' تقسيم إلى أجزاء بحجم 500 ميجابايت
    Split500MB = 500
    ' تقسيم إلى أجزاء بحجم 1 جيجابايت
    Split1GB = 1000
    ' تقسيم إلى أجزاء بحجم 2 جيجابايت
    Split2GB = 2000
End Enum

' تعريف تعداد لأوضاع الكتابة فوق الملفات الموجودة مسبقًا
Enum EnumOverwriteMode
    ' عدم الكتابة فوق الملفات (تجاهل العملية إذا وجد الملف)
    OverwriteNone = 0
    ' طلب تأكيد من المستخدم عند وجود ملف
    OverwritePrompt = 1
    ' الكتابة فوق جميع الملفات الموجودة تلقائيًا
    OverwriteAll = 2
End Enum

' تعريف تعداد لتحديد أداة الأرشفة المستخدمة
Enum EnumArchiveMethod
    ' استخدام WinRAR كأداة ضغط
    WinRAR = 0
    ' استخدام 7-Zip كأداة ضغط
    SevenZip = 1
End Enum


' تعريف تعداد لأنواع الأرشيف المدعومة
Enum EnumArchiveType
    ' أرشيف بصيغة RAR (شائعة الاستخدام مع WinRAR)
    ArchiveRAR = 0
    ' أرشيف بصيغة ZIP (صيغة قياسية مدعومة على نطاق واسع)
    ArchiveZIP = 1
    ' أرشيف بصيغة 7z (صيغة مفتوحة المصدر توفر ضغطًا عاليًا مع 7-Zip)
    Archive7z = 2
    ' أرشيف بصيغة TAR (يستخدم عادة في أنظمة Unix/Linux لتجميع الملفات بدون ضغط)
    ArchiveTAR = 3
    ' أرشيف بصيغة GZ (Gzip، ضغط فعال لملف واحد)
    ArchiveGZ = 4
    ' أرشيف بصيغة BZIP2 (ضغط قوي مشابه لـ GZ ولكن بكفاءة أعلى في بعض الحالات)
    ArchiveBZ2 = 5
    ' أرشيف بصيغة XZ (صيغة حديثة توفر ضغطًا عاليًا، مدعومة بواسطة 7-Zip وأدوات أخرى)
    ArchiveXZ = 6
    ' أرشيف بصيغة ISO (صورة قرص مضغوطة، يمكن التعامل معها بواسطة أدوات مثل 7-Zip أو WinRAR)
    ArchiveISO = 7
    ' أرشيف بصيغة CAB (صيغة Microsoft Cabinet، تُستخدم في ملفات التثبيت)
    ArchiveCAB = 8
    ' أرشيف بصيغة Z (صيغة ضغط قديمة، لا تزال مدعومة في بعض الأدوات)
    ArchiveZ = 9
    ' أرشيف بصيغة LZH (صيغة ضغط يابانية قديمة، مدعومة بواسطة WinRAR وغيرها)
    ArchiveLZH = 10
    ' أرشيف بصيغة ARJ (صيغة ضغط قديمة، لا تزال مدعومة بواسطة بعض الأدوات مثل WinRAR)
    ArchiveARJ = 11
End Enum

' متغير عام للتحكم في حالة الحلقات (مثل السماح بإيقاف عملية متكررة)
Public IsInLoop As Boolean

' متغير عام لتخزين قائمة بالأرشيفات الناتجة (مثل مسارات الملفات المضغوطة)
Public ArchivesList As String


' تعريف متغيرات عامة ثابتة لتخزين مسارات الأدوات المختارة يدويًا
' تحافظ على القيمة طوال جلسة تشغيل قاعدة البيانات
Private m_WinRARPath As String ' مسار WinRAR المختار يدويًا
Private m_SevenZipPath As String ' مسار 7-Zip المختار يدويًا


' دالة مساعدة لتحويل مستوى الضغط إلى تنسيق WinRAR (مثل -m0 إلى -m5)
Function GetWinRARCompressionLevel(compressionLevel As EnumCompressionLevel) As String
    Select Case compressionLevel
        Case CompressionNone: GetWinRARCompressionLevel = "-m0" ' بدون ضغط
        Case CompressionFastest: GetWinRARCompressionLevel = "-m1" ' أسرع ضغط
        Case CompressionFast: GetWinRARCompressionLevel = "-m2" ' ضغط سريع
        Case CompressionNormal: GetWinRARCompressionLevel = "-m3" ' ضغط عادي
        Case CompressionMaximum: GetWinRARCompressionLevel = "-m5" ' ضغط أقصى
        Case CompressionUltra: GetWinRARCompressionLevel = "-m5" ' ضغط فائق (WinRAR لا يدعم 9)
    End Select
End Function

' دالة مساعدة لتحويل مستوى الضغط إلى تنسيق 7-Zip (مثل mx0 إلى mx9)
Function Get7ZipCompressionLevel(compressionLevel As EnumCompressionLevel) As String
    Select Case compressionLevel
        Case CompressionNone: Get7ZipCompressionLevel = "-mx0" ' بدون ضغط
        Case CompressionFastest: Get7ZipCompressionLevel = "-mx1" ' أسرع ضغط
        Case CompressionFast: Get7ZipCompressionLevel = "-mx3" ' ضغط سريع
        Case CompressionNormal: Get7ZipCompressionLevel = "-mx5" ' ضغط عادي
        Case CompressionMaximum: Get7ZipCompressionLevel = "-mx7" ' ضغط أقصى
        Case CompressionUltra: Get7ZipCompressionLevel = "-mx9" ' ضغط فائق
    End Select
End Function

' دالة مساعدة لتحديد نوع الأرشيف لـ 7-Zip (مثل "zip"، "7z"، إلخ)
Function Get7ZipArchiveType(ArchiveType As EnumArchiveType) As String
    Select Case ArchiveType
        Case ArchiveRAR: Get7ZipArchiveType = "rar" ' نوع RAR
        Case ArchiveZIP: Get7ZipArchiveType = "zip" ' نوع ZIP
        Case Archive7z: Get7ZipArchiveType = "7z" ' نوع 7z
        Case ArchiveTAR: Get7ZipArchiveType = "tar" ' نوع TAR
        Case ArchiveGZ: Get7ZipArchiveType = "gzip" ' نوع GZ
        Case ArchiveBZ2: Get7ZipArchiveType = "bzip2" ' نوع BZIP2
        Case ArchiveXZ: Get7ZipArchiveType = "xz" ' نوع XZ
        Case ArchiveISO: Get7ZipArchiveType = "iso" ' نوع ISO
        Case ArchiveCAB: Get7ZipArchiveType = "cab" ' نوع CAB
        Case ArchiveZ: Get7ZipArchiveType = "z" ' نوع Z
        Case ArchiveLZH: Get7ZipArchiveType = "lzh" ' نوع LZH
        Case ArchiveARJ: Get7ZipArchiveType = "arj" ' نوع ARJ
    End Select
End Function

' دالة لإرجاع امتداد الملف بناءً على نوع الأرشيف المحدد في EnumArchiveType
Function GetArchiveExtension(ArchiveType As EnumArchiveType) As String
    Select Case ArchiveType
        Case ArchiveRAR: GetArchiveExtension = ".rar" ' امتداد لأرشيف RAR
        Case ArchiveZIP: GetArchiveExtension = ".zip" ' امتداد لأرشيف ZIP
        Case Archive7z: GetArchiveExtension = ".7z" ' امتداد لأرشيف 7z
        Case ArchiveTAR: GetArchiveExtension = ".tar" ' امتداد لأرشيف TAR
        Case ArchiveGZ: GetArchiveExtension = ".gz" ' امتداد لأرشيف GZ (Gzip)
        Case ArchiveBZ2: GetArchiveExtension = ".bz2" ' امتداد لأرشيف BZIP2
        Case ArchiveXZ: GetArchiveExtension = ".xz" ' امتداد لأرشيف XZ
        Case ArchiveISO: GetArchiveExtension = ".iso" ' امتداد لأرشيف ISO
        Case ArchiveCAB: GetArchiveExtension = ".cab" ' امتداد لأرشيف CAB
        Case ArchiveZ: GetArchiveExtension = ".z" ' امتداد لأرشيف Z
        Case ArchiveLZH: GetArchiveExtension = ".lzh" ' امتداد لأرشيف LZH
        Case ArchiveARJ: GetArchiveExtension = ".arj" ' امتداد لأرشيف ARJ
    End Select
End Function

' دالة لتحويل خيار تقسيم الحجم من تعداد EnumSplitSizeOption إلى سلسلة متوافقة مع أوامر 7-Zip أو WinRAR
' المدخل: خيار التقسيم من نوع EnumSplitSizeOption
' المخرج: سلسلة نصية تمثل حجم التقسيم (مثل "1g" أو "500m") أو سلسلة فارغة إذا لم يكن هناك تقسيم
Function GetSplitSizeString(sizeOption As EnumSplitSizeOption) As String
    Select Case sizeOption
        Case SplitNone: GetSplitSizeString = "" ' بدون تقسيم
        Case Split50MB: GetSplitSizeString = "50m" ' 50 ميجابايت
        Case Split100MB: GetSplitSizeString = "100m" ' 100 ميجابايت
        Case Split200MB: GetSplitSizeString = "200m" ' 200 ميجابايت
        Case Split500MB: GetSplitSizeString = "500m" ' 500 ميجابايت
        Case Split1GB: GetSplitSizeString = "1g" ' 1 جيجابايت
        Case Split2GB: GetSplitSizeString = "2g" ' 2 جيجابايت
    End Select
End Function

' دالة للتحقق من صحة المسار (عدم وجود أحرف غير قانونية أو تعقيدات غير مرغوبة)
' المدخل: سلسلة تمثل المسار المراد التحقق منه
' المخرج: قيمة منطقية (True إذا كان المسار صالحًا، False إذا كان غير صالح)
Function IsValidPath(filePath As String) As Boolean
    On Error GoTo ErrorHandler
    ' تعريف الأحرف غير القانونية في مسارات Windows
    Dim invalidChars As String
    invalidChars = "\/:*?""<>|"
    
    ' متغير للتنقل عبر الأحرف غير القانونية
    Dim i As Integer
    
    ' فحص كل حرف غير قانوني في المسار
    For i = 1 To Len(invalidChars)
        ' إذا وُجد حرف غير قانوني، أنهِ الدالة وأرجع False
        If InStr(filePath, Mid(invalidChars, i, 1)) > 0 Then Exit Function
    Next i
    
    ' التحقق من أن المسار لا يحتوي على ".." (لمنع التنقل غير المرغوب) وأنه غير فارغ
    IsValidPath = (InStr(filePath, "..\") = 0) And (Len(filePath) > 0)
    
    Exit Function

ErrorHandler:
    ' في حالة حدوث خطأ (مثل قيمة غير صالحة لـ filePath)، أرجع False
    IsValidPath = False
End Function

' دالة لتنظيف المدخلات من الأحرف غير المرغوبة التي قد تسبب مشاكل في تنفيذ الأوامر
' المدخل: سلسلة نصية تحتاج إلى تنظيف
' المخرج: سلسلة نصية منقاة من الأحرف المحددة
Function SanitizeInput(inputString As String) As String
    ' إزالة علامات الاقتباس المزدوجة لمنع مشاكل في بناء الأوامر
    SanitizeInput = Replace(inputString, """", "")
    ' إزالة رمز "&" لمنع تنفيذ أوامر متتالية غير مقصودة
    SanitizeInput = Replace(SanitizeInput, "&", "")
    ' إزالة رمز "|" لمنع توجيه الأوامر بشكل غير متوقع
    SanitizeInput = Replace(SanitizeInput, "|", "")
End Function

' دالة للسماح للمستخدم باختيار مسار أداة الأرشفة يدويًا باستخدام نافذة حوار الملفات
' المدخل: اسم الأداة ("WinRAR" أو "SevenZip")
' المخرج: مسار الملف التنفيذي المختار (مثل "WinRAR.exe" أو "7z.exe")، أو سلسلة فارغة إذا فشل الاختيار
Function SelectArchivePathManually(Method As String) As String
    On Error GoTo ErrorHandler
    
    ' التحقق من صحة المدخل للتأكد من أنه إما "WinRAR" أو "SevenZip"
    If Method <> "WinRAR" And Method <> "SevenZip" Then
        MsgBox "قيمة غير صالحة: " & Method, vbCritical ' عرض رسالة خطأ إذا كان المدخل غير صالح
        Exit Function ' الخروج من الدالة إذا لم يكن المدخل صحيحًا
    End If
    
    ' إنشاء كائن نافذة حوار الملفات للسماح للمستخدم باختيار ملف تنفيذي
    Dim fileDialog As Object
    Set fileDialog = Application.fileDialog(3) ' نوع 3 يمثل نافذة اختيار الملفات
    
    With fileDialog
        ' تعيين عنوان النافذة بناءً على الأداة المطلوبة لتوجيه المستخدم
        .Title = IIf(Method = "WinRAR", "اختر WinRAR.exe", "اختر 7z.exe")
        ' مسح أي فلاتر سابقة لضمان عرض الفلتر الجديد فقط
        .Filters.Clear
        ' إضافة فلتر لعرض الملفات التنفيذية (*.exe) فقط لتسهيل الاختيار
        .Filters.Add "Executable", "*.exe"
        ' منع اختيار أكثر من ملف واحد لضمان اختيار ملف واحد فقط
        .AllowMultiSelect = False
        
        ' عرض نافذة الحوار والتحقق مما إذا ضغط المستخدم على "موافق" (-1)
        If .Show = -1 Then
            ' تخزين المسار المختار من العنصر الأول (والوحيد) في قائمة العناصر المختارة
            Dim selectedPath As String
            selectedPath = .SelectedItems(1)
            
            ' التحقق من أن الملف المختار يتطابق مع الأداة المطلوبة (WinRAR.exe أو 7z.exe)
            If (Method = "WinRAR" And InStr(LCase(selectedPath), "winrar.exe") = 0) Or _
               (Method = "SevenZip" And InStr(LCase(selectedPath), "7z.exe") = 0) Then
                MsgBox "الملف غير صحيح!", vbExclamation ' عرض تحذير إذا لم يكن الملف المختار صحيحًا
                Exit Function ' الخروج إذا كان الملف غير مطابق
            End If
            
            ' إرجاع المسار المختار إذا كان صالحًا
            SelectArchivePathManually = selectedPath
        End If
    End With
    
    Exit Function

ErrorHandler:
    ' معالجة أي خطأ يحدث أثناء تنفيذ الدالة (مثل فشل إنشاء نافذة الحوار)
    MsgBox "خطأ في اختيار المسار: " & Err.Description, vbCritical
End Function

' دالة اختيارية لإعادة تعيين المسارات المخزنة (يمكن استدعاؤها عند الحاجة)
Public Sub ResetArchivePaths()
    m_WinRARPath = "" ' إعادة تعيين مسار WinRAR المخزن
    m_SevenZipPath = "" ' إعادة تعيين مسار 7-Zip المخزن
End Sub

' دالة لتحديد مسار أداة الأرشفة تلقائيًا من السجل أو المسارات الافتراضية، مع الرجوع إلى الاختيار اليدوي المخزن إذا لزم الأمر
' المدخل: اسم الأداة ("WinRAR" أو "SevenZip")
' المخرج: مسار الملف التنفيذي للأداة (مثل "WinRAR.exe" أو "7z.exe")، أو سلسلة فارغة إذا فشل التحديد
Function DetermineArchivePath(Method As String) As String
    On Error GoTo ErrorHandler
    
    ' التحقق من صحة المدخل للتأكد من أنه إما "WinRAR" أو "SevenZip"
    If Method <> "WinRAR" And Method <> "SevenZip" Then
        MsgBox "قيمة غير صالحة: " & Method, vbCritical ' عرض رسالة خطأ إذا كان المدخل غير صالح
        Exit Function ' الخروج إذا كان المدخل غير صالح
    End If
    
    ' التحقق مما إذا كان المسار مخزنًا مسبقًا في المتغير العام المناسب
    If Method = "WinRAR" And m_WinRARPath <> "" Then
        DetermineArchivePath = m_WinRARPath ' إرجاع المسار المخزن لـ WinRAR إذا كان موجودًا
        Exit Function
    ElseIf Method = "SevenZip" And m_SevenZipPath <> "" Then
        DetermineArchivePath = m_SevenZipPath ' إرجاع المسار المخزن لـ 7-Zip إذا كان موجودًا
        Exit Function
    End If
    
    ' إنشاء كائن للوصول إلى السجل (Registry) لاستخراج المسارات المثبتة
    Dim reg As Object
    Dim p As Variant ' متغير للتنقل عبر المسارات الافتراضية
    Set reg = CreateObject("WScript.Shell")
    Dim pathFromReg As String ' متغير لتخزين المسار المستخرج من السجل
    
    If Method = "WinRAR" Then
        ' محاولة استخراج مسار WinRAR من السجل باستخدام مفاتيح مختلفة
        On Error Resume Next ' تعطيل معالجة الأخطاء للتعامل مع مفاتيح غير موجودة
        pathFromReg = reg.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\WinRAR.exe\")
        If Err.Number <> 0 Then pathFromReg = reg.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\WinRAR\exe32")
        If Err.Number <> 0 Then pathFromReg = reg.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\WinRAR\exe32")
        On Error GoTo 0 ' إعادة تفعيل معالجة الأخطاء
        
        ' التحقق مما إذا تم العثور على مسار صالح في السجل وأن الملف موجود
        If pathFromReg <> "" And Dir(pathFromReg) <> "" Then
            m_WinRARPath = pathFromReg ' تخزين المسار في المتغير العام لـ WinRAR
            DetermineArchivePath = pathFromReg ' إرجاع المسار المستخرج
            Exit Function
        End If
        
        ' فحص المسارات الافتراضية لـ WinRAR إذا لم يتم العثور على المسار في السجل
        Dim defaultPaths
        defaultPaths = Array("C:\Program Files\WinRAR\WinRAR.exe", "C:\Program Files (x86)\WinRAR\WinRAR.exe")
        For Each p In defaultPaths
            If Dir(p) <> "" Then
                m_WinRARPath = p ' تخزين المسار في المتغير العام لـ WinRAR
                DetermineArchivePath = p ' إرجاع المسار الافتراضي الصالح
                Exit Function
            End If
        Next p
    ElseIf Method = "SevenZip" Then
        ' محاولة استخراج مسار 7-Zip من السجل باستخدام مفاتيح مختلفة
        On Error Resume Next ' تعطيل معالجة الأخطاء للتعامل مع مفاتيح غير موجودة
        pathFromReg = reg.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\7-Zip\Path")
        If Err.Number <> 0 Then pathFromReg = reg.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\7-Zip\Path")
        On Error GoTo 0 ' إعادة تفعيل معالجة الأخطاء
        
        ' التحقق من المسار وإضافة "7z.exe" إذا كان المسار صالحًا
        If pathFromReg <> "" Then
            If Right(pathFromReg, 1) <> "\" Then pathFromReg = pathFromReg & "\" ' التأكد من وجود "\" في نهاية المسار
            If Dir(pathFromReg & "7z.exe") <> "" Then
                m_SevenZipPath = pathFromReg & "7z.exe" ' تخزين المسار في المتغير العام لـ 7-Zip
                DetermineArchivePath = pathFromReg & "7z.exe" ' إرجاع المسار الكامل
                Exit Function
            End If
        End If
        
        ' فحص المسارات الافتراضية لـ 7-Zip إذا لم يتم العثور على المسار في السجل
        defaultPaths = Array("C:\Program Files\7-Zip\7z.exe", CurrentProject.Path & "\7-Zip64\7z.exe", "C:\Program Files (x86)\7-Zip\7z.exe", CurrentProject.Path & "\7-Zip86\7z.exe")

        For Each p In defaultPaths
            If Dir(p) <> "" Then
                m_SevenZipPath = p ' تخزين المسار في المتغير العام لـ 7-Zip
                DetermineArchivePath = p ' إرجاع المسار الافتراضي الصالح
                Exit Function
            End If
        Next p
    End If
    
    ' إذا فشلت جميع الطرق التلقائية، استدعاء الاختيار اليدوي وتخزين النتيجة
    Dim manualPath As String
    manualPath = SelectArchivePathManually(Method) ' استدعاء الدالة للاختيار اليدوي
    If manualPath <> "" Then
        If Method = "WinRAR" Then
            m_WinRARPath = manualPath ' تخزين المسار اليدوي لـ WinRAR في المتغير العام
        ElseIf Method = "SevenZip" Then
            m_SevenZipPath = manualPath ' تخزين المسار اليدوي لـ 7-Zip في المتغير العام
        End If
        DetermineArchivePath = manualPath ' إرجاع المسار المختار يدويًا
    End If
    
    Exit Function

ErrorHandler:
    ' معالجة أي خطأ يحدث أثناء تنفيذ الدالة (مثل فشل الوصول إلى السجل)
    MsgBox "خطأ في تحديد المسار: " & Err.Description, vbCritical
End Function

' دالة لإنشاء ملف نصي مؤقت يحتوي على تعليقات (سطر واحد أو عدة أسطر) مع خيار الحذف بعد الاستخدام
' المدخل:
'   - commentLines: نص أو مصفوفة من النصوص تمثل التعليقات المراد كتابتها في الملف
'   - deleteAfterUse: قيمة منطقية اختيارية (True افتراضيًا) لتحديد ما إذا كان سيتم حذف الملف بعد إنشائه
' المخرج: مسار الملف النصي المؤقت الذي تم إنشاؤه
' دالة لإنشاء ملف تعليقات مؤقت وإرجاع مساره
Function CreateCommentFile(commentLines As Variant) As String
    Dim fso As Object
    Dim tempFile As String
    Dim file As Object
    Dim line As Variant
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    tempFile = CurrentProject.Path & "\temp_comment.txt"
    Set file = fso.CreateTextFile(tempFile, True, True)
    
    If IsArray(commentLines) Then
        For Each line In commentLines
            file.WriteLine CStr(line)
        Next line
    Else
        file.WriteLine CStr(commentLines)
    End If
    
    file.Close
    CreateCommentFile = tempFile ' إرجاع المسار بدون حذف
    
    Set file = Nothing
    Set fso = Nothing
End Function

' دالة لبناء أمر ضغط الملفات/المجلدات بناءً على الخيارات المحددة باستخدام WinRAR أو 7-Zip
' المدخلات:
'   - sourceFile: ملف أو مصفوفة ملفات/مجلدات للضغط (قد تكون مسارات نسبية أو مطلقة)
'   - password: كلمة المرور لتشفير الأرشيف (اختياري)
'   - Method: أداة الضغط (WinRAR أو SevenZip) من EnumArchiveMethod
'   - archiveType: نوع الأرشيف (RAR، ZIP، 7z، إلخ) من EnumArchiveType
'   - compressionLevel: مستوى الضغط من EnumCompressionLevel
'   - partSize: حجم التقسيم (إن وجد) من EnumSplitSizeOption
'   - targetPath: مسار حفظ الأرشيف (اختياري، يُستخدم المشروع الحالي إذا لم يُحدد)
'   - archiveName: اسم الأرشيف (اختياري، يُشتق من الملف الأصلي إذا لم يُحدد)
'   - isSFX: تحديد ما إذا كان الأرشيف سيكون تنفيذيًا ذاتيًا (Self-Extracting)
'   - commentFile: مسار ملف التعليقات (اختياري)
'   - deleteOriginals: حذف الملفات الأصلية بعد الضغط
' المخرج: سلسلة نصية تمثل الأمر الكامل للضغط
Function BuildCompressCommand( _
    sourceFile As Variant, _
    password As String, _
    Method As EnumArchiveMethod, _
    ArchiveType As EnumArchiveType, _
    compressionLevel As EnumCompressionLevel, _
    partSize As EnumSplitSizeOption, _
    targetPath As String, _
    archiveName As String, _
    isSFX As Boolean, _
    commentFile As String, _
    Optional ByVal deleteOriginals As Boolean = True) As String
    
    ' تعريف المتغيرات اللازمة لبناء الأمر
    Dim Command As String          ' الأمر النهائي الذي سيتم إرجاعه
    Dim archiveProgramPath As String ' مسار أداة الضغط (WinRAR.exe أو 7z.exe)
    Dim fileList As String         ' قائمة الملفات/المجلدات للضغط
    Dim targetFile As String       ' المسار الكامل للأرشيف الناتج
    Dim fso As Object              ' كائن FileSystemObject للتعامل مع الملفات
    Dim file As Variant            ' متغير للتنقل عبر الملفات في المصفوفة
    Dim fullFilePath As String     ' المسار الكامل لكل ملف/مجلد
    
'    On Error GoTo ErrorHandler
    ' إنشاء كائن FileSystemObject للتحقق من الملفات والمسارات
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '--- معالجة المسارات النسبية ---
    fileList = "" ' تهيئة قائمة الملفات
    ' تحويل المدخل إلى مصفوفة إذا لم يكن كذلك لتسهيل المعالجة
    If Not IsArray(sourceFile) Then sourceFile = Array(sourceFile)
    
    ' معالجة كل ملف/مجلد في المصفوفة
    For Each file In sourceFile
        ' تحديد المسار الكامل بناءً على كونه نسبيًا أو مطلقًا
        If InStr(file, ":\") = 0 And InStr(file, "\\") = 0 Then
            ' مسار نسبي (لا يحتوي على محرك أقراص أو مسار شبكة)
            If Left(file, 1) = "\" Then
                ' يبدأ بـ "\" (مثل \folder\file.txt)، يُضاف إلى مسار المشروع مباشرة
                fullFilePath = CurrentProject.Path & file
            Else
                ' مسار نسبي عادي (مثل folder\file.txt)، يُضاف مع فاصل "\"
                fullFilePath = CurrentProject.Path & "\" & file
            End If
        Else
            ' مسار مطلق (مثل C:\...\file.txt)، يُستخدم كما هو
            fullFilePath = file
        End If
        
        ' التحقق من وجود الملف أو المجلد في المسار المحدد
        If Not fso.FileExists(fullFilePath) And Not fso.FolderExists(fullFilePath) Then
            MsgBox "المسار غير موجود: " & fullFilePath, vbCritical
            Exit Function ' الخروج إذا لم يكن المسار موجودًا
        End If
        
        ' إضافة المسار المنظف إلى قائمة الملفات مع إحاطته بعلامات اقتباس
        fileList = fileList & " """ & SanitizeInput(fullFilePath) & """"
    Next file
    
    '--- تحديد مسار الأرشيف الناتج ---
    If targetPath = "" Then
        ' إذا لم يُحدد مسار الهدف، استخدام مسار المشروع الحالي
        targetPath = CurrentProject.Path
    End If
    
    '--- بناء اسم الأرشيف ---
    targetFile = targetPath & "\" & _
                 IIf(archiveName = "", fso.GetBaseName(sourceFile(LBound(sourceFile))), archiveName) & _
                 IIf(isSFX, ".exe", _
                 IIf(ArchiveType = ArchiveRAR, ".rar", _
                 IIf(ArchiveType = ArchiveZIP, ".zip", ".7z")))
    ' الشرح:
    ' - إذا لم يُحدد اسم الأرشيف، يُشتق من اسم الملف الأول (بدون الامتداد)
    ' - إذا كان SFX، يُستخدم امتداد ".exe"، وإلا يُحدد الامتداد بناءً على نوع الأرشيف (RAR، ZIP، 7z)
    
    '--- التحقق من صحة الأداة ---
    archiveProgramPath = DetermineArchivePath(IIf(Method = WinRAR, "WinRAR", "SevenZip"))
    If archiveProgramPath = "" Then Exit Function ' الخروج إذا لم يتم العثور على الأداة
    
    '--- بناء الأمر بناءً على الأداة ---
    If Method = WinRAR Then
        ' بناء أمر WinRAR
        Command = """" & archiveProgramPath & """ a -ep1 -m" & compressionLevel
        ' - "a": إضافة الملفات إلى الأرشيف
        ' - "-ep1": استبعاد المسار الأساسي من الأسماء داخل الأرشيف
        ' - "-m": تحديد مستوى الضغط (0-5)
        
        Command = Command & IIf(isSFX, " -sfx", "") ' إضافة خيار SFX إذا تم تحديده
        Command = Command & " """ & targetFile & """" & fileList ' إضافة مسار الأرشيف وقائمة الملفات
        Command = Command & IIf(password <> "", " -p" & SanitizeInput(password), "") ' إضافة كلمة المرور إذا وُجدت
        Command = Command & IIf(partSize <> SplitNone, " -v" & GetSplitSizeString(partSize), "") ' إضافة خيار التقسيم إذا تم تحديده
        Command = Command & IIf(commentFile <> "" And fso.FileExists(commentFile), " -z""" & commentFile & """", "") ' إضافة ملف التعليقات إذا وُجد
        Command = Command & IIf(deleteOriginals, " -df", "") ' حذف الملفات الأصلية بعد الضغط إذا تم تحديده
    ElseIf Method = SevenZip Then
        ' بناء أمر 7-Zip
        Command = """" & archiveProgramPath & """ a -mx=" & Get7ZipCompressionLevel(compressionLevel)
        ' - "a": إضافة الملفات إلى الأرشيف
        ' - "-mx=": تحديد مستوى الضغط (0-9) باستخدام دالة GetSevenZipCompressionLevel
        
        Command = Command & IIf(isSFX, " -sfx7z.sfx", "") ' إضافة خيار SFX باستخدام ملف 7z.sfx
        Command = Command & " """ & targetFile & """" & fileList ' إضافة مسار الأرشيف وقائمة الملفات
        Command = Command & IIf(password <> "", " -p" & SanitizeInput(password) & " -mhe=on", "") ' إضافة كلمة المرور مع تشفير الأسماء
        Command = Command & IIf(partSize <> SplitNone, " -v" & GetSplitSizeString(partSize), "") ' إضافة خيار التقسيم إذا تم تحديده
        Command = Command & IIf(deleteOriginals, " -sdel", "") ' حذف الملفات الأصلية بعد الضغط إذا تم تحديده
    End If
    
    ' إرجاع الأمر النهائي
    BuildCompressCommand = Command
    Exit Function
'
'ErrorHandler:
'    ' معالجة الأخطاء وعرض رسالة في حالة حدوث مشكلة (مثل مسار غير صالح أو فشل إنشاء الكائن)
'    MsgBox "خطأ في بناء الأمر: " & Err.Description, vbCritical
End Function

' إجراء لضغط العناصر (ملفات أو مجلدات) باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
' المدخلات (جميعها اختيارية):
'   - itemsArray: ملف أو مصفوفة ملفات/مجلدات للضغط
'   - password: كلمة المرور لتشفير الأرشيف (افتراضي: فارغ)
'   - Method: أداة الضغط (افتراضي: SevenZip)
'   - archiveType: نوع الأرشيف (افتراضي: Archive7z)
'   - compressionLevel: مستوى الضغط (افتراضي: CompressionNormal)
'   - partSize: حجم التقسيم (افتراضي: SplitNone)
'   - targetPath: مسار حفظ الأرشيف (افتراضي: فارغ، يُستخدم المشروع الحالي)
'   - archiveName: اسم الأرشيف (افتراضي: فارغ، يُشتق من الملف الأصلي)
'   - isSFX: تحديد ما إذا كان الأرشيف تنفيذيًا ذاتيًا (افتراضي: False)
'   - commentFile: مسار ملف التعليقات (افتراضي: فارغ)
'   - deleteOriginals: حذف الملفات الأصلية بعد الضغط (افتراضي: False)
' إجراء لضغط العناصر باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
' إجراء لضغط العناصر باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
' إجراء لضغط العناصر باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
Sub CompressItems( _
    Optional ByVal itemsArray As Variant, _
    Optional ByVal password As String = "", _
    Optional ByVal Method As EnumArchiveMethod = SevenZip, _
    Optional ByVal ArchiveType As EnumArchiveType = Archive7z, _
    Optional ByVal compressionLevel As EnumCompressionLevel = CompressionNormal, _
    Optional ByVal partSize As EnumSplitSizeOption = SplitNone, _
    Optional ByVal targetPath As String = "", _
    Optional ByVal archiveName As String = "", _
    Optional ByVal isSFX As Boolean = False, _
    Optional ByVal commentFile As String = "", _
    Optional ByVal deleteOriginals As Boolean = False)
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    On Error GoTo ErrorHandler
    If VarType(itemsArray) = vbEmpty Then
        MsgBox "لم يتم تحديد عناصر للضغط!", vbExclamation
        Exit Sub
    End If
    
    ' تحويل itemsArray إلى مصفوفة إذا كان سلسلة نصية واحدة
    Dim items As Variant
    If Not IsArray(itemsArray) Then
        items = Array(itemsArray)
    Else
        items = itemsArray
    End If
    
    ' التحقق من وجود الملفات قبل الضغط
    Dim i As Long
    Dim fullPath As String
    For i = LBound(items) To UBound(items)
        ' إذا كان المسار نسبيًا، أضف CurrentProject.Path
        If InStr(items(i), ":\") = 0 And InStr(items(i), "\\") = 0 Then
            fullPath = CurrentProject.Path & "\" & items(i)
        Else
            fullPath = items(i)
        End If
        If Not fso.FileExists(fullPath) And Not fso.FolderExists(fullPath) Then
            MsgBox "الملف أو المجلد غير موجود: " & fullPath, vbExclamation
            Exit Sub
        End If
        ' تحديث المسار في المصفوفة ليكون مطلقًا
        items(i) = fullPath
    Next i
    
    Dim archiveProgramPath As String
    archiveProgramPath = DetermineArchivePath(IIf(Method = WinRAR, "WinRAR", "SevenZip"))
    If archiveProgramPath = "" Then Exit Sub
    
    ' بناء المسار الكامل للأرشيف الناتج
    Dim archiveFullPath As String
    Dim baseName As String
    baseName = fso.GetBaseName(items(LBound(items))) ' استخدام أول عنصر بعد التأكد من المسار
    archiveFullPath = IIf(targetPath = "", CurrentProject.Path, targetPath) & "\" & _
                      IIf(archiveName = "", baseName, archiveName) & _
                      IIf(isSFX, ".exe", GetArchiveExtension(ArchiveType))
    
    Dim Command As String
    If Method = WinRAR Then
        Command = """" & archiveProgramPath & """ a -ep1 """ & archiveFullPath & """ " & JoinArchivePaths(items)
        Command = Command & IIf(password <> "", " -p" & SanitizeInput(password), "")
        Command = Command & " " & GetWinRARCompressionLevel(compressionLevel)
        Command = Command & IIf(partSize <> SplitNone, " -v" & GetSplitSizeString(partSize), "")
        Command = Command & IIf(isSFX, " -sfx", "")
        Command = Command & IIf(commentFile <> "" And fso.FileExists(commentFile), " -z""" & commentFile & """", "")
        Command = Command & IIf(deleteOriginals, " -df", "")
        If ArchiveType = ArchiveXZ Or ArchiveType = ArchiveBZ2 Then
            MsgBox "WinRAR لا يدعم نوع الأرشيف المحدد: " & ArchiveType, vbExclamation
            Exit Sub
        End If
    ElseIf Method = SevenZip Then
        Command = """" & archiveProgramPath & """ a """ & archiveFullPath & """ " & JoinArchivePaths(items)
        Command = Command & IIf(password <> "", " -p" & SanitizeInput(password), "")
        Command = Command & " " & Get7ZipCompressionLevel(compressionLevel)
        Command = Command & IIf(partSize <> SplitNone, " -v" & GetSplitSizeString(partSize), "")
        Command = Command & IIf(isSFX, " -sfx", "")
        Command = Command & IIf(commentFile <> "" And fso.FileExists(commentFile), " -scc""" & commentFile & """", "")
        Command = Command & IIf(deleteOriginals, " -sdel", "")
        Command = Command & " -t" & Get7ZipArchiveType(ArchiveType)
    End If
    
    If Command = "" Then Exit Sub
    
    ' تنفيذ الأمر باستخدام ExecuteAndWait مع الانتظار حتى اكتمال العملية
'    ExecuteAndWait Command, WindowHidden, True
    ' Command: السلسلة التي تحتوي على الأمر الكامل (مثل: """C:\Program Files\7-Zip\7z.exe"" a ""C:\output.rar"" ""C:\input.txt""")
    ' WindowHidden: تحديد نمط النافذة لتكون مخفية (0) أثناء التنفيذ لعدم إظهار واجهة البرنامج
    ' True: تشغيل الأمر بصلاحيات المسؤول (RunAsAdmin) لضمان الوصول إلى الملفات المحمية إذا لزم الأمر
    
    ' تنفيذ الأمر باستخدام ExecuteWithTimeout مع التحكم في المهلة الزمنية
    ExecuteWithTimeout Command, WindowHidden, 0, True
    ' Command: السلسلة التي تحتوي على الأمر الكامل (مثل: """C:\Program Files\7-Zip\7z.exe"" x ""C:\archive.rar"" -o""C:\destination""")
    ' WindowHidden: تحديد نمط النافذة لتكون مخفية (0) أثناء التنفيذ للحفاظ على تجربة مستخدم نظيفة
    ' 0: المهلة الزمنية بالمللي ثانية (0 تعني الانتظار إلى ما لا نهاية حتى اكتمال العملية)
    ' True: تشغيل الأمر كمسؤول (RunAsAdmin)
    
    If Not IsInLoop Then
        MsgBox "تم الضغط بنجاح إلى: " & archiveFullPath, vbInformation
    Else
        ArchivesList = ArchivesList & archiveFullPath & vbCrLf
    End If
    
    On Error Resume Next
        If commentFile <> "" And fso.FileExists(commentFile) Then fso.DeleteFile commentFile
    On Error GoTo 0
    
    Set fso = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "خطأ في الضغط: " & Err.Description, vbCritical
    LogError "CompressItems Error: " & Err.Description
    Set fso = Nothing
End Sub

' إجراء لفك ضغط الأرشيفات باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
' المدخلات:
'   - archivePaths: مسار أو مصفوفة مسارات للأرشيفات المراد فك ضغطها
'   - destinationPath: مسار الوجهة لفك الضغط
'   - password: كلمة المرور لفك تشفير الأرشيف (اختياري، افتراضي: فارغ)
'   - Method: أداة فك الضغط (افتراضي: WinRAR)
'   - OverwriteMode: وضع الكتابة فوق الملفات الموجودة (افتراضي: OverwriteAll)
'   - deleteArchive: حذف الأرشيف بعد فك الضغط (افتراضي: False)
' إجراء لفك ضغط الأرشيفات باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
' إجراء لفك ضغط الأرشيفات باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
' إجراء لفك ضغط الأرشيفات باستخدام WinRAR أو 7-Zip بناءً على الخيارات المحددة
Sub ExtractItems( _
    archivePaths As Variant, _
    destinationPath As String, _
    Optional ByVal password As String = "", _
    Optional ByVal Method As EnumArchiveMethod = WinRAR, _
    Optional ByVal OverwriteMode As EnumOverwriteMode = OverwriteAll, _
    Optional ByVal deleteArchive As Boolean = False)
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    On Error GoTo ErrorHandler
    If VarType(archivePaths) = vbEmpty Then
        MsgBox "لم يتم تحديد أرشيفات!", vbExclamation
        Exit Sub
    End If
    
    ' تحويل archivePaths إلى مصفوفة إذا كان سلسلة نصية واحدة
    Dim archives As Variant
    If Not IsArray(archivePaths) Then
        archives = Array(archivePaths)
    Else
        archives = archivePaths
    End If
    
    ' التحقق من وجود الأرشيفات قبل فك الضغط
    Dim i As Long
    Dim fullPath As String
    For i = LBound(archives) To UBound(archives)
        ' إذا كان المسار نسبيًا، أضف CurrentProject.Path
        If InStr(archives(i), ":\") = 0 And InStr(archives(i), "\\") = 0 Then
            fullPath = CurrentProject.Path & "\" & archives(i)
        Else
            fullPath = archives(i)
        End If
        If Not fso.FileExists(fullPath) Then
            MsgBox "الأرشيف غير موجود: " & fullPath, vbExclamation
            Exit Sub
        End If
        ' تحديث المسار في المصفوفة ليكون مطلقًا
        archives(i) = fullPath
    Next i
    
    ' التحقق من وجود مسار الوجهة وإنشاؤه إذا لم يكن موجودًا
    If Not fso.FolderExists(destinationPath) Then
        fso.CreateFolder destinationPath
    End If
    
    Dim archiveProgramPath As String
    archiveProgramPath = DetermineArchivePath(IIf(Method = WinRAR, "WinRAR", "SevenZip"))
    If archiveProgramPath = "" Then Exit Sub
    
    Dim Command As String
    If Method = WinRAR Then
        Command = """" & archiveProgramPath & """ x " & JoinArchivePaths(archives) & " """ & destinationPath & """"
        Command = Command & IIf(password <> "", " -p" & SanitizeInput(password), "")
        Command = Command & IIf(OverwriteMode = OverwriteAll, " -o+", IIf(OverwriteMode = OverwritePrompt, "", " -o-"))
        Command = Command & IIf(deleteArchive, " -df", "")
    ElseIf Method = SevenZip Then
        Command = """" & archiveProgramPath & """ x " & JoinArchivePaths(archives) & " -o""" & destinationPath & """"
        Command = Command & IIf(password <> "", " -p" & SanitizeInput(password), "")
        Command = Command & IIf(OverwriteMode = OverwriteAll, " -aoa", IIf(OverwriteMode = OverwritePrompt, "", " -aos"))
        Command = Command & IIf(deleteArchive, " -sdel", "")
    End If
    
    ' تنفيذ الأمر باستخدام ExecuteAndWait مع الانتظار حتى اكتمال العملية
'    ExecuteAndWait Command, WindowHidden, True
    ' Command: السلسلة التي تحتوي على الأمر الكامل (مثل: """C:\Program Files\7-Zip\7z.exe"" a ""C:\output.rar"" ""C:\input.txt""")
    ' WindowHidden: تحديد نمط النافذة لتكون مخفية (0) أثناء التنفيذ لعدم إظهار واجهة البرنامج
    ' True: تشغيل الأمر بصلاحيات المسؤول (RunAsAdmin) لضمان الوصول إلى الملفات المحمية إذا لزم الأمر
    
    ' تنفيذ الأمر باستخدام ExecuteWithTimeout مع التحكم في المهلة الزمنية
    ExecuteWithTimeout Command, WindowHidden, 0, True
    ' Command: السلسلة التي تحتوي على الأمر الكامل (مثل: """C:\Program Files\7-Zip\7z.exe"" x ""C:\archive.rar"" -o""C:\destination""")
    ' WindowHidden: تحديد نمط النافذة لتكون مخفية (0) أثناء التنفيذ للحفاظ على تجربة مستخدم نظيفة
    ' 0: المهلة الزمنية بالمللي ثانية (0 تعني الانتظار إلى ما لا نهاية حتى اكتمال العملية)
    ' True: تشغيل الأمر كمسؤول (RunAsAdmin)
    
    If Not IsInLoop Then
        MsgBox "تم فك الضغط بنجاح إلى: " & destinationPath, vbInformation
    Else
        ArchivesList = ArchivesList & destinationPath & vbCrLf
    End If
    
    Set fso = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "خطأ في فك الضغط: " & Err.Description, vbCritical
    LogError "ExtractItems Error: " & Err.Description
    Set fso = Nothing
End Sub

' دالة لدمج مسارات الأرشيفات في سلسلة واحدة مع إحاطة كل مسار بعلامات اقتباس
' المدخل:
'   - archivePaths: مسار واحد أو مصفوفة من مسارات الأرشيفات
' المخرج: سلسلة نصية تحتوي على المسارات مفصولة بمسافات ومحاطة بعلامات اقتباس (مثل: "path1" "path2")
Function JoinArchivePaths(archivePaths As Variant) As String
    ' تعريف متغير لتخزين النتيجة النهائية
    Dim Result As String
    ' متغير للتنقل عبر عناصر المصفوفة
    Dim p As Variant
    
    ' تحويل المدخل إلى مصفوفة إذا لم يكن كذلك لتسهيل المعالجة
    If Not IsArray(archivePaths) Then archivePaths = Array(archivePaths)
    
    ' تكرار على كل مسار في المصفوفة
    For Each p In archivePaths
        ' إضافة المسار المنظف إلى النتيجة مع إحاطته بعلامات اقتباس وفاصل مسافة
        Result = Result & " """ & SanitizeInput(CStr(p)) & """"
        ' - SanitizeInput: تنظيف المسار من الأحرف غير المرغوبة
        ' - CStr: تحويل المسار إلى سلسلة نصية
    Next p
    
    ' إرجاع السلسلة الناتجة (بدون مسافة إضافية في البداية)
    JoinArchivePaths = Result
End Function

' إجراء لتسجيل الأخطاء في ملف نصي بمسار المشروع الحالي
' المدخل:
'   - errorMessage: رسالة الخطأ المراد تسجيلها
Sub LogError(errorMessage As String)
    ' تعريف مسار ملف السجل (ErrorLog.txt في مسار المشروع الحالي)
    Dim logFile As String
    logFile = CurrentProject.Path & "\ErrorLog.txt"
    
    ' فتح الملف في وضع الإضافة (Append) برقم قناة #1
    Open logFile For Append As #1
    ' كتابة التاريخ/الوقت الحالي ورسالة الخطأ في الملف مع فاصل سطر
    Print #1, Now & " - " & errorMessage
    ' إغلاق الملف لضمان حفظ التغييرات
    Close #1
End Sub

' إجراء لعرض نافذة تعليمات بسيطة تحتوي على إرشادات حول استخدام الكود
Sub ShowHelp()
    ' عرض رسالة تحتوي على تعليمات أساسية حول الإجراءات والتعدادات
    MsgBox "التعليمات:" & vbCrLf & _
           "1. CompressItems: لضغط الملفات" & vbCrLf & _
           "2. ExtractItems: لفك الضغط" & vbCrLf & _
           "3. استخدام التعدادات لتحديد الخيارات" & vbCrLf & _
           "راجع التعليقات في الكود للمزيد من التفاصيل", vbInformation
    ' - vbCrLf: فاصل سطر لتنسيق النص
    ' - vbInformation: رمز أيقونة المعلومات في نافذة الرسالة
End Sub

'##################################################
'# دوال مساعدة للحلقات (الضغط وفك الضغط)
'##################################################

' إجراء لبدء حلقة ضغط متعددة وتهيئة المتغيرات العامة
Sub StartCompressionLoop()
    ' تعيين المتغير العام IsInLoop إلى True للإشارة إلى أن العملية تعمل داخل حلقة
    IsInLoop = True   ' تفعيل وضع الحلقة
    ' تهيئة المتغير العام ArchivesList كسلسلة فارغة لتخزين قائمة الأرشيفات الناتجة
    ArchivesList = "" ' تهيئة قائمة الأرشيفات
End Sub

' إجراء لعرض رسالة نجاح موحدة بعد انتهاء حلقة الضغط
Sub ShowCompressionSuccess()
    ' التحقق مما إذا كان الإجراء في وضع حلقة وما إذا كانت قائمة الأرشيفات تحتوي على بيانات
    If IsInLoop And ArchivesList <> "" Then
        ' عرض رسالة نجاح تحتوي على قائمة الأرشيفات المضغوطة
        MsgBox "تم الضغط بنجاح للملفات التالية:" & vbCrLf & ArchivesList, vbInformation, "نجاح"
        ' - vbCrLf: فاصل سطر لتنسيق القائمة
        ' - vbInformation: رمز أيقونة المعلومات
        ' - "نجاح": عنوان النافذة
    End If
    ' تعطيل وضع الحلقة بعد الانتهاء
    IsInLoop = False  ' إنهاء وضع الحلقة
    ' إعادة تهيئة قائمة الأرشيفات كسلسلة فارغة للاستخدام المستقبلي
    ArchivesList = "" ' إعادة تهيئة القائمة
End Sub

' إجراء لبدء حلقة فك ضغط متعددة وتهيئة المتغيرات العامة
Sub StartExtractionLoop()
    ' تعيين المتغير العام IsInLoop إلى True للإشارة إلى أن العملية تعمل داخل حلقة
    IsInLoop = True   ' تفعيل وضع الحلقة
    ' تهيئة المتغير العام ArchivesList كسلسلة فارغة لتخزين قائمة مسارات الوجهة
    ArchivesList = "" ' تهيئة قائمة الأرشيفات
End Sub

' إجراء لعرض رسالة نجاح موحدة بعد انتهاء حلقة فك الضغط
Sub ShowExtractionSuccess()
    ' التحقق مما إذا كان الإجراء في وضع حلقة وما إذا كانت قائمة الأرشيفات تحتوي على بيانات
    If IsInLoop And ArchivesList <> "" Then
        ' عرض رسالة نجاح تحتوي على قائمة مسارات الوجهة التي تم فك الضغط إليها
        MsgBox "تم فك الضغط بنجاح للملفات التالية:" & vbCrLf & ArchivesList, vbInformation, "نجاح"
        ' - vbCrLf: فاصل سطر لتنسيق القائمة
        ' - vbInformation: رمز أيقونة المعلومات
        ' - "نجاح": عنوان النافذة
    End If
    ' تعطيل وضع الحلقة بعد الانتهاء
    IsInLoop = False  ' إنهاء وضع الحلقة
    ' إعادة تهيئة قائمة الأرشيفات كسلسلة فارغة للاستخدام المستقبلي
    ArchivesList = "" ' إعادة تهيئة القائمة
End Sub

' دالة تستخدم لاختبار
' DetermineArchivePath
' التي تحدد مسار ملفي
' ("WinRAR : WinRAR.exe " أو "SevenZip : 7z.exe")
' تلقائيا أو يدوًا
' يمكن حذفها هى فقط كانت لتجربة الكود والتأكد من جلب مسارات التطبيقات
Sub TestDetermineArchivePath()
    ' الغرض: اختبار دالة DetermineArchivePath لتحديد مسارات WinRAR و7-Zip
    ' المخرجات:
    '   - طباعة المسارات في نافذة Immediate إذا تم العثور عليها
    '   - عرض رسالة إذا لم يتم العثور على الأداة

    On Error GoTo ErrorHandler

    Dim tools As Variant
    Dim tool As Variant ' يجب أن يكون Variant لاستخدامه في For Each
    Dim archivePath As String

    ' قائمة الأدوات للاختبار
    tools = Array("WinRAR", "SevenZip")

    ' اختبار كل أداة
    For Each tool In tools
        archivePath = DetermineArchivePath(CStr(tool)) ' تحويل Variant إلى String صراحة
        If archivePath <> "" Then
            Debug.Print "تم العثور على " & tool & " في: " & archivePath
        Else
            MsgBox "لم يتم العثور على " & tool & ".", vbInformation, "نتيجة الاختبار"
        End If
    Next tool

    Exit Sub

ErrorHandler:
    MsgBox "حدث خطأ أثناء اختبار DetermineArchivePath: " & Err.Description, vbCritical, "خطأ"
    Exit Sub
End Sub

الكود مرتبط بـ : ExecuteWith
الغرض: تشغيل برنامج والانتظار حتى ينتهي مع السماح بمعالجة الأحداث الأخرى
الكود داخل وحده نمطيه عامة باسم : basShellExecutor

' يضمن مقارنة النصوص بناءً على إعدادات قاعدة البيانات (مثل ترتيب الحروف واللغة)
Option Compare Database
' يجبر على تعريف المتغيرات صراحة قبل استخدامها، مما يمنع الأخطاء الناتجة عن الأسماء الخاطئة
Option Explicit


'=======================================================================================================================
'------    الثوابت
Public Const PROCESS_TIMEOUT_INFINITE As Long = &HFFFFFFFF
Public Const PROCESS_STILL_ACTIVE As Long = &H103
Public Const PROCESS_TERMINATED As Long = vbObjectError Or &HDEAD
Public Const MAX_PATH_LENGTH As Long = 260
Public Const QS_ALL_INPUT As Long = &H4FF

Private Const ERR_NO_COMMAND As Long = vbObjectError Or 1001
Private Const ERR_EXECUTING As Long = vbObjectError Or 1002
Private Const ERR_EXECUTION_FAILED As Long = vbObjectError Or 1003
Private Const ERR_TERMINATION_FAILED As Long = vbObjectError Or 1004

Private Const SHELL_MASK_NOCLOSEPROCESS As Long = &H40
Private Const SHELL_MASK_DOENVSUBST As Long = &H200
Private Const SHELL_MASK_SUPPRESS_ERRORS As Long = &H400

Private Const PROCESS_QUERY_INFO As Long = &H400
Private Const PROCESS_SYNCHRONIZE As Long = &H100000
Private Const PROCESS_TERMINATE As Long = &H1
Private Const ERROR_ACCESS_DENIED As Long = 5

'=======================================================================================================================
'------     التعدادات
Public Enum ShellWindowStyle
    WindowHidden = 0
    WindowNormal = 1
    WindowMinimized = 2
    WindowMaximized = 3
    WindowNoActivate = 4
End Enum

'=======================================================================================================================
'------    الأنواع المخصصة
#If VBA7 Then
    Private Type ShellExecuteParams
        Size As Long
        Mask As Long
        ParentWindowHandle As LongPtr
        Verb As String
        filePath As String
        Arguments As String
        WorkingDirectory As String
        ShowCommand As Long
        InstanceHandle As LongPtr
        ItemListPointer As LongPtr
        ClassName As String
        ClassKeyHandle As LongPtr
        HotKey As Long
        IconHandle As LongPtr
        ProcessHandle As LongPtr
    End Type
#Else
    Private Type ShellExecuteParams
        Size As Long
        Mask As Long
        ParentWindowHandle As Long
        Verb As String
        filePath As String
        Arguments As String
        WorkingDirectory As String
        ShowCommand As Long
        InstanceHandle As Long
        ItemListPointer As Long
        ClassName As String
        ClassKeyHandle As Long
        HotKey As Long
        IconHandle As Long
        ProcessHandle As Long
    End Type
#End If

'=======================================================================================================================
'------    تعريفات API
#If VBA7 Then
    Private Declare PtrSafe Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr ' فتح مقبض العملية
    Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Long ' إغلاق مقبض العملية
    Private Declare PtrSafe Function ExpandEnvironmentStringsW Lib "kernel32.dll" (ByVal lpSrc As LongPtr, Optional ByVal lpDst As LongPtr, Optional ByVal nSize As Long) As Long ' توسيع متغيرات البيئة
    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As LongPtr, ByRef lpExitCode As Long) As Long ' جلب رمز الخروج للعملية
    Private Declare PtrSafe Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As LongPtr, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long ' انتظار العمليات مع معالجة الأحداث
    Private Declare PtrSafe Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr, Optional ByVal Length As Long) As Long ' إعادة تخصيص حجم السلسلة
    Private Declare PtrSafe Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As LongPtr, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As LongPtr) As LongPtr ' إنشاء مؤقت قابل للانتظار
    Private Declare PtrSafe Function GetProcessId Lib "kernel32.dll" (ByVal hProcess As LongPtr) As Long ' جلب معرف العملية
    Private Declare PtrSafe Function PathCanonicalizeW Lib "shlwapi.dll" (ByVal lpszDst As LongPtr, ByVal lpszSrc As LongPtr) As Long ' تبسيط المسار
    Private Declare PtrSafe Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As LongPtr) As LongPtr ' استخراج المعاملات من المسار
    Private Declare PtrSafe Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As LongPtr, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As LongPtr, Optional ByVal lpArgToCompletionRoutine As LongPtr, Optional ByVal fResume As Long) As Long ' ضبط المؤقت
    Private Declare PtrSafe Function ShellExecuteExW Lib "shell32.dll" (ByVal pExecInfo As LongPtr) As Long ' تنفيذ أمر عبر Shell
    Private Declare PtrSafe Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long ' إعادة تخصيص السلسلة
    Private Declare PtrSafe Sub PathRemoveArgsW Lib "shlwapi.dll" (ByVal pszPath As LongPtr) ' إزالة المعاملات من المسار
    Private Declare PtrSafe Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long ' إنهاء العملية قسريًا
    Private Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long ' لقياس الوقت المنقضي
#Else
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long ' فتح مقبض العملية
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long ' إغلاق مقبض العملية
    Private Declare Function ExpandEnvironmentStringsW Lib "kernel32.dll" (ByVal lpSrc As Long, Optional ByVal lpDst As Long, Optional ByVal nSize As Long) As Long ' توسيع متغيرات البيئة
    Private Declare Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long ' جلب رمز الخروج للعملية
    Private Declare Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long ' انتظار العمليات مع معالجة الأحداث
    Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long ' إعادة تخصيص حجم السلسلة
    Private Declare Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As Long) As Long ' إنشاء مؤقت قابل للانتظار
    Private Declare Function GetProcessId Lib "kernel32.dll" (ByVal hProcess As Long) As Long ' جلب معرف العملية
    Private Declare Function PathCanonicalizeW Lib "shlwapi.dll" (ByVal lpszDst As Long, ByVal lpszSrc As Long) As Long ' تبسيط المسار
    Private Declare Function PathGetArgsW Lib "shlwapi.dll" (ByVal pszPath As Long) As Long ' استخراج المعاملات من المسار
    Private Declare Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As Long) As Long ' ضبط المؤقت
    Private Declare Function ShellExecuteExW Lib "shell32.dll" (ByVal pExecInfo As Long) As Long ' تنفيذ أمر عبر Shell
    Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long ' إعادة تخصيص السلسلة
    Private Declare Sub PathRemoveArgsW Lib "shlwapi.dll" (ByVal pszPath As Long) ' إزالة المعاملات من المسار
    Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long ' إنهاء العملية قسريًا
    Private Declare Function GetTickCount Lib "kernel32.dll" () As Long ' لقياس الوقت المنقضي
#End If

'=======================================================================================================================
'------    المتغيرات العامة و الخاصة
Public g_TerminateLoops As Boolean      ' متغير للتحكم في إنهاء الحلقات يدويًا
Private m_IsExecuting As Boolean        ' علامة لمنع التداخل أثناء التنفيذ

'=======================================================================================================================
'-------------------------------------------    الدوال العامة

' تشغيل أمر والانتظار حتى ينتهي مع استجابة الواجهة
Public Function ExecuteAndWait(ByVal CommandLine As String, _
                               Optional ByVal WindowStyle As ShellWindowStyle = WindowNormal, _
                               Optional ByVal RunAsAdmin As Boolean = False, _
                               Optional ByVal MaxWaitMs As Long = PROCESS_TIMEOUT_INFINITE) As Long
    #If VBA7 Then
        Dim ShellParams As ShellExecuteParams
        Dim ProcessHandle As LongPtr
    #Else
        Dim ShellParams As ShellExecuteParams
        Dim ProcessHandle As Long
    #End If
    
    Dim ExpandedPath As String
    Dim Executable As String
    Dim Arguments As String
    Dim startTime As Long
    Dim ExitCode As Long
    Dim Result As Long
    
    If m_IsExecuting Then
        Err.Raise ERR_EXECUTING, "ExecuteAndWait", "عملية أخرى قيد التنفيذ"
    End If
    
    m_IsExecuting = True
    On Error GoTo Cleanup
    
    ' توسيع متغيرات البيئة
    ExpandedPath = ExpandEnvVars(CommandLine)
    
    ' فصل المسار التنفيذي عن المعاملات يدويًا
    If Left(ExpandedPath, 1) = """" Then
        Executable = Mid(ExpandedPath, 2, InStr(2, ExpandedPath, """") - 2)
        Arguments = Trim(Mid(ExpandedPath, InStr(2, ExpandedPath, """") + 2))
    Else
        Dim Parts() As String
        Parts = Split(ExpandedPath, " ", 2)
        Executable = Parts(0)
        If UBound(Parts) > 0 Then Arguments = Parts(1) Else Arguments = ""
    End If
    
    With ShellParams
        .Size = LenB(ShellParams)
        .Mask = SHELL_MASK_NOCLOSEPROCESS Or SHELL_MASK_DOENVSUBST Or SHELL_MASK_SUPPRESS_ERRORS
        .ShowCommand = WindowStyle
        .filePath = CanonicalizePath(Executable) ' المسار التنفيذي فقط
        .Arguments = Arguments ' المعاملات كما هي
        If RunAsAdmin Then .Verb = "runas"
        
        If ShellExecuteExW(VarPtr(ShellParams)) = 0 Then
            Err.Raise ERR_EXECUTION_FAILED, "ExecuteAndWait", "فشل في تنفيذ الأمر: " & CommandLine
        End If
        
        ProcessHandle = .ProcessHandle
    End With
    
    startTime = GetTickCount
    Do
        Result = MsgWaitForMultipleObjects(1, ProcessHandle, False, 100, QS_ALL_INPUT)
        DoEvents
        
        If GetExitCodeProcess(ProcessHandle, ExitCode) Then
            If ExitCode <> PROCESS_STILL_ACTIVE Then Exit Do
        End If
        
        If MaxWaitMs <> PROCESS_TIMEOUT_INFINITE Then
            If (GetTickCount - startTime) > MaxWaitMs Then
                Debug.Print "تجاوز الحد الأقصى للانتظار: " & MaxWaitMs & " ميلي ثانية"
                Exit Do
            End If
        End If
    Loop
    
    ExecuteAndWait = ExitCode

Cleanup:
    If ProcessHandle <> 0 Then CloseHandle ProcessHandle
    m_IsExecuting = False
    If Err.Number <> 0 Then Err.Raise Err.Number, "ExecuteAndWait", Err.Description
End Function

' دالة لتنفيذ أمر مع مهلة زمنية اختيارية وخيار التشغيل كمسؤول
Public Function ExecuteWithTimeout(Command As String, Optional ByVal WindowStyle As ShellWindowStyle = WindowNormal, Optional ByVal TimeoutMs As Long, Optional ByVal RunAsAdmin As Boolean = False, Optional RetryCount As Long = 0) As Long
    #If VBA7 Then
        Dim ShellParams As ShellExecuteParams
        Dim ProcessHandle As LongPtr
    #Else
        Dim ShellParams As ShellExecuteParams
        Dim ProcessHandle As Long
    #End If
    
    Dim ExpandedPath As String
    Dim Executable As String
    Dim Arguments As String
    Dim startTime As Long
    Dim ExitCode As Long
    Dim Result As Long
    Dim RetryIndex As Long
    
    If m_IsExecuting Then
        Err.Raise ERR_EXECUTING, "ExecuteWithTimeout", "عملية أخرى قيد التنفيذ"
    End If
    
    m_IsExecuting = True
    On Error GoTo Cleanup
    
    ExpandedPath = ExpandEnvVars(Command)
    
    ' فصل المسار التنفيذي عن المعاملات يدويًا
    If Left(ExpandedPath, 1) = """" Then
        Executable = Mid(ExpandedPath, 2, InStr(2, ExpandedPath, """") - 2)
        Arguments = Trim(Mid(ExpandedPath, InStr(2, ExpandedPath, """") + 2))
    Else
        Dim Parts() As String
        Parts = Split(ExpandedPath, " ", 2)
        Executable = Parts(0)
        If UBound(Parts) > 0 Then Arguments = Parts(1) Else Arguments = ""
    End If
    
    For RetryIndex = 0 To RetryCount
        With ShellParams
            .Size = LenB(ShellParams)
            .Mask = SHELL_MASK_NOCLOSEPROCESS Or SHELL_MASK_DOENVSUBST Or SHELL_MASK_SUPPRESS_ERRORS
            .ShowCommand = WindowStyle
            .filePath = CanonicalizePath(Executable) ' المسار التنفيذي فقط
            .Arguments = Arguments ' المعاملات كما هي
            If RunAsAdmin Then .Verb = "runas"
            
            If ShellExecuteExW(VarPtr(ShellParams)) = 0 Then
                If RetryIndex = RetryCount Then
                    Err.Raise ERR_EXECUTION_FAILED, "ExecuteWithTimeout", "فشل في تنفيذ الأمر بعد " & RetryCount + 1 & " محاولات: " & Command
                End If
            Else
                ProcessHandle = .ProcessHandle
                Exit For
            End If
        End With
    Next RetryIndex
    
    startTime = GetTickCount
    Do
        Result = MsgWaitForMultipleObjects(1, ProcessHandle, False, 100, QS_ALL_INPUT)
        DoEvents
        
        If GetExitCodeProcess(ProcessHandle, ExitCode) Then
            If ExitCode <> PROCESS_STILL_ACTIVE Then Exit Do
        End If
        
        If TimeoutMs > 0 Then
            If (GetTickCount - startTime) > TimeoutMs Then
                If TerminateProcess(ProcessHandle, PROCESS_TERMINATED) = 0 Then
                    Debug.Print "فشل في إنهاء العملية بعد تجاوز المهلة"
                End If
                ExitCode = PROCESS_TERMINATED
                Exit Do
            End If
        End If
        
        If g_TerminateLoops Then Exit Do
    Loop
    
    ExecuteWithTimeout = ExitCode

Cleanup:
    If ProcessHandle <> 0 Then CloseHandle ProcessHandle
    m_IsExecuting = False
    If Err.Number <> 0 Then Err.Raise Err.Number, "ExecuteWithTimeout", Err.Description
End Function

' دالة لتشغيل أمر باستخدام WScript.Shell مع خيار الانتظار
Public Function ExecuteWScript(ByVal CommandLine As String, Optional ByVal WindowStyle As ShellWindowStyle = WindowNormal, Optional ByVal WaitForCompletion As Boolean = False) As Long
    Dim WScriptShell As Object
    
    On Error GoTo ErrorHandler
    Set WScriptShell = CreateObject("WScript.Shell")
    ExecuteWScript = WScriptShell.Run(CommandLine, WindowStyle, WaitForCompletion)
    Exit Function

ErrorHandler:
    Debug.Print "خطأ في تشغيل الأمر عبر WScript: " & Err.Description
    Err.Raise Err.Number, "ExecuteWScript", "خطأ في تشغيل الأمر عبر WScript: " & Err.Description
End Function

' دالة محسنة لتشغيل أمر باستخدام WScript.Shell والتقاط الناتج
Public Function ExecuteWScriptCapture(ByVal CommandLine As String, Optional ByVal WindowStyle As ShellWindowStyle = WindowNormal) As String
    Dim WScriptShell As Object
    Dim ShellExec As Object
    Dim Output As String
    
    On Error GoTo ErrorHandler
    Set WScriptShell = CreateObject("WScript.Shell")
    Set ShellExec = WScriptShell.Exec(CommandLine)
    
    Do While ShellExec.Status = 0
        DoEvents
    Loop
    Output = ShellExec.StdOut.ReadAll
    
    ExecuteWScriptCapture = Output
    Exit Function

ErrorHandler:
    Debug.Print "خطأ في تشغيل الأمر عبر WScript: " & Err.Description
    ExecuteWScriptCapture = ""
    Err.Raise Err.Number, "ExecuteWScriptCapture", "خطأ في تشغيل الأمر عبر WScript: " & Err.Description
End Function

'=======================================================================================================================
'------    الدوال المساعدة

' دالة لتوسيع متغيرات البيئة في سلسلة (مثل %windir%)
Private Function ExpandEnvVars(ByVal Path As String) As String
    Dim Buffer As String
    Dim Length As Long
    
    If InStr(Path, "%") Then
        Length = ExpandEnvironmentStringsW(StrPtr(Path), 0, 0)
        If Length > 0 Then
            Buffer = String$(Length - 1, vbNullChar)
            If ExpandEnvironmentStringsW(StrPtr(Path), StrPtr(Buffer), Length) Then
                ExpandEnvVars = Left$(Buffer, Length - 1)
            Else
                Debug.Print "فشل توسيع متغيرات البيئة، يتم إرجاع المسار الأصلي: " & Path
                ExpandEnvVars = Path
            End If
        Else
            ExpandEnvVars = Path
        End If
    Else
        ExpandEnvVars = Path
    End If
End Function

' دالة لتبسيط المسار (مثل حل النقاط . و ..)
Private Function CanonicalizePath(ByVal Path As String) As String
    Dim TempPath As String
    If InStr(Path, "\.") Or InStr(Path, ".\") Then
        If Len(Path) < MAX_PATH_LENGTH Then
            TempPath = String$(MAX_PATH_LENGTH - 1, vbNullChar)
            If PathCanonicalizeW(StrPtr(TempPath), StrPtr(Path)) Then
                CanonicalizePath = Left$(TempPath, InStr(TempPath, vbNullChar) - 1)
            Else
                Debug.Print "فشل تبسيط المسار، يتم إرجاع المسار الأصلي: " & Path
                CanonicalizePath = Path
            End If
        Else
            CanonicalizePath = Path
        End If
    Else
        CanonicalizePath = Path
    End If
End Function

' دالة لاستخراج المعاملات من المسار
Private Function ExtractArguments(ByRef Path As String) As String
    SysReAllocString VarPtr(ExtractArguments), PathGetArgsW(StrPtr(Path))
    If LenB(ExtractArguments) Then
        PathRemoveArgsW StrPtr(Path)
        If InStr(ExtractArguments, """") Then ExtractArguments = Replace(ExtractArguments, """", """""")
    End If
End Function

' دالة مساعدة لاستخراج اسم العملية من الأمر
Private Function ExtractProcessName(ByVal CommandLine As String) As String
    Dim Parts() As String
    Dim FirstPart As String
    
    If Left(CommandLine, 1) = """" Then
        FirstPart = Mid(CommandLine, 2, InStr(2, CommandLine, """") - 2)
    Else
        Parts = Split(CommandLine, " ")
        FirstPart = Parts(0)
    End If
    ExtractProcessName = Mid(FirstPart, InStrRev(FirstPart, "\") + 1)
End Function

' دالة لإنهاء عملية باستخدام WMI بناءً على اسم العملية
Public Function KillProcess(sProcessName As String, Optional sHost As String = ".") As Boolean
    On Error GoTo Error_Handler
    Dim oWMI As Object
    Dim sWMIQuery As String
    Dim oCols As Object
    Dim oCol As Object
    
    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    sWMIQuery = "SELECT Name FROM Win32_Process"
    Set oCols = oWMI.ExecQuery(sWMIQuery)
    For Each oCol In oCols
        If LCase(sProcessName) = LCase(oCol.Name) Then
            oCol.Terminate
        End If
    Next oCol
    KillProcess = True
    
Error_Handler_Exit:
    On Error Resume Next
    Set oCol = Nothing
    Set oCols = Nothing
    Set oWMI = Nothing
    Exit Function
    
Error_Handler:
    Debug.Print "خطأ في KillProcess: " & Err.Description & " - رقم الخطأ: " & Err.Number
    KillProcess = False
    Resume Error_Handler_Exit
End Function

اوامر الاستدعاء المختلفة : 

سوف نقوم بعمل وحده نمطيه عامه لتجربة :  WinRAR
اسم الوحده النمطيه : basArchiveExamplesWinRAR

' يضمن مقارنة النصوص بناءً على إعدادات قاعدة البيانات (مثل ترتيب الحروف واللغة)
Option Compare Database
' يجبر على تعريف المتغيرات صراحة قبل استخدامها، مما يمنع الأخطاء الناتجة عن الأسماء الخاطئة
Option Explicit

' وحدة نمطية تحتوي على أمثلة شاملة لضغط وفك ضغط باستخدام WinRAR مع كل الخيارات

' ===========================================================================
' 1. ضغط ملف واحد
' ===========================================================================
' بدون كلمة مرور، مستوى ضغط عادي
Sub CompressSingleFileNoPasswordWinRAR()
    CompressItems "file1.txt", , WinRAR, ArchiveZIP, CompressionNormal
    ' الناتج: file1.rar في CurrentProject.Path
End Sub

' مع كلمة مرور، مستوى ضغط أقصى
Sub CompressSingleFileWithPasswordMaxCompressionWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems "file1.txt", password, WinRAR, ArchiveZIP, CompressionMaximum
    ' الناتج: file1.rar (مشفر، مضغوط بأقصى مستوى) في CurrentProject.Path
End Sub

' مع تقسيم الأرشيف (Split500MB)
Sub CompressSingleFileWithSplitWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems "file1.txt", password, WinRAR, ArchiveRAR, CompressionNormal, Split500MB
    ' الناتج: file1.rar مقسم إلى أجزاء بحجم 500 ميجابايت
End Sub

' ذاتي الاستخراج (SFX) مع تعليق
' ضغط مجلد واحد مع تعليق باستخدام متغير لكلمة المرور
Sub CompressSingleFileSFXWithCommentWinRAR()
    Dim commentLines As Variant
    Dim commentFile As String
    Dim password As String
    
    ' تعيين كلمة المرور
    password = "officena"
    
    ' إعداد التعليق باستخدام المتغير
    commentLines = Array( _
        "منتديات أوفيسنا", _
        "www.officena.net", _
        "وقت وتاريخ إنشاء الأرشيف:", _
        Format(Now, "dd-mm-yyyy hh:nn AM/PM"), _
        "كلمة المرور لفك الضغط: " & password, _
        "مع أطيب الأماني: أبو جودى")
    
    commentFile = CreateCommentFile(commentLines)
    
    ' استخدام كلمة المرور في الضغط
    CompressItems "Folder1", password, WinRAR, ArchiveRAR, CompressionNormal, , , , True, commentFile

    ' الناتج: Folder1.rar (مشفر بكلمة المرور "MS-Access(officena)"، مع تعليق) في CurrentProject.Path
End Sub

' ===========================================================================
' 2. فك ضغط ملف واحد
' ===========================================================================
' بدون كلمة مرور، الكتابة فوق الملفات
Sub ExtractSingleFileNoPasswordOverwriteWinRAR()
    ExtractItems CurrentProject.Path & "\file1.zip", CurrentProject.Path & "\Extracted", , WinRAR, OverwriteAll
    ' الناتج: محتويات file1.rar مفكوكة في CurrentProject.Path\Extracted مع الكتابة فوق الملفات
End Sub

' مع كلمة مرور، تجاهل الملفات الموجودة
Sub ExtractSingleFileWithPasswordNoOverwriteWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    ExtractItems CurrentProject.Path & "\file1.zip", CurrentProject.Path & "\Extracted", password, WinRAR, OverwriteNone
    ' الناتج: محتويات file1.rar مفكوكة في CurrentProject.Path\Extracted مع تجاهل الملفات الموجودة
End Sub

' ===========================================================================
' 3. ضغط عدة ملفات (كل ملف على حدة)
' ===========================================================================
' بدون كلمة مرور، نوع ZIP
Sub CompressMultipleFilesSeparateNoPasswordZipWinRAR()
    Dim filesArray As Variant
    filesArray = Array(CurrentProject.Path & "\file1.txt", CurrentProject.Path & "\file2.docx", CurrentProject.Path & "\file3.pdf")
    StartCompressionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        CompressItems CStr(filePath), , WinRAR, ArchiveZIP, CompressionNormal
    Next filePath
    ShowCompressionSuccess
    ' الناتج: file1.zip, file2.zip, file3.zip في CurrentProject.Path
End Sub

' مع كلمة مرور وتعليق
Sub CompressMultipleFilesSeparateWithCommentWinRAR()
    Dim commentLines As Variant
    Dim commentFile As String
    Dim password As String
    
    ' تعيين كلمة المرور
    password = "officena"
    
    ' إعداد التعليق باستخدام المتغير
    commentLines = Array( _
        "منتديات أوفيسنا", _
        "www.officena.net", _
        "وقت وتاريخ إنشاء الأرشيف:", _
        Format(Now, "dd-mm-yyyy hh:nn AM/PM"), _
        "كلمة المرور لفك الضغط: " & password, _
        "مع أطيب الأماني: أبو جودى")
    
    commentFile = CreateCommentFile(commentLines)
    Dim filesArray As Variant
    filesArray = Array("file1.txt", "file2.docx", "file3.pdf", "Folder1", "Folder2")
    StartCompressionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        CompressItems CStr(filePath), password, WinRAR, ArchiveRAR, CompressionNormal, , , , , commentFile
    Next filePath
    ShowCompressionSuccess
    ' الناتج: file1.rar, file2.rar, file3.rar (مشفرة، مع تعليق) في CurrentProject.Path
End Sub

' ===========================================================================
' 4. فك ضغط عدة ملفات (كل ملف على حدة)
' ===========================================================================
' بدون كلمة مرور
Sub ExtractMultipleFilesSeparateNoPasswordWinRAR()
    Dim filesArray As Variant
    filesArray = Array(CurrentProject.Path & "\file1.rar", CurrentProject.Path & "\file2.rar", CurrentProject.Path & "\file3.rar")
    StartExtractionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        ExtractItems CStr(filePath), CurrentProject.Path, , WinRAR, OverwriteAll
    Next filePath
    ShowExtractionSuccess
    ' الناتج: محتويات كل ملف مفكوكة في CurrentProject.Path
End Sub

' مع كلمة مرور
Sub ExtractMultipleFilesSeparateWithPasswordWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim filesArray As Variant
    filesArray = Array(CurrentProject.Path & "\file1.rar", CurrentProject.Path & "\file2.rar", CurrentProject.Path & "\file3.rar")
    StartExtractionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        ExtractItems CStr(filePath), CurrentProject.Path, password, WinRAR, OverwriteNone
    Next filePath
    ShowExtractionSuccess
    ' الناتج: محتويات كل ملف مفكوكة في CurrentProject.Path مع تجاهل الموجود
End Sub

' ===========================================================================
' 5. ضغط عدة ملفات في أرشيف واحد
' ===========================================================================
' بدون كلمة مرور، تقسيم 100MB
Sub CompressMultipleFilesOneArchiveWithSplitWinRAR()
    Dim files As Variant
    files = Array("file1.txt", "file2.docx", "file3.pdf")
    CompressItems files, , WinRAR, ArchiveRAR, CompressionNormal, Split100MB, , "CompressedFiles"
    ' الناتج: CompressedFiles.rar مقسم إلى أجزاء بحجم 100 ميجابايت
End Sub

' مع كلمة مرور وتعليق
Sub CompressMultipleFilesOneArchiveWithCommentWinRAR()
    Dim commentLines As Variant
    Dim commentFile As String
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    
    ' إعداد التعليق باستخدام المتغير
    commentLines = Array( _
        "منتديات أوفيسنا", _
        "www.officena.net", _
        "وقت وتاريخ إنشاء الأرشيف:", _
        Format(Now, "dd-mm-yyyy hh:nn AM/PM"), _
        "كلمة المرور لفك الضغط: " & password, _
        "مع أطيب الأماني: أبو جودى")
        
    commentFile = CreateCommentFile(commentLines)
    Dim files As Variant
    files = Array("file1.txt", "file2.docx", "file3.pdf")
    CompressItems files, password, WinRAR, ArchiveRAR, CompressionMaximum, , , "CompressedFiles", , commentFile
    ' الناتج: CompressedFiles.rar (مشفر، مع تعليق) في CurrentProject.Path
End Sub

' ===========================================================================
' 6. فك ضغط أرشيف واحد يحتوي على عدة ملفات
' ===========================================================================
' بدون كلمة مرور
Sub ExtractMultipleFilesOneArchiveNoPasswordWinRAR()
    Dim archives As Variant
    archives = Array(CurrentProject.Path & "\CompressedFiles.rar")
    ExtractItems archives, CurrentProject.Path, , WinRAR, OverwriteAll
    ' الناتج: محتويات CompressedFiles.rar مفكوكة في CurrentProject.Path
End Sub

' مع كلمة مرور
Sub ExtractMultipleFilesOneArchiveWithPasswordWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim archives As Variant
    archives = Array(CurrentProject.Path & "\CompressedFiles.rar")
    ExtractItems archives, CurrentProject.Path, password, WinRAR, OverwriteNone
    ' الناتج: محتويات CompressedFiles.rar مفكوكة في CurrentProject.Path مع تجاهل الموجود
End Sub

' ===========================================================================
' 7. ضغط مجلد واحد
' ===========================================================================
' مع تعليق
Sub CompressSingleFolderWithCommentWinRAR()
    Dim commentLines As Variant
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    
    ' إعداد التعليق باستخدام المتغير
    commentLines = Array( _
        "منتديات أوفيسنا", _
        "www.officena.net", _
        "وقت وتاريخ إنشاء الأرشيف:", _
        Format(Now, "dd-mm-yyyy hh:nn AM/PM"), _
        "كلمة المرور لفك الضغط: " & password, _
        "مع أطيب الأماني: أبو جودى")
        
    Dim commentFile As String
    commentFile = CreateCommentFile(commentLines)
    CompressItems CurrentProject.Path & "\Folder1", password, WinRAR, ArchiveRAR, CompressionNormal, , , , , commentFile
    ' الناتج: Folder1.rar (مشفر، مع تعليق) في CurrentProject.Path
End Sub

' مع تقسيم وSFX
Sub CompressSingleFolderWithSplitSFXWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems CurrentProject.Path & "\Folder1", password, WinRAR, ArchiveRAR, CompressionNormal, Split1GB, , "Folder1SFX", True
    ' الناتج: Folder1SFX.exe مقسم إلى أجزاء بحجم 1 جيجابايت
End Sub

' ===========================================================================
' 8. ضغط عدة مجلدات (كل مجلد على حدة)
' ===========================================================================
' بدون كلمة مرور
Sub CompressMultipleFoldersNoPasswordWinRAR()
    Dim foldersArray As Variant
    foldersArray = Array(CurrentProject.Path & "\Folder1", CurrentProject.Path & "\Folder2")
    StartCompressionLoop
    Dim folderPath As Variant
    For Each folderPath In foldersArray
        CompressItems CStr(folderPath), , WinRAR, ArchiveRAR, CompressionNormal
    Next folderPath
    ShowCompressionSuccess
    ' الناتج: Folder1.rar, Folder2.rar في CurrentProject.Path
End Sub

' مع كلمة مرور وتعليق
Sub CompressMultipleFoldersWithCommentWinRAR()
    Dim commentLines As Variant
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    
    ' إعداد التعليق باستخدام المتغير
    commentLines = Array( _
        "منتديات أوفيسنا", _
        "www.officena.net", _
        "وقت وتاريخ إنشاء الأرشيف:", _
        Format(Now, "dd-mm-yyyy hh:nn AM/PM"), _
        "كلمة المرور لفك الضغط: " & password, _
        "مع أطيب الأماني: أبو جودى")
        
    Dim commentFile As String
    commentFile = CreateCommentFile(commentLines)
    Dim foldersArray As Variant
    foldersArray = Array(CurrentProject.Path & "\Folder1", CurrentProject.Path & "\Folder2")
    StartCompressionLoop
    Dim folderPath As Variant
    For Each folderPath In foldersArray
        CompressItems CStr(folderPath), password, WinRAR, ArchiveRAR, CompressionNormal, , , , , commentFile
    Next folderPath
    ShowCompressionSuccess
    ' الناتج: Folder1.rar, Folder2.rar (مشفرة، مع تعليق) في CurrentProject.Path
End Sub

' ===========================================================================
' 9. فك ضغط مجلد واحد
' ===========================================================================
' بدون كلمة مرور
Sub ExtractSingleFolderNoPasswordWinRAR()
    ExtractItems CurrentProject.Path & "\Folder1.rar", CurrentProject.Path & "\Extracted", , WinRAR, OverwriteAll
    ' الناتج: محتويات Folder1.rar مفكوكة في CurrentProject.Path\Extracted
End Sub

' مع كلمة مرور
Sub ExtractSingleFolderWithPasswordWinRAR()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    ExtractItems CurrentProject.Path & "\Folder1.rar", CurrentProject.Path & "\Extracted", password, WinRAR, OverwriteNone
    ' الناتج: محتويات Folder1.rar مفكوكة في CurrentProject.Path\Extracted مع تجاهل الموجود
End Sub

سوف نقوم بعمل وحده نمطيه عامه لتجربة :  7Zip
اسم الوحده النمطيه : basArchiveExamples7Zip

' يضمن مقارنة النصوص بناءً على إعدادات قاعدة البيانات (مثل ترتيب الحروف واللغة)
Option Compare Database
' يجبر على تعريف المتغيرات صراحة قبل استخدامها، مما يمنع الأخطاء الناتجة عن الأسماء الخاطئة
Option Explicit


' وحدة نمطية تحتوي على أمثلة شاملة لضغط وفك ضغط باستخدام 7-Zip مع كل الخيارات

' ===========================================================================
' 1. ضغط ملف واحد
' ===========================================================================
' بدون كلمة مرور، مستوى ضغط عادي
Sub CompressSingleFileNoPasswordSevenZip()
    CompressItems "file1.txt", , SevenZip, Archive7z, CompressionNormal
    ' الناتج: file1.7z في CurrentProject.Path
End Sub

' مع كلمة مرور، مستوى ضغط أقصى
Sub CompressSingleFileWithPasswordMaxCompressionSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems "file1.txt", password, SevenZip, Archive7z, CompressionMaximum
    ' الناتج: file1.7z (مشفر، مضغوط بأقصى مستوى) في CurrentProject.Path
End Sub

' مع تقسيم الأرشيف (Split500MB)
Sub CompressSingleFileWithSplitSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems "file1.txt", password, SevenZip, Archive7z, CompressionNormal, Split500MB
    ' الناتج: file1.7z مقسم إلى أجزاء بحجم 500 ميجابايت
End Sub

' ذاتي الاستخراج (SFX)
Sub CompressSingleFileSFXSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems "file1.txt", password, SevenZip, Archive7z, CompressionNormal, , , "File1SFX", True
    ' الناتج: File1SFX.exe (مشفر) في CurrentProject.Path
End Sub

' ===========================================================================
' 2. فك ضغط ملف واحد
' ===========================================================================
' بدون كلمة مرور، الكتابة فوق الملفات
Sub ExtractSingleFileNoPasswordOverwriteSevenZip()
    ExtractItems CurrentProject.Path & "\file1.7z", CurrentProject.Path & "\Extracted", , SevenZip, OverwriteAll
    ' الناتج: محتويات file1.7z مفكوكة في CurrentProject.Path\Extracted مع الكتابة فوق الملفات
End Sub

' مع كلمة مرور، تجاهل الملفات الموجودة
Sub ExtractSingleFileWithPasswordNoOverwriteSevenZip()
    ExtractItems CurrentProject.Path & "\file1.7z", CurrentProject.Path & "\Extracted", "MyPassword123", SevenZip, OverwriteNone
    ' الناتج: محتويات file1.7z مفكوكة في CurrentProject.Path\Extracted مع تجاهل الملفات الموجودة
End Sub

' ===========================================================================
' 3. ضغط عدة ملفات (كل ملف على حدة)
' ===========================================================================
' بدون كلمة مرور
Sub CompressMultipleFilesSeparateNoPasswordSevenZip()
    Dim filesArray As Variant
    filesArray = Array("file1.txt", CurrentProject.Path & "\file2.docx", CurrentProject.Path & "\file3.pdf")
    StartCompressionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        CompressItems CStr(filePath), , SevenZip, Archive7z, CompressionNormal
    Next filePath
    ShowCompressionSuccess
    ' الناتج: file1.7z, file2.7z, file3.7z في CurrentProject.Path
End Sub

' مع كلمة مرور وتقسيم
Sub CompressMultipleFilesSeparateWithSplitSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim filesArray As Variant
    filesArray = Array(CurrentProject.Path & "\file1.txt", CurrentProject.Path & "\file2.docx", CurrentProject.Path & "\file3.pdf")
    StartCompressionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        CompressItems CStr(filePath), password, SevenZip, Archive7z, CompressionNormal, Split100MB
    Next filePath
    ShowCompressionSuccess
    ' الناتج: file1.7z, file2.7z, file3.7z مقسمة إلى أجزاء بحجم 100 ميجابايت
End Sub

' ===========================================================================
' 4. فك ضغط عدة ملفات (كل ملف على حدة)
' ===========================================================================
' بدون كلمة مرور
Sub ExtractMultipleFilesSeparateNoPasswordSevenZip()
    Dim filesArray As Variant
    filesArray = Array(CurrentProject.Path & "\file1.7z", CurrentProject.Path & "\file2.7z", CurrentProject.Path & "\file3.7z")
    StartExtractionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        ExtractItems CStr(filePath), CurrentProject.Path, , SevenZip, OverwriteAll
    Next filePath
    ShowExtractionSuccess
    ' الناتج: محتويات كل ملف مفكوكة في CurrentProject.Path
End Sub

' مع كلمة مرور
Sub ExtractMultipleFilesSeparateWithPasswordSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim filesArray As Variant
    filesArray = Array(CurrentProject.Path & "\file1.7z", CurrentProject.Path & "\file2.7z", CurrentProject.Path & "\file3.7z")
    StartExtractionLoop
    Dim filePath As Variant
    For Each filePath In filesArray
        ExtractItems CStr(filePath), CurrentProject.Path, password, SevenZip, OverwriteNone
    Next filePath
    ShowExtractionSuccess
    ' الناتج: محتويات كل ملف مفكوكة في CurrentProject.Path مع تجاهل الموجود
End Sub

' ===========================================================================
' 5. ضغط عدة ملفات في أرشيف واحد
' ===========================================================================
' بدون كلمة مرور، تقسيم 100MB
Sub CompressMultipleFilesOneArchiveWithSplitSevenZip()
    Dim files As Variant
    files = Array("file1.txt", "file2.docx", "file3.pdf")
    CompressItems files, , SevenZip, Archive7z, CompressionNormal, Split100MB, , "CompressedFiles"
    ' الناتج: CompressedFiles.7z مقسم إلى أجزاء بحجم 100 ميجابايت
End Sub

' مع كلمة مرور وSFX
Sub CompressMultipleFilesOneArchiveSFXSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim files As Variant
    files = Array("file1.txt", "file2.docx", "file3.pdf")
    CompressItems files, password, SevenZip, Archive7z, CompressionMaximum, , , "CompressedFilesSFX", True
    ' الناتج: CompressedFilesSFX.exe (مشفر) في CurrentProject.Path
End Sub

' ===========================================================================
' 6. فك ضغط أرشيف واحد يحتوي على عدة ملفات
' ===========================================================================
' بدون كلمة مرور
Sub ExtractMultipleFilesOneArchiveNoPasswordSevenZip()
    Dim archives As Variant
    archives = Array(CurrentProject.Path & "\CompressedFiles.7z")
    ExtractItems archives, CurrentProject.Path, , SevenZip, OverwriteAll
    ' الناتج: محتويات CompressedFiles.7z مفكوكة في CurrentProject.Path
End Sub

' مع كلمة مرور
Sub ExtractMultipleFilesOneArchiveWithPasswordSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim archives As Variant
    archives = Array(CurrentProject.Path & "\CompressedFiles.7z")
    ExtractItems archives, CurrentProject.Path, password, SevenZip, OverwriteNone
    ' الناتج: محتويات CompressedFiles.7z مفكوكة في CurrentProject.Path مع تجاهل الموجود
End Sub

' ===========================================================================
' 7. ضغط مجلد واحد
' ===========================================================================
' مع تقسيم وSFX
Sub CompressSingleFolderWithSplitSFXSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    CompressItems CurrentProject.Path & "\Folder1", password, SevenZip, Archive7z, CompressionNormal, Split1GB, , "Folder1SFX", True
    ' الناتج: Folder1SFX.exe مقسم إلى أجزاء بحجم 1 جيجابايت
End Sub

' ===========================================================================
' 8. ضغط عدة مجلدات (كل مجلد على حدة)
' ===========================================================================
' بدون كلمة مرور
Sub CompressMultipleFoldersNoPasswordSevenZip()
    Dim foldersArray As Variant
    foldersArray = Array(CurrentProject.Path & "\Folder1", CurrentProject.Path & "\Folder2")
    StartCompressionLoop
    Dim folderPath As Variant
    For Each folderPath In foldersArray
        CompressItems CStr(folderPath), , SevenZip, Archive7z, CompressionNormal
    Next folderPath
    ShowCompressionSuccess
    ' الناتج: Folder1.7z, Folder2.7z في CurrentProject.Path
End Sub

' مع كلمة مرور وتقسيم
Sub CompressMultipleFoldersWithSplitSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    Dim foldersArray As Variant
    foldersArray = Array(CurrentProject.Path & "\Folder1", CurrentProject.Path & "\Folder2")
    StartCompressionLoop
    Dim folderPath As Variant
    For Each folderPath In foldersArray
        CompressItems CStr(folderPath), password, SevenZip, Archive7z, CompressionNormal, Split500MB
    Next folderPath
    ShowCompressionSuccess
    ' الناتج: Folder1.7z, Folder2.7z مقسمة إلى أجزاء بحجم 500 ميجابايت
End Sub

' ===========================================================================
' 9. فك ضغط مجلد واحد
' ===========================================================================
' بدون كلمة مرور
Sub ExtractSingleFolderNoPasswordSevenZip()
    ExtractItems CurrentProject.Path & "\Folder1.7z", CurrentProject.Path & "\Extracted", , SevenZip, OverwriteAll
    ' الناتج: محتويات Folder1.7z مفكوكة في CurrentProject.Path\Extracted
End Sub

' مع كلمة مرور
Sub ExtractSingleFolderWithPasswordSevenZip()
    Dim password As String
    ' تعيين كلمة المرور
    password = "officena"
    ExtractItems CurrentProject.Path & "\Folder1.7z", CurrentProject.Path & "\Extracted", password, SevenZip, OverwriteNone
    ' الناتج: محتويات Folder1.7z مفكوكة في CurrentProject.Path\Extracted مع تجاهل الموجود
End Sub

 

وأخيــــر وحده نمطيه عامة لضغط قاعدة البيانات الحاليه(  الأمامية أو الخلفيه أو الأمامية والخلفية معا أو القاعدة الحاليه فقط ان لم تكن منقسمه )

اسم الوحدة النمطية : basCompressDatabase

الكود

' يضمن مقارنة النصوص بناءً على إعدادات قاعدة البيانات (مثل ترتيب الحروف واللغة)
Option Compare Database
' يجبر على تعريف المتغيرات صراحة قبل استخدامها، مما يمنع الأخطاء الناتجة عن الأسماء الخاطئة
Option Explicit

' تعداد لتحديد نوع القاعدة المراد ضغطها
Enum EnumDatabaseType
    FrontEndOnly = 0    ' ضغط القاعدة الحالية (Front-End) فقط
    BackEndOnly = 1     ' ضغط القاعدة الخلفية (Back-End) فقط
    BothFrontAndBack = 2 ' ضغط القاعدة الحالية والخلفية معًا
End Enum


' دالة لضغط قاعدة البيانات الحالية و/أو الخلفية بناءً على الخيارات
' المدخلات:
'   - dbType: نوع القاعدة المراد ضغطها (Front-End، Back-End، أو الاثنين)
'   - archiveName: اسم الأرشيف الناتج (اختياري، لو فارغ بيستخدم اسم القاعدة)
'   - targetPath: مسار حفظ الأرشيف (اختياري، لو فارغ بيستخدم مسار القاعدة)
'   - Method: أداة الضغط (WinRAR أو SevenZip، افتراضي SevenZip)
'   - ArchiveType: نوع الأرشيف (افتراضي Archive7z)
'   - compressionLevel: مستوى الضغط (افتراضي CompressionNormal)
'   - password: كلمة المرور لتشفير الأرشيف (اختياري)
'   - commentFile: مسار ملف التعليقات لإضافته إلى الأرشيف (اختياري)
' دالة لضغط قاعدة البيانات الحالية و/أو الخلفية بناءً على الخيارات
' المدخلات:
'   - dbType: نوع القاعدة المراد ضغطها (Front-End، Back-End، أو الاثنين)
'   - archiveName: اسم الأرشيف الناتج (اختياري، لو فارغ بيستخدم اسم القاعدة)
'   - targetPath: مسار حفظ الأرشيف (اختياري، لو فارغ بيستخدم مسار القاعدة)
'   - Method: أداة الضغط (WinRAR أو SevenZip، افتراضي SevenZip)
'   - ArchiveType: نوع الأرشيف (افتراضي Archive7z)
'   - compressionLevel: مستوى الضغط (افتراضي CompressionNormal)
'   - password: كلمة المرور لتشفير الأرشيف (اختياري)
'   - commentFile: مسار ملف التعليقات لإضافته إلى الأرشيف (اختياري)
'   - showHelp: عرض تعليمات قبل الضغط إذا كان True (افتراضي False)
' دالة لضغط قاعدة البيانات الحالية و/أو الخلفية بناءً على الخيارات
' المدخلات:
'   - dbType: نوع القاعدة المراد ضغطها (إجباري: FrontEndOnly, BackEndOnly, BothFrontAndBack)
'   - archiveName: اسم الأرشيف الناتج (اختياري، لو فارغ بيستخدم اسم القاعدة)
'   - targetPath: مسار حفظ الأرشيف (اختياري، لو فارغ بيستخدم مسار القاعدة)
'   - Method: أداة الضغط (اختياري: WinRAR أو SevenZip، افتراضي SevenZip)
'   - ArchiveType: نوع الأرشيف (اختياري، افتراضي Archive7z)
'   - compressionLevel: مستوى الضغط (اختياري، افتراضي CompressionNormal)
'   - password: كلمة المرور لتشفير الأرشيف (اختياري)
'   - commentFile: مسار ملف التعليقات لإضافته إلى الأرشيف (اختياري)
Sub CompressDatabase( _
    ByVal dbType As EnumDatabaseType, _
    Optional ByVal archiveName As String = "", _
    Optional ByVal targetPath As String = "", _
    Optional ByVal Method As EnumArchiveMethod = SevenZip, _
    Optional ByVal ArchiveType As EnumArchiveType = Archive7z, _
    Optional ByVal compressionLevel As EnumCompressionLevel = CompressionNormal, _
    Optional ByVal password As String = "", _
    Optional ByVal commentFile As String = "")
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    On Error GoTo ErrorHandler
    
    ' التحقق من صحة dbType
    If dbType < FrontEndOnly Or dbType > BothFrontAndBack Then
        MsgBox "خطأ: نوع القاعدة (dbType) غير صحيح!", vbExclamation
        ShowHelp
        Exit Sub
    End If
    
    ' متغيرات لتخزين مسارات القاعدة
    Dim frontEndPath As String
    Dim backEndPath As String
    Dim tempFrontEndPath As String
    Dim tempBackEndPath As String
    
    ' الحصول على مسار القاعدة الحالية (Front-End)
    frontEndPath = CurrentDb.Name ' مثل: "C:\Users\YourUser\Documents\FrontEnd.accdb"
    
    ' الحصول على مسار القاعدة الخلفية (Back-End) إذا كانت موجودة
    backEndPath = GetBackEndPath()
    
    ' تحديد المسارات المؤقتة في مجلد Temp
    tempFrontEndPath = Environ$("TEMP") & "\" & fso.GetFileName(frontEndPath)
    If backEndPath <> "" Then
        tempBackEndPath = Environ$("TEMP") & "\" & fso.GetFileName(backEndPath)
    End If
    
    ' تحديد مسار واسم الأرشيف الناتج
    Dim finalTargetPath As String
    finalTargetPath = IIf(targetPath = "", fso.GetParentFolderName(frontEndPath), targetPath)
    
    ' معالجة حسب نوع القاعدة المطلوب
    Select Case dbType
        Case FrontEndOnly
            ' ضغط القاعدة الحالية فقط
            fso.CopyFile frontEndPath, tempFrontEndPath, True
            Dim frontEndArchiveName As String
            frontEndArchiveName = IIf(archiveName = "", fso.GetBaseName(frontEndPath), archiveName) & GetArchiveExtension(ArchiveType)
            Dim uniqueFrontEndArchive As String
            uniqueFrontEndArchive = GenerateUniqueFileName(finalTargetPath, frontEndArchiveName)
            CompressItems tempFrontEndPath, password, Method, ArchiveType, compressionLevel, SplitNone, finalTargetPath, fso.GetBaseName(uniqueFrontEndArchive), , commentFile
            If fso.FileExists(tempFrontEndPath) Then fso.DeleteFile tempFrontEndPath
            
        Case BackEndOnly
            ' ضغط القاعدة الخلفية فقط
            If backEndPath = "" Then
                MsgBox "لا توجد قاعدة خلفية مرتبطة!", vbExclamation
                Exit Sub
            End If
            fso.CopyFile backEndPath, tempBackEndPath, True
            Dim backEndArchiveName As String
            backEndArchiveName = IIf(archiveName = "", fso.GetBaseName(backEndPath), archiveName) & GetArchiveExtension(ArchiveType)
            Dim uniqueBackEndArchive As String
            uniqueBackEndArchive = GenerateUniqueFileName(finalTargetPath, backEndArchiveName)
            CompressItems tempBackEndPath, password, Method, ArchiveType, compressionLevel, SplitNone, finalTargetPath, fso.GetBaseName(uniqueBackEndArchive), , commentFile
            If fso.FileExists(tempBackEndPath) Then fso.DeleteFile tempBackEndPath
            
        Case BothFrontAndBack
            ' ضغط القاعدتين معًا
            If backEndPath = "" Then
                MsgBox "لا توجد قاعدة خلفية، سيتم ضغط القاعدة الحالية فقط!", vbInformation
                fso.CopyFile frontEndPath, tempFrontEndPath, True
                Dim singleArchiveName As String
                singleArchiveName = IIf(archiveName = "", fso.GetBaseName(frontEndPath) & "_Full", archiveName) & GetArchiveExtension(ArchiveType)
                Dim uniqueSingleArchive As String
                uniqueSingleArchive = GenerateUniqueFileName(finalTargetPath, singleArchiveName)
                CompressItems tempFrontEndPath, password, Method, ArchiveType, compressionLevel, SplitNone, finalTargetPath, fso.GetBaseName(uniqueSingleArchive), , commentFile
                If fso.FileExists(tempFrontEndPath) Then fso.DeleteFile tempFrontEndPath
            Else
                fso.CopyFile frontEndPath, tempFrontEndPath, True
                fso.CopyFile backEndPath, tempBackEndPath, True
                Dim bothFiles(1) As String
                bothFiles(0) = tempFrontEndPath
                bothFiles(1) = tempBackEndPath
                Dim bothArchiveName As String
                bothArchiveName = IIf(archiveName = "", fso.GetBaseName(frontEndPath) & "_Full", archiveName) & GetArchiveExtension(ArchiveType)
                Dim uniqueBothArchive As String
                uniqueBothArchive = GenerateUniqueFileName(finalTargetPath, bothArchiveName)
                CompressItems bothFiles, password, Method, ArchiveType, compressionLevel, SplitNone, finalTargetPath, fso.GetBaseName(uniqueBothArchive), , commentFile
                If fso.FileExists(tempFrontEndPath) Then fso.DeleteFile tempFrontEndPath
                If fso.FileExists(tempBackEndPath) Then fso.DeleteFile tempBackEndPath
            End If
    End Select
    
    Set fso = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "خطأ في ضغط قاعدة البيانات: " & Err.Description, vbCritical
    LogError "CompressDatabase Error: " & Err.Description
    ShowHelp ' عرض التعليمات عند حدوث أي خطأ
    ' تنظيف الملفات المؤقتة في حالة الخطأ
    If fso.FileExists(tempFrontEndPath) Then fso.DeleteFile tempFrontEndPath
    If fso.FileExists(tempBackEndPath) Then fso.DeleteFile tempBackEndPath
    Set fso = Nothing
End Sub

' دالة مساعدة للحصول على مسار القاعدة الخلفية من الجداول المرتبطة
Private Function GetBackEndPath() As String
    On Error GoTo ErrorHandler
    Dim tdf As DAO.TableDef
    Dim db As DAO.Database
    Set db = CurrentDb
    
    ' فحص الجداول المرتبطة
    For Each tdf In db.TableDefs
        If Len(tdf.Connect) > 0 Then ' إذا كان الجدول مرتبطًا
            ' استخراج المسار من خاصية Connect
            Dim connectString As String
            connectString = tdf.Connect
            If InStr(connectString, "DATABASE=") > 0 Then
                GetBackEndPath = Mid(connectString, InStr(connectString, "DATABASE=") + 9)
                Exit Function
            End If
        End If
    Next tdf
    
    ' إذا لم يتم العثور على قاعدة خلفية
    GetBackEndPath = ""
    Exit Function

ErrorHandler:
    GetBackEndPath = ""
End Function

' توليد اسم ملف فريد
Public Function GenerateUniqueFileName(Folderpath As String, Filename As String) As String
    Dim baseName As String
    Dim extension As String
    Dim counter As Integer
    Dim uniqueName As String

    baseName = Left(Filename, InStrRev(Filename, ".") - 1)
    extension = Mid(Filename, InStrRev(Filename, "."))
    uniqueName = Folderpath & "\" & Filename

    counter = 1
    Do While Dir(uniqueName) <> ""
        uniqueName = Folderpath & "\" & baseName & " (" & counter & ")" & extension
        counter = counter + 1
    Loop

    GenerateUniqueFileName = uniqueName
End Function

' إجراء لتسجيل الأخطاء في ملف نصي بمسار المشروع الحالي
Sub LogError(errorMessage As String)
    Dim logFile As String
    logFile = CurrentProject.Path & "\ErrorLog.txt"
    
    Open logFile For Append As #1
    Print #1, Now & " - " & errorMessage
    Close #1
End Sub

' إجراء لعرض نافذة تعليمات تحتوي على تعريف الباراميترات
Sub ShowHelp()
    MsgBox "تعليمات CompressDatabase:" & vbCrLf & _
           "الباراميترات:" & vbCrLf & _
           "- dbType (إجباري): نوع القاعدة المراد ضغطها" & vbCrLf & _
           "  * FrontEndOnly: ضغط القاعدة الحالية فقط" & vbCrLf & _
           "  * BackEndOnly: ضغط القاعدة الخلفية فقط" & vbCrLf & _
           "  * BothFrontAndBack: ضغط القاعدتين معًا" & vbCrLf & _
           "- archiveName (اختياري): اسم الأرشيف، لو فارغ يستخدم اسم القاعدة" & vbCrLf & _
           "- targetPath (اختياري): مسار الحفظ، لو فارغ يستخدم مسار القاعدة" & vbCrLf & _
           "- Method (اختياري): أداة الضغط (WinRAR أو SevenZip)، افتراضي SevenZip" & vbCrLf & _
           "- ArchiveType (اختياري): نوع الأرشيف (مثل Archive7z, ArchiveZIP)، افتراضي Archive7z" & vbCrLf & _
           "- compressionLevel (اختياري): مستوى الضغط (مثل CompressionNormal)، افتراضي CompressionNormal" & vbCrLf & _
           "- password (اختياري): كلمة المرور للتشفير" & vbCrLf & _
           "- commentFile (اختياري): مسار ملف التعليقات" & vbCrLf & _
           "ملاحظات: راجع التعدادات (EnumDatabaseType, EnumArchiveMethod, EnumArchiveType, EnumCompressionLevel) في الكود", vbInformation
End Sub



Sub TestCompressDatabase()

    Dim commentLines As Variant
    Dim commentFile As String
    Dim password As String
    
    ' تعيين كلمة المرور
    password = "officena"
    
    ' إعداد التعليق باستخدام المتغير
    commentLines = Array( _
        "منتديات أوفيسنا", _
        "www.officena.net", _
        "وقت وتاريخ إنشاء الأرشيف:", _
        Format(Now, "dd-mm-yyyy hh:nn AM/PM"), _
        "كلمة المرور لفك الضغط: " & password, _
        "مع أطيب الأماني: أبو جودى")
        
   commentFile = CreateCommentFile(commentLines)
   
    ' ضغط القاعدة الحالية فقط
   CompressDatabase FrontEndOnly, , , WinRAR, ArchiveZIP, CompressionMaximum, password, commentFile
    
    
''    ' ضغط القاعدة الخلفية فقط (لو موجودة)
''    CompressDatabase BackEndOnly, "MyBackend", "", WinRAR, ArchiveRAR
''    ' الناتج: C:\Backups\MyBackend.zip
''
''    ' ضغط القاعدتين معًا
''    CompressDatabase BothFrontAndBack, "FullBackup", "", WinRAR, ArchiveRAR, CompressionMaximum
''    ' الناتج: C:\Backups\FullBackup.7z يحتوي على الـ Front-End والـ Back-End (لو موجود)
    
End Sub

 

فى انتظار آرائكم بشغف 

انا كتبت اكواد التجربة على  اعتبار وجود المجلدات والملفات فى مسار قاعدة البيانات
على ان يكون اسماء المجلدات كالتالى : 
Folder1
Folder2

واسماء الملفات كالتالى :
file1.txt
file2.docx
file3.pdf

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

ولكن قد أكون أخطأت فى أى شئ بسبب كبر الكود وتشعبه لذلك فى انتظار مراجعتكم وآرائكم ان شاء الله

 

 

التحديثات الأخيــــره

• فى حالة التعامل مع البرامج المحموله امكانيه تحديد مسار التطبيق مره واحده فقط طوال الجلسة الحاليه
• اضافة نسخ محمولة مختلفة الانويه فى مسار القاعدة ل 7-zip  ودعم الكود للعمل من خلالهما مباشرة فى حالة عدم التسطيب
• دعم اضافى لانواع الارشيف المختلفه والتعامل مع الانواع بمرونه اكبر
• اضافة وظائف لضغط قاعدة البيانات الحلفيه سواء كانت امامية فقط أو امامية وخلفيه لكل واحده على حده او كلاهما معا مع اسم فريد للاحتفاظ بالنسخ القديمه المضغوطة بتعداد متزايد

اتمنى لكم تجربة ممتعة 
وأخيـــــــــــرا المرفق

كلمة مرور فك الضغط للمرفق : officena
 

OfficenaZip V2.zip

[ابو جودي]

يعنى انا افضل ابحث وامحص وافكر واكتب فى الكود بالساعات والايام والاسابيع واخليه يشتغل اتنين فى واحد

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

اقسم بالله كل كلمه وكل سطر وكل فكرة فى الكود من كتابتى لم ينقل ولم يقتبس منها اى شئ ولا من اى مكان 

كان البحث عبر صفحات ومواقع الانترنت عن بناء اسطر الاوامر فقط  " Command Line "والخاصىة بالتطبيقات لا أكثر من ذلك ولا أقل

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

تقريبا بفضل الله تعالى قمت بالالمام بكل ما يتعلق بالموضوع ليتم التحكم بكل كبيرة وصغيرة

وفى الاخر لم أجد إهتمام حتى الآن  .. انا زعلان 

جالكم قلب 7 ساعات من نشر المضوع ده بالات بدون أى اهتمام

 

[Foksh]

ايه يا عم ، هو الواحد ما يعرفش ينام ساعتين هنا بهدوووء 😂 ..

رووء كدة وخلينا نركز شوية في الشغل الجامد ده ، وبصراحة الواحد محتاج يركز شوية وهو بكامل قواه البدنية
( أصل لما بكون صايم بكون تفكيري محدود شوية لحد ما نصلي التراويح ) ، هي دي كل الحكاية لا أكثر ولا أقل 😁 .

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

[ابوخليل]

3 دقائق مضت, Foksh said:

ايه يا عم ، هو الواحد ما يعرفش ينام ساعتين هنا بهدوووء 😂 ..

رووء كدة وخلينا نركز شوية في الشغل الجامد ده ، وبصراحة الواحد محتاج يركز شوية وهو بكامل قواه البدنية
( أصل لما بكون صايم بكون تفكيري محدود شوية لحد ما نصلي التراويح ) ، هي دي كل الحكاية لا أكثر ولا أقل 😁 .

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

سبحان الله

هذا ما يجول في نفسي واحببت كتابته

ليه بس استاذ فادي ؟؟ نسخ لصق من افكاري 😕

[ابو جودي]

16 دقائق مضت, Foksh said:

يه يا عم ، هو الواحد ما يعرفش ينام ساعتين هنا بهدوووء 😂 ..

رمضان شهر العمل يا فؤش أفندى مش شهر النوم 

16 دقائق مضت, Foksh said:

رووء كدة وخلينا نركز شوية في الشغل الجامد ده ، وبصراحة الواحد محتاج يركز شوية وهو بكامل قواه البدنية

هو انا بأقول لك شيل الكود واللا بأقولك العب بودى بيلدنج ؟

9 دقائق مضت, ابوخليل said:

( أصل لما بكون صايم بكون تفكيري محدود شوية لحد ما نصلي التراويح ) ، هي دي كل الحكاية لا أكثر ولا أقل 😁 .

هههههههه انا الكود ده تقريبا بأفكر واكتب وأطور فيه من قبل رمضان بحوالى أسبوع وإنقطعت عنه تقريبا أول 3 أيام رمضان ورجعت أكمل تانى وكنت شغال يا فؤش أفندى قبل الفطار وبعد التراويح 

انت بقيت بتتدلع كتير يا فؤش أفندى 

9 دقائق مضت, ابوخليل said:

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

رميت الكود لان والله مكانش فى وقت خلاص وكان لازم اقوم علشان اروح الشغل
ووقت المشاكره كنت لسه منتهى تماما منه تقريبا وجربت وراجعت 70 % من الامثله

بس انا سهلت لكم الدنيا برضو

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

والامثله يا فؤش افندى هتعملها Run  بس 

وبعدين انا ما قلتش حاولوا تفهموا دى خااااااااااالص

اكيد مش هأقولها لكم الصبح وأجى ع المغرب بالكود ده كل واسألكم عملتوا ايه

انا طالب بس مع التجارب للامثلة المختلفة ابداء الرأى 

هل فى اى مشاكل

انا نواتى 64  منتظر لو حد عنده نواة 32 الدنيا تمام معاه واللا فى مشاكل 

انا فى مرحلة عاوز المشاكل 

او لو مفيش مشاكل لو حد حاسس اكواد الاستدعائات فيها تعقيد مثلا يقول 

بالرغم والله دى اسهل حاجه قدرت اوصلها او بمعنى أدق ده افضل واسهل طريقه للاستدعاء خطرت  على بالى جالت بأفكارى المحدوده

ولأن أنا مقتنع مليون % أن القارئ كالحالب والسامع كالشارب 

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

مش بأقول لك انت بقيت بتتدلع كتيــــر 

 

[ابو جودي]

22 دقائق مضت, ابوخليل said:

سبحان الله

هذا ما يجول في نفسي واحببت كتابته

ليه بس استاذ فادي ؟؟ نسخ لصق من افكاري 😕

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

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

فلا وجه شبه اصلا بين المصابيح   والنجوم المتلئلئة  

[Foksh]

منذ ساعه, ابوخليل said:

سبحان الله

هذا ما يجول في نفسي واحببت كتابته

ليه بس استاذ فادي ؟؟ نسخ لصق من افكاري 😕

لي النصيب الكبير أن تكون أفكاركم معلمنا القدير محل تفكيري وخاطري .. 

 

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

فلا وجه شبه اصلا بين المصابيح   والنجوم المتلئلئة  

هههههههه خفت انت  ، ما تخافش انا قبل المغرب حالياً هادي ، وبعد المغرب بكون برضو هادي هههههههههه

يا مزوء انت ياللي بتعرف ترتب الكلام وتظبطه على التمام 💖

[ابو جودي]

10 دقائق مضت, Foksh said:

هههههههه خفت انت  

ههههههههه طبها لازم اخاف

بس انا برضو قلت انك مصباح بتضوى ضلمات حياتنا بنورك يا عسل ما لنا غنى عنك جميل 

لكن برضو النجوم حاجه تانيه و فى حته تانيه خااااااااااااااااااااالص  

 

[ابوخليل]

منذ ساعه, ابو جودي said:

ههههههههه طبها لازم اخاف

بس انا برضو قلت انك مصباح بتضوى ضلمات حياتنا بنورك يا عسل ما لنا غنى عنك جميل 

لكن برضو النجوم حاجه تانيه و فى حته تانيه خااااااااااااااااااااالص  

 

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

انتم مصابيح تنير الطريق وقريبة بين الأيدي واضحة وقوية

والنجوم صحيح لامعة ولكنها ليست كالمصابيح في الإضاءة .. وتحجب غالبا من عوامل كثيرة كالغيوم مثلا

وقفة : آفة العلم النسيان

[ابو جودي]

9 ساعات مضت, ابوخليل said:

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

انتم مصابيح تنير الطريق وقريبة بين الأيدي واضحة وقوية

والنجوم صحيح لامعة ولكنها ليست كالمصابيح في الإضاءة .. وتحجب غالبا من عوامل كثيرة كالغيوم مثلا

وقفة : آفة العلم النسيان

استاذى الجليل و معلمى القدير و والدى الحبيب 

بالعكس انا للمرة الاولى فى حياتى اختلف مع حضرتك

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

[abouelhassan]

شكر وتقدير واحترام من اخيك

[Moosak]

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

كل الشكر والتقدير لك أستاذ @ابو جودي على هذي التحفة الفنية 🙂 

أنا جمعت البتاع كله في ملفات لتسهيل التطبيق على الاخوة 🙂

وبعد التجربة لم يتم إنشاء الملف المضغوط وظهرت لي هذه الرسالة من WinRAR :

وبعدها :

ولكن لا يتم إنشاء الملف !! 🙂 

طبعا هذا يحصل في الدوال الثلاث الأولى : 

وهذه : 

وهذه :

وهذا:

وهذا :

وهذا : 

وغيرها ..... 😅🖐🏻

الخلاصة : أنت راجع كل الدوال كلها .. وهناك كم دالة هم اللي أشتغلوا فقط والباقي لا .

 

Automate compression and decompression processes for files and folders.zip

[ابو جودي]

15 ساعات مضت, Moosak said:

ولكن لا يتم إنشاء الملف !! 🙂 

طبعا هذا يحصل في الدوال الثلاث الأولى :

الخلاصة : أنت راجع كل الدوال كلها .. وهناك كم دالة هم اللي أشتغلوا فقط والباقي لا .

 

اولا المشكله كانت بسبب استخدام الكود بدون تمرير المسار الكامل

وكانت هذه هى الفكرة الاخيرة التى كنت اطمح فى الوصول اليها  

طبعا هذا المسار نسبى لانه فى مسار قاعدة البيانات وكانت المشكلة فى الكود الرئيسي :BuildCompressCommand

بحمد الله قمت بحل المشكله : تم تعديل الاكواد فى رأس الموضوع , وكذلك تمت اضافة المرفق فى رأس الموضوع 

اعتذر على التأخير فى الرد عليكم وعلى التأخير فى وضع المرفق 

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

 

شكرا لك من القلب يا استاذ @Moosak 

الان تم اضافة المرفق فى رأس الموضوع وهنا ايضا

OfficenaZip.zip

 

[Moosak]

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

الان تم اضافة المرفق فى رأس الموضوع وهنا ايضا

شكرا يا معلم .. أشتغلت بنجاح 😊👌

[ابو جودي]

تم تحديث الموضوع الاساسى فى المشاركة الاولى بالاكواد الجديده المعدله

وتم اضافة نسخة مطوره للمرفق النهائى كذلك  

[محمد احمد لطفى]

تم التجربة والبرنامج يعمل بلا أخطاء

[ابو جودي]

في 26‏/3‏/2025 at 04:16, محمد احمد لطفى said:

تم التجربة والبرنامج يعمل بلا أخطاء

الحمد لله تعالى

اشكرك جدا يا صديقى العزيز وسعيد جدا جدا بمرورك واهتمامك