حماية ملفك .تحويل كود vba الى ملف DLL

[الرائد77]

السلام عليكم 

نظرا لبعض طلبات الاعضاء الكرام . خاصة ممن يقومون بعمل برامج من أجل كسب العيش أعانهم الله

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

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

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

عن طريق برنامج vbacompiler for excel و لكن للاسف غير مجاني

و هو برنامج يقوم بتحويل الاكواد بالملف الى ملف DLL   و تغيير الاكواد بالملف لتستدعى ملف DLL الذي تم انشاؤه 

و يعمل الملف بكفاءءة عالية لقد قمت بالتجريب و فعلا نتيجة رائعة.

يمكنك تحميل البرنامج كنسخة تجريبية . و بالنسبة للذين يعملون البرامج و يبيعونها و يكسبون العيش مننها يمكنهم شراء النسخة الكاملة 

كيف تحمي ملفك ؟

يمكنك وضع كود خاص بكلمة السر و السريال نمبر للهارد ديسك 

و ييمكنك وضع الكود التالي عند فتح الملف WORK BOOK OPEN

يعني اذاكان رقم السريال نمبر هو  مثلا : FFFFF-FFFFF-FFFFF  ادخل الرقم السري  222222 و اذا كان خطأا اغلق الملف 

 

Private Sub Workbook_Open()
Dim RAD As String
If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber = "FFFFF-FFFFF-FFFFF" Then
    RAD = InputBox("Enter password:")
    If LCaseRAD <> "222222" Then ActiveWorkbook.Close False
End If
End Sub

 و بعد الانتهاء من عمل ملف 

افتح برنامج  vbacompiler for excel

و جول ملفك الى ملف جديد معه ملف DLL 

يمكنك التجريب على أي ملف 

لقد قمت بتجريب البرنامج على ملف  أحد الاعضاء و النتيجة بالمرفقات 

الملف عبارة عن كود بسيط يبحث عن تكرار في  عمودين و نقل المكرر الى عمود ثالث

هدا الكود مثلا قبل استعمال برنامج  vbacompiler for excel

Sub brg()
ScreenUpdating = False

Dim lr As Integer
Dim lr1 As Integer
Dim c As Range

lr1 = ActiveSheet.Range("g" & Rows.Count).End(xlUp).Row

For Each c In ActiveSheet.Range("c2:c1000")
lr = ActiveSheet.Range("i" & Rows.Count).End(xlUp).Row

If WorksheetFunction.CountIf(ActiveSheet.Range("g2:g" & lr1), c.Value) >= 1 Then

Cells(lr + 1, 9) = c.Value
On Error Resume Next
End If

Next
ScreenUpdating = True


End Sub

و هذا بعد استعمال البرنامج 

 

#If Win64 Then
Private Declare PtrSafe Sub p0iflwmc269 Lib "EXEMPLE_xlsm_64.dll" Alias "r8rfyae98n05rlq" ()
#Else
Private Declare Sub p0iflwmc269 Lib "EXEMPLE_xlsm_64.dll" Alias "r8rfyae98n05rlq@0" ()
#End If
Sub brg()
p0iflwmc269
End Sub

Option Private Module
#If Win64 Then
Private Declare PtrSafe Function SetThisWbk Lib "EXEMPLE_xlsm_64.dll" Alias "SetThisWorkbook" (ByVal twbk As Object) As Long
Private Declare PtrSafe Function u6hpyov9dx5 Lib "EXEMPLE_xlsm_64.dll" (ByVal i As Long, ByVal obj As Object) As Long
Private Declare PtrSafe Function c1smc91ey1mls Lib "EXEMPLE_xlsm_64.dll" (ByVal i As Long, ByVal mp As LongPtr) As Long
Private Declare PtrSafe Function s1a3nzo1yqora3l Lib "EXEMPLE_xlsm_64.dll" () As Variant
Private Declare PtrSafe Sub d0np2x0oglsn Lib "EXEMPLE_xlsm_64.dll" (ByVal dst As Any, ByVal src As LongPtr, ByVal sz As Long)
Private Declare PtrSafe Function p8t9c8qi9tgx Lib "EXEMPLE_xlsm_64.dll" (ByRef p() As Any) As LongPtr
Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal libFileName As String) As LongPtr
Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As LongLong
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
#Else
Private Declare Function SetThisWbk Lib "EXEMPLE_xlsm_64.dll" Alias "SetThisWorkbook@4" (ByVal twbk As Object) As Long
Private Declare Function u6hpyov9dx5 Lib "EXEMPLE_xlsm_64.dll" Alias "u6hpyov9dx5@8" (ByVal i As Long,ByVal obj As Object) As Long
Private Declare Function c1smc91ey1mls Lib "EXEMPLE_xlsm_64.dll" Alias "c1smc91ey1mls@8" (ByVal i As Long,ByVal mp As Long) As Long
Private Declare Function s1a3nzo1yqora3l Lib "EXEMPLE_xlsm_64.dll" Alias "s1a3nzo1yqora3l@0" () As Variant
Private Declare Sub d0np2x0oglsn Lib "EXEMPLE_xlsm_64.dll" Alias "d0np2x0oglsn@12" (ByVal dst As Any,ByVal src As Long,ByVal sz As Long)
Private Declare Function p8t9c8qi9tgx Lib "EXEMPLE_xlsm_64.dll" Alias "p8t9c8qi9tgx@4" (ByRef p() As Any) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal libFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
#End If
Private Function k7wgf46mba0cj8() As String
On Error Resume Next
k7wgf46mba0cj8 = ThisWorkbook.Path + "\EXEMPLE_xlsm_64.dll"
End Function
Public Sub p8oi75y3jrid8()
#If Win64 Then
Dim hModule As LongPtr
Dim dllPath As String
Dim msg As String
On Error Resume Next
dllPath = k7wgf46mba0cj8()
hModule = LoadLibrary(dllPath)
If hModule = 0 Then
MsgBox "Cannot load '" & dllPath & "'"
ThisWorkbook.Close False
Else
c1smc91ey1mls 1&, AddressOf u4fw2npwzdn25f4
If SetThisWbk(ThisWorkbook) Then
u6hpyov9dx5 3&, Sheet1
u6hpyov9dx5 4&, Sheet2
u6hpyov9dx5 2&, ThisWorkbook
ThisWorkbook.Saved = True
Else
GoTo qpnt
End If
End If
#Else
MsgBox "This workbook can work with 64 bit Excel only"
ThisWorkbook.Close False
#End If
Exit Sub
qpnt: ThisWorkbook.Close False
End Sub
Public Sub x1u5slqd9g()
On Error GoTo errh
SetThisWbk (ThisWorkbook)
Exit Sub
errh: p8oi75y3jrid8
End Sub
Public Function q7uobay8mw() As Boolean
On Error Resume Next
q7uobay8mw = GetModuleHandle("EXEMPLE_xlsm_64.dll") <> 0&
End Function
#If Win64 Then
Public Function FreeCompiledDll() As LongLong
Dim i As Long
Do
FreeCompiledDll = FreeLibrary(GetModuleHandle("EXEMPLE_xlsm_64.dll"))
i = i + 1
Loop While FreeCompiledDll <> 0 And i < 100
End Function
#End If
Private Sub auto_open()
x1u5slqd9g
End Sub
Private Sub auto_close()
#If Win64 Then
On Error Resume Next
Dim p As Variant
ThisWorkbook.Saved = True
SetThisWbk Nothing
p = s1a3nzo1yqora3l
FreeCompiledDll
If p <> "" Then
Kill p & "cbinrtl.dll"
RmDir p
End If
#End If
End Sub
Function u4fw2npwzdn25f4(ByVal v7liriqd8 As Variant, ByVal m8g6onrhcrw As Variant, ByVal m7jy4oel As Variant, ByRef j8yhrsbf2() As Variant) As Variant
On Error Resume Next
Dim sz As Long
sz = UBound(j8yhrsbf2) - LBound(j8yhrsbf2) + 1
Select Case sz
Case 0
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel)
Case 1
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0))
Case 2
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1))
Case 3
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2))
Case 4
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3))
Case 5
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4))
Case 6
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5))
Case 7
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6))
Case 8
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7))
Case 9
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7), j8yhrsbf2(8))
Case 10
u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7), j8yhrsbf2(8), j8yhrsbf2(9))
End Select
End Function

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

ملف خاص بعد التشفير ب اوفيس 64

و ملف خاص بعد التشفير ب اوفيس 32

و السلام عليكم  و تقبل الله منا و منكم

الملف بدون تشفير.rar الملف مشفر مع ملف DLL لنسخة اوفيس 32.rar الملف مشفر مع ملف DLL لنسخة اوفيس 64.rar

[Ali Mohamed Ali]

أحسنت اخى الكريم عمل رائع بارك الله فيك وزادك الله من فضله

[الرائد77]

بارك الله فيك حبيبي Ali Mohamed Ali

و جزاك الله خيرا

[saad abed]

اخى الرائد77

بارك الله فيك موضوع مميز وارجو الاهتمام بالرد على التساؤلات

 

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

المفروض الا يظهر الاكواد بعد التشفير 

اشكرك موضوع مهم جدا

تم تعديل مايو 4, 2020 بواسطه saad abed

[الرائد77]

أخي saad abed شكرا و بارك الله فيك

المثال المرفق كنموذج فقط..

الفكرة هي أن البرنامج الذي  تبرمجه .لا يعمل الا على الجهاز المدخل رقمه التسلسلي.  و لا يمكن لاحد سرقته. حتى لو أاخذ البرنامج عن طريق النسخ الى جهاز آخر . لن يشتغل 

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

 

يعني اذا خصصت البرنامج لأحد معين .سيشتغل معه فقط. و الله أعلم

[saad abed]

اخى رائد

ارجو ان يتسع صدرك لاستفساراتى

ممكن شرح ولو بسيط لطريقة استخدام البرنامج

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

وهل يغلق المشروع vba بحيث لا يستطيع احد الوصول للاكواد وكلمات المرور

اشكرك

[abouelhassan]

بارك الله فيك استاذنا رائد

احترامى

[saad abed]

السلام عليكم

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

البرنامج يخفى اكوادك ومشروعك فى ملف dll

رغم ان المشروع مفتوح واكوادك تعمل فهو ينقلها تماما من الملف

برنامج ممتاز

وهناك اكواد تخفى vba

فلو وضعنا الكود قبل تشفيره اظن ان اى شخص لا يستطيع الوصول للاكواد

[الرائد77]

الكود الاصلي في ملف dll

لا يصل اليه.

عندما تضع برنام

لا  .لم اقل أن البرنامج  لا يمكن لاكثر من مستخدم ؟؟؟

قلت انشء برنامجك لشخص ما تريد بيعه له. ضع سيريال نمبر الجهاز الخاص به في كودك . ثم ششفر مللفك . الكود يصبح في ملف dll . لا يمكن الوصول له 

أاما الكود الذي تراه فهو مشفر لا يمكن نقله أو تغييره لجهاز آخر . و اذا أردت بيع برنامجك لشخص آخر غير معلوومات الجهاز ثم شفره . و ارسله له مع ملف dll

و الله أعلم 

[رولي]

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

[Yasser Fathi Albanna]

بارك الله فيك أخى الفاضل

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