اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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

في هذا الإصدار يوجد ثلاث تطبيقات ( الملف بالمرفقات )
 - awsReg_Colorize_VBE لتلوين محرر الأكواد

   image.png.fe1c5e28c3530aa4a57a755e87f783cd.png
 - awsReg_HyperLink_Warning لتفعيل وتعطيل [ application.FollowHyperlink warning ]
   تم شرح وإضافة الأكواد بالمشاركة التالية بالموضوع الأول الرابط من هنا
 - awsReg_User_Trusted_Helper_MOD للتحكم بالمواقع الموثوقة Trusted Locations

 

التطبيق الأول : تلوين محرر الأكواد
يوجد بعض الأدوات المجانية التي تتيح التعديل علي ألوان محرر الأكواد وتعتمد فكرتها علي التعديل في ملف الـ VBA{Ver}.dll
مثال : https://github.com/gallaux/VBEThemeColorEditor
ولكن يمكن تحقق نفس النتيجة يدوي او من خلال إضافة قيم للريجيستري
يدوي : 
 image.png.2275d33f8078aa22070c7c9a60d2737e.png  image.png.c88dd16bc480a1e9fe5e9ee3c1db9881.png

عن طريق الأكواد
إضافة القيم التالية للريجيستري في المسار (HKEY_CURRENT_USER\Software\Microsoft\VBA\7.1\Common)
7.1 هو رقم الاصدار وقد يختلف وتم إضافة المسارات المتوقعة بالاكواد
CodeForeColors | CodeBackColors | FontFace | FontHeight | FontCharSet

طريقة الإستخدام :call setUpVbeColors(awsDark3)
image.png.fc499e58223cbe74afdde614ff69dceb.png
ملحوظة
:
عند اختيار الخط يفضل اختار ما يدعم اللغة العربية إذا كنت تريد إضافة تعليقات باللغة العربية كما يجب التاكد من الأحجام المتاحة فبعض الخطوط تتيح أحجام محددة
مثال

image.png.bc0f4511406c8517b9f9d9f2b69d7700.png

بانتظار مشاركة إبداعتكم

التطبيق الثالث : إضافة مسار البرامج الخاصة بك في المواقع الموثوقة Trusted Locations
لماذا يفضل إضافة المسار الخاص ببرنامجك إلي المواقع الموثوقة ؟
1- الحد من ظهور التحذيرات أثناء عمل البرنامج وعند كل تشغيل
2- والأهم هي سرعة عمل الأكود فوفق دراسة قام بها بعض المبرمجين فإن الأكود تعمل بشكل أسعر يصل إلي 23× 
    رابط المصدر من هنا
     اقتباس من المصدر :

اقتباس

This particular issue was brought to my attention by Aleksander Wojtasz, an experienced Access developer from Poland.
      Aleksander has some very impressive Access applications involving the use of drag & drop with Gantt charts . See his YouTube channel.
      Aleksander also provided sample code to demonstrate the issue which I have adapted (with his permission) for use in the example app supplied with this article.
      These are the results I obtained with the example app:
The code ran in about 32 milliseconds from a trusted location but took about 740 milliseconds from an untrusted location. That is about 23x slower!

image.png.bf5cc7cea5ca6179e168d148bfb5e319.png image.png.1806c72165e3e8ec122e2dfba59d7c4e.png

هل يوجد مكان واحد للإضافة ؟
لا يوجد أكثر من مكان للضافة ولكل مكان ميزاته وعيوبة
مثال : فالمسار الخاص بإضافة المواقع الموثوقة لكل برنامج من برامج الاوفيس هو
Software\Microsoft\Office\16.0\Access\Security\Trusted Locations ويتغير اسم البرنامج ورقم الإصدار وفق النسخة والبرنامج المستهدف
فإذا كان الجذر (ROOT ) هو [ HKEY_CURRENT_USER ] فمن يتأثر بهذه المواقع هو اليوزر الحالي فقط
ولكن إن كان [ HKEY_LOCAL_MACHINE] فيتأثر جميع المستخدمين
كما ان هناك ترتيب فالموقع داخل HKEY_CURRENT_USER 
له الأفضلية علي HKEY_CURRENT_USER 
الموقع الموثوق عبارة عن مفتاح وهو اسم الموقع ويوجد بداخل قيم
ويوجد تحت المفتاح الرئيس [Trusted Locations] قيم 
مثال

[USER Trusted Locations Values] : 
HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations
---------------------------------------------
	[Value Name   ] : AllLocationsDisabled
	[Value Data   ] : False
	[Value Type   ] : REG_DWORD
	[Value Integer] : 0
	[Note         ] : All Trusted Locations are Allowed
	---------------------------------------------
	[Value Name   ] : AllowNetworkLocations
	[Value Data   ] : False
	[Value Type   ] : REG_DWORD
	[Value Integer] : 0
	[Note         ] : All NetWork Locations are Disabled
	---------------------------------------------

[Locations] : 
HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\awsTLocation
---------------------------------------------
[Location Name  ] : awsTLocation
	[Location Number] : 02
	[Location Values] : 
		[Value Name   ] : Path
		[Value Data   ] : D:\AWSTRUSTLOCATION3\
		[Value Type   ] : REG_SZ
		-----------------------------------
		[Value Name   ] : Description
		[Value Data   ] : This Location Has Been Trusted By : AWS REG
		[Value Type   ] : REG_SZ
		-----------------------------------
		[Value Name   ] : Date
		[Value Data   ] : 17/11/2024/ 10:41:00 AM
		[Value Type   ] : REG_SZ
		-----------------------------------
		[Value Name   ] : AllowSubfolders
		[Value Data   ] : True
		[Value Type   ] : REG_DWORD
		[Value Integer] : 1
		[Note         ] : All Sub Folders are Allowed
		-----------------------------------
	---------------------------------------------

فإذا تم تفعيل القيمة [AllLocationsDisabled] تحت المفتاح [Trusted Locations] 
فهذا يعني تعطيل جميع المسارات الموثوقة

تحذير هام:
أنصح بعدم وضع المسارات شائعة الاستخدم كسطح المكتب والتنزيلات حتي لا نضعف حماية النظام

ملحوظة: أكبر عدد مسموح به للإضافة هو 20 لكل برنامج أوفيس

الأمثلة موجودة في مديول : awsReg_Trusted_Locations
كما يوجد شرح أيضاً في راس المديول : awsReg_User_Trusted_Helper_MOD

تم إضافة تعديل علي الكلاس مديول بإضافة دالة جديدة : allValuesKeysDictColl
-------------------------------------------------------------------------------------------

أود الإشارة إلي هذه المقاطع داخل الأكواد لأهميتها
1- داخل الكود   loadUserTrusted

image.png.b6045a5ce23382ec9e249fa85b779faf.png

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

2- داخل الكود  setUserAppTrustLocation

image.jpeg.12e10bc584dea68f8c168b6c2f0766e8.jpeg

 

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

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

winRegApi_OV2.zip

  • Like 2
  • Thanks 2
قام بنشر (معدل)

أرفق لكم تعديل بسيط حتي يسمح بإضافة مسار كهذا %USERPROFILE%\Desktop\AWSTRUSTLOCATION5\
فكان هدفي من البداية هو توحيد المسارات حتي أستطيع المقارنة
ولكن وجدت ان هذا يمنع من تسجيل مسارات في صورتها المتغيرة والقابلة للتمدد وقد يحتاج إليها البعض

image.png.e9a7f8b8183b29c4161e68434d3d160c.png

كما تم إضافة تعديل إذا لفرض حفظ المسار وان لم يكن قابل للتمدد ويكون نوع البيانات الخاصة به هو REG_EXPAND_SZ
قد تحتاج إليها في المسارات القصيرة مثل "
C:\PROGRA~1" وهو ما يسمي بـ  8.3 Paths
ولكي تحصل علي مساراتك الخاصة بعد فتح الـ CMD في الموقع المراد هذا هو الأمر Dir /x

image.png.a6724c2502aeba802a52004df6673978.png

image.png.3e5b90fd49f4479517e800d9c5d24f79.png

وهذا التعديل الذي يسمح بتسجل النص بدلاً من REG_SZ إلي REG_EXPAND_SZ
تم أولاً علي الـ awsReg Class Module
1- تم إضافة الكود التالي بالاعلي
Private Const FORCE_EXPAND_SZ As String = "awsExpand "

Private Const FORCE_EXPAND_SZ As String = "awsExpand "

2- تم التعديل علي VALUE LET PROPERTY
بإضافة هذا الجزء

 

ElseIf Left$(CStr(vData), Len(FORCE_EXPAND_SZ)) = FORCE_EXPAND_SZ Then
                    vData = Mid$(vData, Len(FORCE_EXPAND_SZ) + 1)
                    Call RegSetValueEx(hCurKey, ValueName, 0, _
                        REG_EXPAND_SZ, ByVal CStr(vData), _
                        Len(vData) + 1)

وهنا يتحقق من النص إذا كان يبدأ بـ "awsExpand " سيتم حذفها وتسجيل النص بنوع REG_EXPAND_SZ

ثم تم التعديل علي

 

Public Function setUserAppTrustLocation(Optional ByVal locationName As String = "", _
                                            Optional ByVal locationPath As String = "", _
                                            Optional ByVal sDescription As String = "", _
                                            Optional allowSubFolders As Boolean = False, _
                              ----->        Optional forcePathExpandEZ As Boolean = False) As Boolean


If forcePathExpandEZ = False Then
                .value("Path") = sPath
            Else
                .value("Path") = "awsExpand " & sPath
            End If


بعد التجربة :
تم تسجيل ShortPath بنوع REG_SZ وتم التعرف عليه والتعامل معه بدون مشاكل
ما يميز REG_EXPAND_SZ  هو تعاملها مع مسارات النظام مثل (%ProgramFiles% - %SystemRoot%)

winRegApi_OV2.1.zip

تم تعديل بواسطه Ahmos
بعد التجربة لا حاجة إلي استخدام (forcePathExpandEZ) حتي الأن
  • Like 2
قام بنشر (معدل)

لمعرفة إذا كانت قاعدة الحالية تعمل من موقع موثوق أم لا
فيمكن تطبيق الأمر التالي

? CurrentProject.IsTrusted

يرجع بـ TRUE إذا كانت تعمل من موقع موثوق أما إذا كان لا فلا يعود بـ False
إنما تظهر الرسالة التالية

image.png.8f761132966a8885d9a5d3cbb63d2a5c.png

ولذلك تم إضافة الأكواد التالية لمعرفة الحالة
هناك إحتمالين 
1- ان قاعدة البيانات تعمل من مسار رئيسي مضاف للمواقع الموثوقة
2- ان القاعدة تعمل من مسار فرعي ضمن مسار رئيسي مضافة لموقع موثوق + السماح للمجلدات الفرعي مفعل داخل الموقع 
    AllowSubfolders = 1


لذلك أولاً نحتاج إلي هذه الأكواد ويفضل إضافتها للمديول (Helper_Functions)
 

Public Function isPathOrSub(ByVal basePath As String, ByVal pathToCheck As String) As Boolean
    
    Dim sBPath          As String
    Dim sCPath          As String
    
    sBPath = validTLocPath(Trim(basePath), True)
    sBPath = Replace(sBPath, "/", "\")
    sBPath = addTrailSlash(sBPath)
    sBPath = LCase(sBPath)
    
    sCPath = validTLocPath(Trim(pathToCheck), True)
    sCPath = Replace(sCPath, "/", "\")
    sCPath = addTrailSlash(sCPath)
    sCPath = LCase(sCPath)

    isPathOrSub = (sBPath = sCPath) Or (sBPath = Left(sCPath, Len(sBPath)))
End Function

Public Function isSubPath(ByVal basePath As String, ByVal pathToCheck As String) As Boolean
    
    Dim sBPath          As String
    Dim sCPath          As String
    
    sBPath = validTLocPath(Trim(basePath), True)
    sBPath = Replace(sBPath, "/", "\")
    sBPath = addTrailSlash(sBPath)
    sBPath = LCase(sBPath)
    
    sCPath = validTLocPath(Trim(pathToCheck), True)
    sCPath = Replace(sCPath, "/", "\")
    sCPath = addTrailSlash(sCPath)
    sCPath = LCase(sCPath)

    isSubPath = (sBPath = Left(sCPath, Len(sBPath)))
End Function

Public Function isSamePath(ByVal basePath As String, ByVal pathToCheck As String) As Boolean
    
    Dim sBPath          As String
    Dim sCPath          As String
    
    sBPath = validTLocPath(Trim(basePath), True)
    sBPath = Replace(sBPath, "/", "\")
    sBPath = addTrailSlash(sBPath)
    sBPath = LCase(sBPath)
    
    sCPath = validTLocPath(Trim(pathToCheck), True)
    sCPath = Replace(sCPath, "/", "\")
    sCPath = addTrailSlash(sCPath)
    sCPath = LCase(sCPath)

    isSamePath = (sBPath = sCPath)
End Function

ثانياً يتم إضافة الكود التالي الي المديول (awsReg_User_Trusted_Helper_MOD)
 

Public Function isCurrentLocTrusted(Optional ByVal sPathToCheck As String = "")
    
    Dim currentLoc      As String
    Dim i               As Long
    
    On Error GoTo ErrorHandler
    resetUserTrusted
    loadUserTrusted
    
    If userDeleteLoc Is Nothing Then
        Err.Raise vbObjectError + 1001, "isCurrentLocTrusted", "Unable to load user trusted locations or there are none available."
    End If
    
    If Len(Trim(sPathToCheck)) > 0 Then
        currentLoc = Trim(sPathToCheck)
    Else
        currentLoc = GetAppPath()
    End If
    
    For i = 1 To userKeysCount
        If isSamePath(CStr(userDeleteLoc(i)("locPath")), currentLoc) Then
            isCurrentLocTrusted = True
            MsgLog "This Path: [" & currentLoc & "] Is Trusted", llinfo, devDebugP, usrMsgLog
            Exit For
        Else
            If isSubPath(CStr(userDeleteLoc(i)("locPath")), currentLoc) And userDeleteLoc(i)("allowSub") = True Then
                isCurrentLocTrusted = True
                MsgLog "This Sub Path: [" & currentLoc & "] Is Trusted", llinfo, devDebugP, usrMsgLog
                Exit For
            Else
                isCurrentLocTrusted = False
            End If
        End If
    Next i
    

ExitAndClean:
    resetUserTrusted
    Exit Function
    
ErrorHandler:
    MsgLog "We Received an Error" & vbCrLf & _
           "Error Number : " & Err.Number & vbCrLf & _
           "Description  : " & Err.Description & vbCrLf & _
           "Source       : " & Err.Source, _
           llCritical, debugState, usrMsgLog
           isCurrentLocTrusted = False
    Resume ExitAndClean
    
End Function

 

تم تعديل بواسطه Ahmos
تصحيح الكود + إضافة للـ isCurrentLocTrusted
  • Like 2
قام بنشر

ما شاء الله 

موضوع جميل ومتعوب عليه 

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

واشكرك على هذه الطرح الرائع

  • Like 1
قام بنشر

بارك الله فيك , فعلا موضوع شيق , تحياتي

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information