استبدال كود أداة بكود أخر لاستدعاء رقم الماك أدرس للحماية

[محمد صلاح1]

السلام عليكم

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

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

مع مراعاة تعديل مناداة الوحدة النمطية في عمل أ / حسنين والمسؤولة عن استدعاء رقم الماك أدرس لتكون الحماية برقم الماك وادرس وليس بالرقم الذي كانت تعمل به الأداة في السابق

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

GET_HWID.rar

تم تعديل سبتمبر 2, 2019 بواسطه محمد صلاح1

[محمد صلاح1]

تيسيراً علي من يريد المساعدة

هذا هو كود الأداة المرفقة ووظيفتها أنها تقوم باستخراج ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) ثم ينسخه كما أفاد بذلك أ / حسنين في موضوعه هنا

' Get clipboard text
Set objHTML = CreateObject("htmlfile")
Set Ws = CreateObject("WScript.Shell")
Clipboardtext = objHTML.ParentWindow.ClipboardData.GetData("text")
sText = HWND_GET
'Set Clipboard
Ws.Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True

MsgBox "Copied!"

Function HWND_GET()
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set disks = root.execquery("select * from win32_logicaldisk")
For Each disk In disks
    If disk.volumeserialnumber <> "" Then
        HWND_GET = disk.volumeserialnumber
        Exit For
    End If
Next
End Function

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

Public Function getMacAddress(Optional strComputer As Variant) As String
Dim oWMIService As Object
Dim oMacs As Object
Dim oMac As Object
Dim strComp As Variant
'if no computer name is passed then use the name of the computer running the code.
If IsMissing(strComputer) Then
    strComputer = "."
End If
      
    Set oWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set oMacs = oWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration")
    'Win32_ComputerSystem
    For Each oMac In oMacs
       If IsNull(oMac.MacAddress) = False Then
        'Debug.Print oMac.MacAddress
        getMacAddress = oMac.MacAddress
    End If
    Next
End Function

وتعديل هاتين الوظيفتين ليتم التوافق مع وظيفة الأداة بعد التعديل المطلوب

Function HWND_GET()
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set disks = root.execquery("select * from win32_logicaldisk")
For Each disk In disks
    If disk.volumeserialnumber <> "" Then
        HWND_GET = disk.volumeserialnumber
        Exit For
    End If
Next
End Function
Function HWND_PROTECTION()
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set disks = root.execquery("select * from win32_logicaldisk")
For Each disk In disks
    If disk.volumeserialnumber <> "" Then
        HWND_PROTECTION = disk.volumeserialnumber
        Exit For
    End If
Next
If HWND_ID = HWND_PROTECTION Then
HWND_PROTECTION = "True"
Else
HWND_PROTECTION = "False"
End If
End Function

 

[محمد صلاح1]

للرفع

[ابو عارف]

20 ساعات مضت, محمد صلاح1 said:

وهذا هو الكود الذي تفضل به الأخ أبو جودي والذي أود تعديل الأداة إليه لتصبح وظيفتها استخراج رقم (الماك أدرس فقط)

تفضل أخي

' Get clipboard text
Set objHTML = CreateObject("htmlfile")
Set Ws = CreateObject("WScript.Shell")
Clipboardtext = objHTML.ParentWindow.ClipboardData.GetData("text")
sText = HWND_GET
'Set Clipboard
Ws.Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True


MsgBox "Copied!"

Function HWND_GET()
Set objVMI = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set vAdptr = objVMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

For Each objAdptr In vAdptr
    HWND_GET = objAdptr.MACAddress
Next 
End Function

 

[محمد صلاح1]

تسلم أيديك أ @ابو عارف وبارك الله فيك

بقي أخر تعديل حتي يتم المطلوب علي خير بإذن الله وهو تعديل كودي وظائف التأكد من رقم الماك ادرس في وحدة الحماية

Function HWND_GET()
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set disks = root.execquery("select * from win32_logicaldisk")
For Each disk In disks
    If disk.volumeserialnumber <> "" Then
        HWND_GET = disk.volumeserialnumber
        Exit For
    End If
Next
End Function
Function HWND_PROTECTION()
Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2")
Set disks = root.execquery("select * from win32_logicaldisk")
For Each disk In disks
    If disk.volumeserialnumber <> "" Then
        HWND_PROTECTION = disk.volumeserialnumber
        Exit For
    End If
Next
If HWND_ID = HWND_PROTECTION Then
HWND_PROTECTION = "True"
Else
HWND_PROTECTION = "False"
End If
End Function

 

تم تعديل سبتمبر 3, 2019 بواسطه محمد صلاح1

[محمد صلاح1]

للرفع

[ابو عارف]

رغم انني ما عملت برامج حماية و لكن انت جرب الفنكشن 

Function HWND_PROTECTION(HWND_ID)
Set objVMI = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set vAdptr = objVMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objAdptr In vAdptr
    HWND_GET = objAdptr.MACAddress
Next
If HWND_ID = HWND_PROTECTION Then
HWND_PROTECTION = "True"
Else
HWND_PROTECTION = "False"
End If

End Function

 

 

[محمد صلاح1]

منذ ساعه, ابو عارف said:

جرب الفنكشن 

بعد التطبيق ظهر معي هذا الخطأ بالكود

تم تعديل سبتمبر 3, 2019 بواسطه محمد صلاح1

[ابو عارف]

آصف قد كتبت اسم فنكشن آخر بالخطاء  جرب الآن

Function HWND_PROTECTION(HWND_ID)
Set objVMI = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set vAdptr = objVMI.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objAdptr In vAdptr
    HWND_PROTECTION = objAdptr.MACAddress
Next
If HWND_ID = HWND_PROTECTION Then
HWND_PROTECTION = "True"
Else
HWND_PROTECTION = "False"
End If

End Function

 

[محمد سلامة]

@محمد صلاح1 ممكن اخي المرفق الاخير بعد التعديل لكى اطلع عليه