التعامل مع الريجيستري [ Windows Registry ] من خلال الـ Win_API يدعم 32x و 64x من خلال [ Class Module ]

[Ahmos]

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

الأخوة الكرام بارك الله فيكم

تجدون بالملف المرفق قاعدة بيانات بها

- [ awsReg ] وهو Class Module للتحكم بالريجيستري [ Windows Registry ]
- [ awsReg_Test_Module ] وهو مديول به نماذج لتوضيح كيفية  للإستخدام 
  حاولت قدر المستطاع تغطية جميع الإستخدامات

- [ باقي المديولز ] هي ضرورية للعمل

نبذة مختصرة
 - مصدر الكود من هنا : 
   https://learn.microsoft.com/en-us/previous-versions/office/developer/office2000/aa155731(v=office.10)?redirectedfrom=MSDN&ref=nolongerset.com
 - من قام بتعديل التعريفات لتناسب 64x من هنا :
   https://nolongerset.com/regop-class-for-64-bit-vba/

  - قمت بفضل الله ونعمتة ( الحمد كله لله أوله وأخره)
     1- دمج وتجهيز الكود بالكامل 😁
     2- تعديل نظام عرض الرسائل والأخصاء بالكامل يدعم اللغة ( العربية - الإنجليزية )
     3- تعديل وظيفة allValue لتعود بي 3D Array القيمة والبيانات ونوعها
     4- تعديل وظيفة value لتعود بي 2D array البيانات ونوعها
     5- إضافة وظيفة allKeysDict - [Get Property] لتعود بالمفاتيح الفرعية داخل قاموس
     6- إضافة وظيفة allValuesDict - [Get Property] لتعود بالقيم الموجودة في مفتاح داخل قاموس
     7- إضافة وظيفة IsKeyExists لتعود بنعم إذا كان المفتاح موجود (تم إضافة الـ Api الخاص بها)
     8- إضافة وظيفة IsValueExists لتعود بنعم إذا كانت القيمة موجودة
     9- التعديل علي بعض الأكواد وإضافة وظائف أخري (قد نأتي لذكرها لاحقاً "إن شاء الله"

شرح لمثال واحد [ كتابة قيم داخل الريجيستري ]
باقي الأمثلة موجودة بالملف
 

Public Sub Test_awsReg_WriteValues()
    Dim winReg      As awsReg
    Dim sPath       As String
    Dim sValue      As String
    Dim vResult     As Variant
    
    On Error GoTo ErrorHandler
    
    sPath = "Software\awsApp"   ' awsApp Doesn't Exist Yet
    
    Set winReg = New awsReg
    With winReg
        .useDebug = debugState
        .useMsgLog = msgLogState
        .MsgLanguage = englishMsg
        .Root = HKEY_CURRENT_USER
        .key = sPath
        
        ' REG_SZ Writing a string value
        .value("MyString") = "Hello, World!"
        .value("Date") = Format(Now, "yyyy-mm-dd hh:nn:ss")
        .value("awsPath") = "%USERPROFILE%\Documents"
        
        ' REG_DWORD Writing a numeric value [0 For False] [1 For True]
        .value("isValid") = CInt(1)
        .value("myNumber") = 2341
        
        .Options = StoreNumbersAsStrings    'this to store numbers as String
        .value("strNumer") = 5246
        ' REG_MULTI_SZ Writing an array (multi-string value)
        Dim myArray(2) As String
        myArray(0) = "Value1"
        myArray(1) = "Value2"
        myArray(2) = "Value3"
        .value("MyArray") = myArray

        Debug.Print "Values written successfully"
    End With

ExitAndClean:
    If Not winReg Is Nothing Then Set winReg = Nothing
    Exit Sub
    
ErrorHandler:
    MsgLog "We Received an unknown Error" & vbCrLf & _
                   "Error Number : " & Err.Number & vbCrLf & _
                   "Description  : " & Err.description _
                   , llCritical, debugState, msgLogState, "Unknown Error"
    Resume ExitAndClean

End Sub

النتيجة :

 

الأخوة الكرام الكود متاح للجميع نسعد بتعديلاتكم ومشاركتكم وإستفساركم
بالتوفيق

winRegApi_V1_FN.zip

[Foksh]

الله يعطيك العافية على مجهودك اخي الكريم @Ahmos .

عندي نقطة اذا سمحت بتوضيحها لي وهي ؛ ما الهدف من الفكرة والذي سيحققه الكود من الريجستري !!!!!!

ارجو التوضيح بشكل مبسط 😇

[Ahmos]

أخي الكريم @Foksh
الأخوة الكرام صبحكم الله بالخير

1- إلغاء وتفعيل الحماية الخاصة بـ application.FollowHyperlink

2- إضافة مسار البرنامج لـالــ  Access\Security\Trusted Locations

3- يعتبر الرجستري وسيط بين الوجهات المتعددة
    مثال 1 :
       أعمل بكود لضبط وتحجيم أبعاد الاكسيس والتعامل مع أكثر من شاشة
       بحيث يسمح للمستخدم بعرض البرنامج علي الشاشة 1 او 2 إن كان متصل بالجهاز أكثر من شاشة
       وإن كانت الابعاد مختلفة تختلف أبعاد البرنامج وهو يعتمد علي الجداول بشكل أساسي
       وإن كان هناك أكثر من واجهة تحتاج إلي تطبيق الامر علي كل واجهة
       ولكن الريجيستري يعتبر وسيط يسمح لك بتمرير القيم وإستدعائها وتعين قيم افتراضية

    مثال 2 :
       يمكن إستخدامة في حماية البرنامج الخاص بك فإضافة قيم في الريجيستري تسمح لك بالتحقق من
         - متي أول مرة تم إستخدام البرنامج (للمدة التجريبة)
         - إضافة مفاتيح خاصة بكل جهاز
         - الأفكار كثيرة 
    أظن كدا فكرة الوساطة واضحة وأتمني أسمع أفكاركم 🧠

4- إستدعاء بعض المعلومات التي تحتاج إليها مثل
         - معرفة مسار النظام الافتراضي [ HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion ]
         - معرفة جميع الطابعات الموجودة [ HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Printers ]
         - معرفة الطابعة الإفتراضية [ HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows ] ثم [ Device ] 

5 - تغير الإعدادات
         - تغير الطابعة الإفتراضية
         - عدم السماح للوندوز بتجاوز إختيار
         - فيما أذكر يمكن التحكم بالطابعة الإفتراضية من خلال الريجيستري
           كعمل بروفايل خاص بإعدادات خاصة

أرجو لكم التوفيق والسداد والتعامل مع الريجيستري بحذر ويفضل دائماً أخذ نسخة احتياطية للأمان

[hanan_ms]

استاذ @Ahmos ☕

 

يمكن استكمال بنموذج وجدول عند التشغيل يتأكد اذا كان 1 يغير الى 0

لتغير عدد كمثال مسار الملفات يكون مجنون كطول اضافي 

كأمثله يمكن تطبيقها

 حماية الجهاز وتمديد وقت الاتصال ونطاق الارقام 

* مع نموذج آخر يأخذ نسخة كاملة من الرجستري ولاعادة الضبط 

بجدول  2يمكن تسجيل بعض البيانات كتلميح 

 

وشكرا على المرفق ❤️🌹

[Foksh]

2 ساعات مضت, Ahmos said:

أخي الكريم @Foksh
الأخوة الكرام صبحكم الله بالخير

1- إلغاء وتفعيل الحماية الخاصة بـ application.FollowHyperlink

2- إضافة مسار البرنامج لـالــ  Access\Security\Trusted Locations

3- يعتبر الرجستري وسيط بين الوجهات المتعددة
    مثال 1 :
       أعمل بكود لضبط وتحجيم أبعاد الاكسيس والتعامل مع أكثر من شاشة
       بحيث يسمح للمستخدم بعرض البرنامج علي الشاشة 1 او 2 إن كان متصل بالجهاز أكثر من شاشة
       وإن كانت الابعاد مختلفة تختلف أبعاد البرنامج وهو يعتمد علي الجداول بشكل أساسي
       وإن كان هناك أكثر من واجهة تحتاج إلي تطبيق الامر علي كل واجهة
       ولكن الريجيستري يعتبر وسيط يسمح لك بتمرير القيم وإستدعائها وتعين قيم افتراضية

    مثال 2 :
       يمكن إستخدامة في حماية البرنامج الخاص بك فإضافة قيم في الريجيستري تسمح لك بالتحقق من
         - متي أول مرة تم إستخدام البرنامج (للمدة التجريبة)
         - إضافة مفاتيح خاصة بكل جهاز
         - الأفكار كثيرة 
    أظن كدا فكرة الوساطة واضحة وأتمني أسمع أفكاركم 🧠

4- إستدعاء بعض المعلومات التي تحتاج إليها مثل
         - معرفة مسار النظام الافتراضي [ HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion ]
         - معرفة جميع الطابعات الموجودة [ HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Printers ]
         - معرفة الطابعة الإفتراضية [ HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows ] ثم [ Device ] 

5 - تغير الإعدادات
         - تغير الطابعة الإفتراضية
         - عدم السماح للوندوز بتجاوز إختيار
         - فيما أذكر يمكن التحكم بالطابعة الإفتراضية من خلال الريجيستري
           كعمل بروفايل خاص بإعدادات خاصة

أرجو لكم التوفيق والسداد والتعامل مع الريجيستري بحذر ويفضل دائماً أخذ نسخة احتياطية للأمان

مشكور ، والله يعطيك العافية على مجهودك..

اتفق معك تماما في المثال 2 ، ولا أخالفك الرأي في باقي الأمثلة أو التقليل من أهمية موضوعك لا سمح الله ، لكن في الريجستري يجب ان تكون ضليعاً في التعامل معه وبحذر - كما قلت - ولكن كموضوع تم طرحه ليست الفكرة ان نقوم بإنشاء أكواد فقط ، بل دعمها بأفكار تنفيذية حتى يثبت الموضوع جدارته في ما هو قادر على فعله .

كمثال وليس الحصر ، هل تستطيع من خلال الكود التعرف على البرامج المثبتة على الكمبيوتر وجلب مسار تثبيت كل برنامج والإصدار له والمساحة التي استخدمها ( مساحة مجلد البرنامج ) ... إلخ ❗وجميع هذه النقاط أفضل طريق لها هو الريجستري 😉

[AlwaZeeR]

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

::
تحياتي

[Ahmos]

سلام الله ورحمتهُ وبركاتهُ علي من أتبع خير الأنام محمد "صلى الله عليه وسلم"

الأخوة الكرام
تحية طيبة وبعد ،،،
أشكر مروركم الكريم وتفاعلكم الطيب

أخي الكريم @Foksh

في 8‏/11‏/2024 at 09:54, Foksh said:

ليست الفكرة ان نقوم بإنشاء أكواد فقط 

مشاركة الأفكار والأكواد فقط.
    - قد لا يتسع الوقت والجهد لعمل موضوع متكامل الأركان [ قدر المستطاع ]
      فأفضل المشاركة ثم متابعة الموضوع بالأمثلة او بالرد علي الاستفسارات لأسباب كثيرة أهمها
       * قد يكمل الموضوع من هو أفضل منك [ - من الناشر - ]
       * قد تجد في الاستفسارات او الإقتراحات ما يدفعك إلي التعديل ( الجذري او الجزئي)
       * التأجيل قد يتيح الفرصة للتراخي والتكاسل والوساوس ( يحدث في كثير من الأحيان ) اللهم أعذنا
       * قد لا يستفيد أحد من الفكرة وخاصةً أنها ليست جديدة والجميع لديه ما يحقق المراد ولكن
           - قد يستفيد أحد من طريقة كتابة الأكواد او التفاصيل الصغيرة او وظيفية داعمة
           - قد يجيد غيرك التفكير ويثري الموضوع بتعديلات او أمثلة لم تخطر علي بالك

في 8‏/11‏/2024 at 09:54, Foksh said:

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

إن أستطاع ( الناشر ) فهو خير
وأنصح أن يحشد ما يستطيع من النواية الحسنة الطيبة
وأسأل الله لنا الإخلاص في القول والعمل و التوفيق والسداد

في 8‏/11‏/2024 at 09:54, Foksh said:

هل تستطيع من خلال الكود التعرف على البرامج المثبتة على الكمبيوتر

قبل طرح للسؤال لم أكن أعلم بكل ما يلزم وبعد بحث الحمد لله فهمت أن الأمر ليس صعباً
هل انت بحاجة فأجتهد في تحقيق مرادك ؟

 

[Foksh]

6 ساعات مضت, Ahmos said:

هل انت بحاجة فأجتهد في تحقيق مرادك ؟

 

بارك الله فيك .. وأرجو أن تقبل مني النصيحة كأخ لي ..

لا تعتمد على الذكاء الإصطناعي بشكل كبير حتى في الردود والإجابات . أضراره أكبر من منافعه التي قد تكون لك كبيرة ورائعة وتجعلك تشعر بالرضا عما تقوم بتقديمه .. إلا أنه في نهاية المطاف سيجعل لأفكارك وقدراتك حدود ضيقة تجعلك لا تستغني عنه حتى في أصغر التفاصيل .

ونصيحتي ليست لك كشخص صدقني ، وإنما بشكل عام   .

[Moosak]

في 8‏/11‏/2024 at 08:14, Ahmos said:

1- إلغاء وتفعيل الحماية الخاصة بـ application.FollowHyperlink

2- إضافة مسار البرنامج لـالــ  Access\Security\Trusted Locations

3- يعتبر الرجستري وسيط بين الوجهات المتعددة
    مثال 1 :
       أعمل بكود لضبط وتحجيم أبعاد الاكسيس والتعامل مع أكثر من شاشة
       بحيث يسمح للمستخدم بعرض البرنامج علي الشاشة 1 او 2 إن كان متصل بالجهاز أكثر من شاشة
       وإن كانت الابعاد مختلفة تختلف أبعاد البرنامج وهو يعتمد علي الجداول بشكل أساسي
       وإن كان هناك أكثر من واجهة تحتاج إلي تطبيق الامر علي كل واجهة
       ولكن الريجيستري يعتبر وسيط يسمح لك بتمرير القيم وإستدعائها وتعين قيم افتراضية

    مثال 2 :
       يمكن إستخدامة في حماية البرنامج الخاص بك فإضافة قيم في الريجيستري تسمح لك بالتحقق من
         - متي أول مرة تم إستخدام البرنامج (للمدة التجريبة)
         - إضافة مفاتيح خاصة بكل جهاز
         - الأفكار كثيرة 
    أظن كدا فكرة الوساطة واضحة وأتمني أسمع أفكاركم 🧠

4- إستدعاء بعض المعلومات التي تحتاج إليها مثل
         - معرفة مسار النظام الافتراضي [ HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion ]
         - معرفة جميع الطابعات الموجودة [ HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Print\Printers ]
         - معرفة الطابعة الإفتراضية [ HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows ] ثم [ Device ] 

5 - تغير الإعدادات
         - تغير الطابعة الإفتراضية
         - عدم السماح للوندوز بتجاوز إختيار
         - فيما أذكر يمكن التحكم بالطابعة الإفتراضية من خلال الريجيستري
           كعمل بروفايل خاص بإعدادات خاصة

شكرا لك أخي @Ahmos (آخر ملوك مصر) 😅🖐 على هذا الجهد الطيب 🙂🌹

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

لكن لكي تفتح لنا الآفاق هل يمكنك البدء بإعطاء أمثلة عملية على النقطتين [1 - 2 ] مثلا ؟

[Ahmos]

أخي الكريم @Foksh شكراً لك علي النصيحة
بارك الله فيك

أخي الكريم @Moosak
أشكرك لك مرورك الطيب
كنت بالفعل أنوي تجهيز الأكواد ومشاركتها بمواضيع منفصة ليسهل البحث عنها
ولكن تفضل الأكواد التالية للنقطة 1 وإن شاء الله قريباً النقطة 2

روابط للمراجعة : 
 - https://learn.microsoft.com/en-us/microsoft-365/troubleshoot/administration/enable-disable-hyperlink-warning
 - https://www.slipstick.com/how-to-outlook/disable-unsafe-hyperlink-warning-opening-attachments/
الأكواد بالموديول هي:
  * hyperLinkWOn  -  لتفعيل إشعارات الحماية 
  * hyperLinkWOff  -  لتعطيل إشعارات الحماية
  * isHyperLinkW    - إذا كانت القيمة DisableHyperlinkWarning موجودة بالمسار وتساوي 0 او غير موجودة فهذا يعني ان الحماية مفعلة
  * msOfficeSecurityPath  - لتعود بالمسار المطلوب داخل الريجيستري 
  *  awsLink  -  يقوم هذا الإجراء بتعطيل الحماية ومن ثم فتح الرابط ثم إعادة تفعيلها مرة أخري
      قمت بالامر هكذا حتي لا نترك الحماية معطلة ولكن يمكن التعديل علي الكود بحيث يتعرف اولاً علي حالة الحماية وإعادتها لحالتها بعد الإنتهاء
 

Option Compare Database

Option Explicit

Private Const debugState    As Boolean = True
Private Const msgLogState   As Boolean = False

Sub Test_awsLink()

    Dim sPath       As String
    
    On Error GoTo ErrorHandler
    
    sPath = "whatsapp://send/?phone=+2012312313"
    
    ' Fisrt Test When The Warning is Enabled
    hyperLinkWOn        ' Make Sure it's Enable
    Call Application.FollowHyperlink(sPath)
    
    ' Second Test When The awsLink it Automatically turnOff then follow The link Then turnOn Again
    awsLink sPath
    
ExitAndClean:
    
    Exit Sub
    
ErrorHandler:
    MsgLog "We Received an unknown Error" & vbCrLf & _
                   "Error Number : " & Err.Number & vbCrLf & _
                   "Description  : " & Err.Description _
                   , llCritical, debugState, msgLogState, "Unknown Error"
    Resume ExitAndClean
End Sub

Public Sub awsLink(ByVal sLink As String)
    
    Dim msgRes      As VbMsgBoxResult
    
    On Error GoTo ErrorHandler
    
    hyperLinkWOff       ' To Disable The Hyper Link Security Warning
        If Not (isHyperLinkW) Then
            Call Application.FollowHyperlink(sLink)
        Else
            msgRes = MsgLog("Something Went Wrong" & vbCrLf & _
                "We are unable To Disable The Hyper Link Security Warning" & vbCrLf & _
                "Do You Want to Continue ?", llQuestion, debugState, msgLogState, , , mbYesNo, db2Second, SecToMs(15))
            If msgRes = vbNo Then
                GoTo ExitAndClean
            Else
                Call Application.FollowHyperlink(sLink)
            End If
        End If
    hyperLinkWOn        ' To Enable The Hyper Link Security Warning

ExitAndClean:
    Exit Sub
    
ErrorHandler:
    MsgLog "We Received an unknown Error" & vbCrLf & _
                   "Error Number : " & Err.Number & vbCrLf & _
                   "Description  : " & Err.Description _
                   , llCritical, debugState, msgLogState, "Unknown Error"
    Resume ExitAndClean
End Sub


Public Sub hyperLinkWOn()
    Dim winReg      As awsReg
    Dim sPath       As String
    Dim sValue      As String
    Dim vResult     As Variant
    
    On Error GoTo ErrorHandler
    
    sPath = msOfficeSecurityPath
    
    Set winReg = New awsReg
    With winReg
        .useDebug = debugState
        .useMsgLog = msgLogState
        .MsgLanguage = englishMsg
        .Root = HKEY_CURRENT_USER
        .key = sPath
        .value("DisableHyperlinkWarning") = CInt(0)
    End With

ExitAndClean:
    If Not winReg Is Nothing Then Set winReg = Nothing
    Exit Sub
    
ErrorHandler:
    MsgLog "We Received an unknown Error" & vbCrLf & _
                   "Error Number : " & Err.Number & vbCrLf & _
                   "Description  : " & Err.Description _
                   , llCritical, debugState, msgLogState, "Unknown Error"
    Resume ExitAndClean

End Sub

Public Sub hyperLinkWOff()
    Dim winReg      As awsReg
    Dim sPath       As String
    Dim sValue      As String
    Dim vResult     As Variant
    
    On Error GoTo ErrorHandler
    
    sPath = msOfficeSecurityPath
    
    Set winReg = New awsReg
    With winReg
        .useDebug = debugState
        .useMsgLog = msgLogState
        .MsgLanguage = englishMsg
        .Root = HKEY_CURRENT_USER
        .key = sPath
        .value("DisableHyperlinkWarning") = CInt(1)
    End With

ExitAndClean:
    If Not winReg Is Nothing Then Set winReg = Nothing
    Exit Sub
    
ErrorHandler:
    MsgLog "We Received an unknown Error" & vbCrLf & _
                   "Error Number : " & Err.Number & vbCrLf & _
                   "Description  : " & Err.Description _
                   , llCritical, debugState, msgLogState, "Unknown Error"
    Resume ExitAndClean

End Sub


' isHyperLinkW return True if the DisableHyperlinkWarning is not Exist or = 0

Public Function isHyperLinkW() As Boolean
    Dim winReg      As awsReg
    Dim sPath       As String
    Dim vResult     As Variant
    
    On Error GoTo ErrorHandler
    
    sPath = msOfficeSecurityPath
    
    Set winReg = New awsReg
    With winReg
        .useDebug = debugState
        .useMsgLog = msgLogState
        .MsgLanguage = englishMsg
        .Root = HKEY_CURRENT_USER
        If Not (.IsKeyExists(sPath)) Then GoTo ExitAndClean
        .key = sPath
        If .IsValueExists("DisableHyperlinkWarning") = True Then
            vResult = .value("DisableHyperlinkWarning")
'            Debug.Print vResult(0)
'            Debug.Print vResult(1)
'            Debug.Print CBool(vResult(0))
            If CInt(vResult(0)) = 0 Then
                isHyperLinkW = True
            Else
                isHyperLinkW = False
            End If
        Else
            isHyperLinkW = True
        End If
    End With

ExitAndClean:
    If Not winReg Is Nothing Then Set winReg = Nothing
    Exit Function
    
ErrorHandler:
    MsgLog "We Received an unknown Error" & vbCrLf & _
                   "Error Number : " & Err.Number & vbCrLf & _
                   "Description  : " & Err.Description & vbCrLf & _
                   "Source       : " & Err.Source _
                   , llCritical, debugState, msgLogState, "Unknown Error"
    
    Resume ExitAndClean
End Function

Public Function msOfficeSecurityPath() As String
    msOfficeSecurityPath = "Software\Microsoft\Office" & "\" & MsAccessVersion() & "\Common\Security"
End Function

Private Function MsAccessVersion() As String
    Dim ver As String
    ver = Application.Version
    
    Select Case Left$(ver, 2)
        Case "16"
            MsAccessVersion = "16.0"  ' Access 2016/2019/365
        Case "15"
            MsAccessVersion = "15.0"  ' Access 2013
        Case "14"
            MsAccessVersion = "14.0"  ' Access 2010
        Case "12"
            MsAccessVersion = "12.0"  ' Access 2007
        Case Else
            MsAccessVersion = ver
    End Select
End Function