بسم الله الرحمن الرحيم
سأخاطب بهذا الموضوع من له معرفة جيده بالاكسيل وبلغة البرمجه vba
اليوم ولكثر السؤال عن حماية العمل الخاص بي وكيفية الوصول لاكثر الطرق امننا وبعد شوط كبير في دراسة الامر اليكم مجموعة من الخطواط اكتشفت الان انها الاكثر اماننا
ويجب التنويه ان الكود المستخدم اليوم من حفظ اى ملف واستدعائة داخل شيت الاكسيل من تنفيذ الاستاذ ياسر خليل
وايضا لضيق الوقت سأضع المستفسر على اول الطريق وهو يكمل كما يحب بمعنى سأوضح له طريقة التنفيذ وهو ينفذ كما يحب ويري وللعمل الاكواد والملفات التنفيذية المستخدمة قمت بانشائها سريعا ولم اراجع الاكواد جيدا للوقوف على اي خطأ ، علشان كدا نوهت اولا انى اخاطب من لديه معرفة جيده بلغة البرمج
نأتي للشرح والتنفيذ
اولا : يجب عمل ملفين تنفيذيين باى لغة برمجه تحبها وتفضلها وبالملف التنفيذي تضع كود دور بمجرد فتح الملف يقوم بفتح ملف اكسيل محمي بباس من الخارج واليك الكود المستخدم من ملف vb.net او vb6
CODE
Private Sub Form_Load()
Dim strPassword As String
Dim FileName As String
On Error GoTo 1
strPassword = "456"
FileName = App.Path + "" + "2.xlsm"
On Error GoTo 1
Excel.Workbooks.Open FileName, Password:="" & strPassword
Excel.Application.Visible = False
Start = Timer
Finsh = Start + 10
Do Until Finsh <= Timer
DoEvents
Loop
Unload Form1
1:
Unload Form1
End Sub
ففيى حدث الفتح للفورم مباشرتا يفتح ملف اكسيل المسمي برقم 1 والباس الخارجي له هو 123
ثانيا : اقوم بأنشاء ملف اكسيل واسميه برقم 1 واضع به فورم وأخفي الشيت واظهر الفورم والذى به مديول وانقل له هذا الكود
CODE
Sub Save_Hex_File()
Dim wks As Worksheet
Dim fileName As String
Set wks = Worksheets("Hex Byte Data")
fileName = ThisWorkbook.Path & "" & wks.Range("Ah1").Value
If Dir(fileName) <> "" Then
Call SaveAsHexFile(fileName)
' MsgBox "File Saved", 64
Else
MsgBox "The File '" & fileName & "' Not Found."
End If
End Sub
Sub Restore_Hex_File()
Dim wks As Worksheet
Dim fileName As String
Set wks = Worksheets("Hex Byte Data")
fileName = ThisWorkbook.Path & "" & wks.Range("Ah1").Value
fileName = RestoreHexFile
' MsgBox "File Restored", 64
End Sub
Private Sub SaveAsHexFile(ByVal fileName As String)
Dim wks As Worksheet
Dim data() As Variant
Dim x As String
Dim dataByte As Byte
Dim n As Integer
Dim i As Long
Dim r As Long
Dim c As Long
If Dir(fileName) = "" Then Exit Sub
On Error Resume Next
Set wks = Worksheets("Hex Byte Data")
If Err = 9 Then
Worksheets.Add After:=Worksheets.Count
Set wks = ActiveSheet
wks.Name = "Hex Byte Data"
End If
On Error GoTo 0
wks.Cells.ClearContents
wks.Cells(1, "AH").Value = Dir(fileName)
n = FreeFile
Application.ScreenUpdating = False
Application.ErrorCheckingOptions.NumberAsText = False
With wks.Columns("A:AF")
.NumberFormat = "@"
.Cells.HorizontalAlignment = xlCenter
Open fileName For Binary Access Read As #n
ReDim data((LOF(n) - 1) 32, 31)
For i = 0 To LOF(n) - 1
Get #n, , dataByte
c = i Mod 32
r = i 32
x = Hex(dataByte)
If dataByte < 16 Then x = "0" & x
data(r, c) = x
Next i
Close #n
wks.Range("A1:AF1").Resize(r + 1, 32).Value = data
End With
Application.ScreenUpdating = True
End Sub
Function RestoreHexFile() As String
Dim wks As Worksheet
Dim lsb As Variant
Dim msb As Variant
Dim cell As Range
Dim rng As Range
Dim file As String
Dim n As Integer
Dim data() As Byte
Dim j As Long
On Error Resume Next
Set wks = Worksheets("Hex Byte Data")
If Err <> 0 Then
MsgBox "The Worksheet 'Hex Byte Data' Is Missing.", vbCritical
Exit Function
End If
On Error GoTo 0
Set rng = wks.Range("A1").CurrentRegion
file = wks.Cells(1, "AH").Value
If file <> "" Then
n = FreeFile
file = ThisWorkbook.Path & "" & file
Open file For Binary Access Write As #n
ReDim data(Application.CountA(rng) - 1)
For Each cell In rng
If cell = "" Then Exit For
msb = Left(cell, 1)
If IsNumeric(msb) Then msb = 16 * msb Else msb = 16 * (Asc(msb) - 55)
lsb = Right(cell, 1)
If Not IsNumeric(lsb) Then lsb = (Asc(lsb) - 55) Else lsb = lsb * 1
data(j) = msb + lsb
j = j + 1
Next cell
Put #n, , data
Close #n
End If
RestoreHexFile = file
End Function
والذي نوهت مسبقا انه من صنع استاذ ياسر خليل ودور الكود باختصار انه يقوم بحفظ اى ملف سواء كان صوت او صورة او فديو داخل شيت الاكسيل بطريقة لن يستطيع احد فك تشفيرها
والكود الاول يقوم بالحفظ والثانى بالاستدعاء وداخل الملف رقم 1 ستجد الشرح
المهم نعود لموضوعنا الرئيسي في حدث فتح الملف نضع الكود التالى
CODE
Option Explicit<br />
<br />
Private Sub Workbook_Open()<br />
ThisWorkbook.Application.WindowState = xlMaximized<br />
ThisWorkbook.Application.Visible = False<br />
UserForm1.Show<br />
End Sub<br />
<br />
وفيه يخفي الشيت ويظهر الفورم ويوجد بالفورم زر نضع به الكود التالى
CODE
Dim Mypath As String
On Error GoTo 2
Call Restore_Hex_File
Application.Wait Now + TimeValue("00:00:1")
Mypath = ThisWorkbook.Path & "" & "Project2.exe"
Call Shell(Mypath)
2:
Application.Wait Now + TimeValue("00:00:10")
Kill Mypath
ThisWorkbook.Save
ThisWorkbook.Close
وفكرة الكود انه يقوم باستدعاء الملف المخزن داخل الشيت واسم الملف هو Project2.exe الله ايه ده جه منين اقولك لو مركز معايا هتلقيني قايل في اولا نعمل ملفين تنفيذين مش ملف واحد الاول المستخدم يفتح منه والثاني مخفي داخل ملف الاكسيل رقم 1 ولكن في الملف التنفيذي الثاني وضع ان الباص هو 456 وان الملف الى هيفتحه هو ملف الاكسل المسي 2 وملف الاكسيل ده هو المشروع الرئيسي
ودور الكود انه يستدعى الملف التنفيذى الثاني ثم يقوم بفتحه ويقوم الملف التنفيذي الثاني بفتح ملف الاكسيل المحمي بالخارج الثاني بباص اخر ثم بعد الفتح يحذف الملف التنفيذي الثاني ثم يغل ملف الاكسيل الاول ويفتح المشروع
الله انتوا تهتو مني انا عن نفسي تهت من نفسي الفكرة انه فيه ناس حريفة لغات برمجه اخرى ممكن يحصلو على الملف التنفيذية ويهكروه ويجيبوا منه الباص طيب انا بقة هعمله ملف تانى مخفي هو الى يفتح المشروع الرئيسي وفيهه باص غير الى وصله له
ومش هقول انها مستحيلة الاختراق ولكنها اكثر صعوبه الا لو المخترق محترف او لديه فكرة عن الامر يبقي انا عقد الامر له اكثر
وممكن في زيادة التعقيد ان الكود الى في الملفات التنفيذية ميكنش واضع الباص بطريقة مباشرة يكون فيه لف ودوران بيحث تتوهه ازى يجب الكود وده ان شاء الله يكون موضوع تاني مستقبلا
شكرا لكم واسف على الاطالة مرفق لكم المشروع ارجوا التجربه لفهم الامر
ملحوظة اخيره هامه ممكن الاستعغناء عن الفورم بالملف رقم 1 وعمل الكود مباشرتا من حدث فتح ملف العمل ولكنى عملت كدا علشان تطلعوا على الاكواد
تم حذف المرفقات واضافتها مره أخرى
تحياتى وتقديرى