منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

السلام عليكم ورحمة الله وبركاته
احتاج الي كود بسيط للقيام بتشفير ملف exe
يتم التشفير كل الملفات التنفيذية التي تتواجد بنفس الفولدر عند اغلاق البرنامج
ويتم فك التشفير عند بدء استعمال البرنامج
وجدت هذا المثال هنا ولكنه يحتاج الي تحديد ملف ملف
http://vb4arb.com/vb/showthread.php?tid=...#pid129816

انتظر مساعدة بارك الله فيكم

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

تطبيق على الطريقة الأولى تعبئة الداتا غريد من مجموعة ملفات عن طريق اوبن فايل دايلوغ :

PHP كود :

   Private Sub BtnOpen_Click(sender As Object, e As EventArgs) Handles BtnOpen.Click
        MaxId()
        'استعراض الملف الذي نود وضع كلمة سر عليه ووضع مساره في عنوان النموذج
        With CommonDialog1
            .Filter = "كل الملفات (*.*)|*.*"
            .Title = "تحديد الملف"
            .FileName = ""
            .Multiselect = True
            .ShowDialog()
            If .FileName = "" Then Exit Sub
            Dim i As Integer = 1
            For Each rr In CommonDialog1.FileNames
                DataGridView1.Rows.Add(i, rr, "Password")
                i += 1
            Next
            'Txt_Path.Text = .FileName
        End With
    End Sub 

ده كود التشفير بعد التعديل لكنه لا يحفظ اسم الملف و كلمة المرور المشفرة في قاعدة البيانات فقط يشفر الملفات المحددة في اوبن فايل دايلوغ .

PHP كود :

   Public Sub EncryptionWithPass()
        Dim ContentFile As String
        Dim Password As String
        Dim FileNumber As Integer
        For Each row As DataGridViewRow In DataGridView1.Rows
            If row.Cells(1).Value = String.Empty Or row.Cells(2).Value = String.Empty Then
                MsgBox("الرجاء تحديد مسار الملف و كلمة المرور", MsgBoxStyle.Critical, "خطأ")
                Exit Sub
            End If
            'تعريف رقم ملف جديد لدى ويندوز
            FileNumber = FreeFile()
            'تهيءة المتحول بحجم الملف الذي سوف يفتح لكي يتم وضع المحتويات به
            ContentFile = Space(FileLen(Trim(row.Cells(1).Value)))
            'فتح الملف بشكل ثنائي ووضعه داخل المتحول
            FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
            FileGet(FileNumber, ContentFile, 1)
            FileClose(FileNumber)
            'فتح مربع الحوار الادخال لوضع كلمة المرورو الجديدة
            Password = row.Cells(2).Value 'InputBox("قم بتعيين كلمة المرور للملف على الا تزيد عن ثمانية خانات", "كلمة مرور")
            'تم تحديد عدد الخانات بسبب القرائة من جديد فيجب ان نعرف نقراء من اين اوي مكننا حل المشكلة بوضع علامة مميزة لبدء كلمة المرور ونهايتها مثلا كعلامة #
            'كلمة السر#
            'اما في حال تحديد العدد المعين فنقوم بملاء الخانات البقاية باصفار وسوف نستخدم هنا الطريقة الاولى
            'مع اننا حددنا عدد الخانات ولكن لن نعطي هذا اي اهمية داخل البرمجة حتى ولو زاد العدد عن ثمانية
            'وضع كلمة المرور في بداية الملف قبل مكونات الملف الاصلي ويمكن تحديد مكان اخر او تشغيير ملف
            'قمنا بوضع العلامة التي تقوم ببيان البداية والنهاية
            ContentFile = Password & "#" & ContentFile
            'في حال كنت ستسخدم كلمة السر في بايت محدد فانه من الواجب عليك بان تقوم باختيار حرف بداية وحرف نهاية غير معروف او غير مستخدم في تشفير الملف ولذلك انصح بان تستخدم الطريقة التالية
            'هذه الطريقة في حال كانة كلمة السر في مكان اخر داخل الملف طبعا لاننا لو قمنا بفتح الملف داخل محرر نصوصو وكانة في البداية فسوف نعرف كلمة المرور
            'طبعا هذا الاحتمال وارد وغير وارد فالكثير لايتوقع ان يتم التشفير بهذه الطريقة ولكن البعض يقوم بفتح الملف كما اعمل انا عند ارادة فك كلمة مرور
            'يتم اختبار عدد المحارف
            'يتم وضع عدد محارف كلمة المرور لكي يتم قرائة هذا العدد من الملف ولكي لانقوم بحذف او تعديل حرف المربع في حال كان ضمن الملف
            'طبعا نقوم بذلك بعد ان نقوم بتقسيم الملف لقسمين حتى نضع كلمة المرور في الداخل
            'ContentFile = ContentFile1 & "#" & Len(Password) & "#" & Password & "#" & ContentFile2
            'يتم فتح الملف مرة اخرى وذلك لتخزين القيم الجديدة به اي بعد وضع كلمة المرور
            FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
            FilePut(FileNumber, ContentFile, 1)
            FileClose(FileNumber)
            'ولكن ضع في حسبانك ان بعض الملفات لاتتاثر عند وضع كلمة السر في بداية الملف وتفتح بطريقة عادية
            'SavePathInDatabase()
            'FRMEncryptionWithPassLoad()
        Next
msgbox("Winnnnnn……...")
    End Sub 

و ده كود فك التشفير .

PHP كود :

   Public Sub DecryptionWithPass()
        BtnOpen_Click(Nothing, Nothing)
        Dim ContentFile As String = String.Empty
        Dim Password As String = String.Empty
        Dim FileNumber As Integer = 0
        Dim i As Integer = 0
        Dim ss As String = String.Empty
        Dim sss As String = String.Empty
        For Each row As DataGridViewRow In DataGridView1.Rows
            If row.Cells(1).Value = String.Empty Or row.Cells(2).Value = String.Empty Then
                MsgBox("الرجاء تحديد مسار الملف و كلمة المرور", MsgBoxStyle.Critical, "خطأ")
                Exit Sub
            ElseIf DataGridView1.Rows.Count = 0 Then
                If MsgBox("هل تريد فك تشفير ملف غير مسجل بقاعدة البيانات ", MsgBoxStyle.YesNo, "فك تشفير ملف") = MsgBoxResult.No Then
                    Exit Sub
                End If
            End If

            FileNumber = FreeFile()
            'تهيءة المتحول بحجم الملف الذي سوف يفتح لكي يتم وضع المحتويات به
            ContentFile = Space(FileLen(Trim(row.Cells(1).Value)))
            'فتح الملف بشكل ثنائي ووضعه داخل المتحول
            FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
            FileGet(FileNumber, ContentFile, 1)
            FileClose(FileNumber)
            'يتم قرائة الملف من البداية حتى يتم التاكد من بداية الحرف
            'كلمة المرو#
            For i = 1 To Len(ContentFile)
                'يتم قطع عدد من الاحرف بمقدار الدوارة ووضعها داخل المتغيير حتى يتم اختبار وجود الحرف حتى تاتي العملية التالية
                ss = Mid(ContentFile, 1, i)
                'في حال تم وجود هذا الحرف يتم الخروج من الدوارة كلي تاتي العملية التالية
                If Strings.Right(ss, 1) = "#" Then Exit For
            Next
            'يتم قص كلمة السر من الملف حتى الحرف القبل الاخير والذي هو علامة المربع
            sss = Mid(ss, 1, (Len(ss) - 1))
            inte1 += 1
            'يتم الحصول على كلمة المرور حتى يتم التاكد من صحتها
10:         Password = row.Cells(2).Value ' InputBox("هذا الملف محمي بكلمة مرور قم بوضع كلمة المرور حت يتم التاكد منها", "كلمة المرور")
            'يتم التحقق من كلمة المرور في حال كانة صحيحة يتم ازالتها من الملف والا يتم الخروج دون التغيير في الملف
            If Password = sss Then
                'MsgBox("كلمة المرور صحيحة وسوف يتم ازالة الحماية عن الملف")
                'DeleteRecord()
                If ExitDel = "Exit Sub" Then
                    Exit Sub
                End If
                'يتم قطع القيمة السابقة من الملف لكي يتم اعادته بدون كلمة مرور
                ContentFile = Mid(ContentFile, i + 1, Len(ContentFile))
                'يتم تخزين الملف بدون كلمة مرور
                FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
                FilePut(FileNumber, ContentFile, 1)
                FileClose(FileNumber)
                'FRMEncryptionWithPassLoad()
                'LoadDTGridView()
            Else
                'اظهار رسال
                If MsgBox("كلمة السر هذه خاطئة هل تود المحاولة مرة اخرى ", MsgBoxStyle.YesNo, "كلمة خاطئة") = MsgBoxResult.Yes Then
                    'يتم اعادته الى مربع ادخال كلمة السر من جديد
                    GoTo 10
                Else
                    'يتم الخروج دون تعديل الملف
                    Exit Sub
                End If
            End If
        Next
        MsgBox("Winnnnnnnn...........")
    End Sub 

حان الان موعد قطع الكهرباء نكمل الطريقة الثانية عند عودة الكهرباء باذن الله .

الطريقة الثانية عن طريق جلب الملفات من مكان محدد الكود مشروح :

PHP كود :

   Private Sub Btn_GetFile_Click(sender As Object, e As EventArgs) Handles Btn_GetFile.Click
        Dim i As Integer = 1
        'لوب بحث عن ملفات في المجلد المحدد '
        For Each FileXT In IO.Directory.GetFiles("C:\Users\AL-ASEM\Desktop\Exil")
            DataGridView1.Rows.Add(i, FileXT, "Password")
            i += 1
        Next
        'إذا أردت البحث في مجلد الموجود به البرنامج مع إستثناء بعض الملفات '
        Dim GetPath As String = Application.StartupPath
        'لوب لعمل بحث عن ملفات في المجلد المحدد و إضافتها للداتا غريد فيو ' 
        For Each FileXT In IO.Directory.GetFiles(GetPath)
            'كود إستثناء بعض الملفات من المجلد لانه اذا شفرت ملف البرنامج كيف ستفك تشفيره '
            If FileXT <> GetPath & "\EncryptionFileWithPassword.exe" Then
                'اذ اردت استثناء أكثر من ملف ضع العبارة الشرطية كا التالي :'
                'If FileXT <> GetPath & "\EncryptionFileWithPassword.exe" or FileXT <> GetPath & "\db.mdb" Then '
                DataGridView1.Rows.Add(i, FileXT, "Password")
                i += 1
            End If
        Next
    End Sub 

كود التشفير :

PHP كود :

       Dim inte1 As Integer = 0

    Dim ExitDel As String = String.Empty
Public Sub EncryptionWithPass()
        Dim ContentFile As String
        Dim Password As String
        Dim FileNumber As Integer
        For Each row As DataGridViewRow In DataGridView1.Rows
            If row.Cells(1).Value = String.Empty Or row.Cells(2).Value = String.Empty Then
                MsgBox("الرجاء تحديد مسار الملف و كلمة المرور", MsgBoxStyle.Critical, "خطأ")
                Exit Sub
            End If
            'تعريف رقم ملف جديد لدى ويندوز '
            FileNumber = FreeFile()
            'تهيءة المتحول بحجم الملف الذي سوف يفتح لكي يتم وضع المحتويات به '
            ContentFile = Space(FileLen(Trim(row.Cells(1).Value)))
            'فتح الملف بشكل ثنائي ووضعه داخل المتحول '
            FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
            FileGet(FileNumber, ContentFile, 1)
            FileClose(FileNumber)
            'فتح مربع الحوار الادخال لوضع كلمة المرورو الجديدة '
            'InputBox("قم بتعيين كلمة المرور للملف على الا تزيد عن ثمانية خانات", "كلمة مرور")'
            'أو أخذ كلمة المرور من حقل معين في الداتا غريد'
            Password = row.Cells(2).Value
            'تم تحديد عدد الخانات بسبب القرائة من جديد فيجب ان نعرف نقراء من اين اوي مكننا حل المشكلة بوضع علامة مميزة لبدء كلمة المرور ونهايتها مثلا كعلامة # '
            'كلمة السر # '
            'اما في حال تحديد العدد المعين فنقوم بملاء الخانات البقاية باصفار وسوف نستخدم هنا الطريقة الاولى '
            'مع اننا حددنا عدد الخانات ولكن لن نعطي هذا اي اهمية داخل البرمجة حتى ولو زاد العدد عن ثمانية '
            'وضع كلمة المرور في بداية الملف قبل مكونات الملف الاصلي ويمكن تحديد مكان اخر او تشغيير ملف  '
            'قمنا بوضع العلامة التي تقوم ببيان البداية والنهاية '
            ContentFile = Password & "#" & ContentFile
            'في حال كنت ستسخدم كلمة السر في بايت محدد فانه من الواجب عليك بان تقوم باختيار حرف بداية وحرف نهاية غير معروف او غير مستخدم في تشفير الملف ولذلك انصح بان تستخدم الطريقة التالية '
            'هذه الطريقة في حال كانة كلمة السر في مكان اخر داخل الملف طبعا لاننا لو قمنا بفتح الملف داخل محرر نصوصو وكانة في البداية فسوف نعرف كلمة المرور '
            'طبعا هذا الاحتمال وارد وغير وارد فالكثير لايتوقع ان يتم التشفير بهذه الطريقة ولكن البعض يقوم بفتح الملف كما اعمل انا عند ارادة فك كلمة مرور '
            'يتم اختبار عدد المحارف '
            'يتم وضع عدد محارف كلمة المرور لكي يتم قرائة هذا العدد من الملف ولكي لانقوم بحذف او تعديل حرف المربع في حال كان ضمن الملف '
            'طبعا نقوم بذلك بعد ان نقوم بتقسيم الملف لقسمين حتى نضع كلمة المرور في الداخل '
            'يتم فتح الملف مرة اخرى وذلك لتخزين القيم الجديدة به اي بعد وضع كلمة المرور '
            FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
            FilePut(FileNumber, ContentFile, 1)
            FileClose(FileNumber)
            'ولكن ضع في حسبانك ان بعض الملفات لاتتاثر عند وضع كلمة السر في بداية الملف وتفتح بطريقة عادية '
        Next
        MsgBox("Winnnnnnn..........")
    End Sub 

كود فك التشفيير :

PHP كود :

   Public Sub DecryptionWithPass()
        Dim ContentFile As String = String.Empty
        Dim Password As String = String.Empty
        Dim FileNumber As Integer = 0
        Dim i As Integer = 0
        Dim ss As String = String.Empty
        Dim sss As String = String.Empty
        For Each row As DataGridViewRow In DataGridView1.Rows
            If row.Cells(1).Value = String.Empty Or row.Cells(2).Value = String.Empty Then
                MsgBox("الرجاء تحديد مسار الملف و كلمة المرور", MsgBoxStyle.Critical, "خطأ")
                Exit Sub
            ElseIf DataGridView1.Rows.Count = 0 Then
                If MsgBox("هل تريد فك تشفير ملف غير مسجل بقاعدة البيانات ", MsgBoxStyle.YesNo, "فك تشفير ملف") = MsgBoxResult.No Then
                    Exit Sub
                End If
            End If

            FileNumber = FreeFile()
            'تهيءة المتحول بحجم الملف الذي سوف يفتح لكي يتم وضع المحتويات به '
            ContentFile = Space(FileLen(Trim(row.Cells(1).Value)))
            'فتح الملف بشكل ثنائي ووضعه داخل المتحول '
            FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
            FileGet(FileNumber, ContentFile, 1)
            FileClose(FileNumber)
            'يتم قرائة الملف من البداية حتى يتم التاكد من بداية الحرف '
            'كلمة المرو # '
            For i = 1 To Len(ContentFile)
                'يتم قطع عدد من الاحرف بمقدار الدوارة ووضعها داخل المتغيير حتى يتم اختبار وجود الحرف حتى تاتي العملية التالية '
                ss = Mid(ContentFile, 1, i)
                'في حال تم وجود هذا الحرف يتم الخروج من الدوارة كلي تاتي العملية التالية '
                If Strings.Right(ss, 1) = "#" Then Exit For
            Next
            'يتم قص كلمة السر من الملف حتى الحرف القبل الاخير والذي هو علامة المربع '
            sss = Mid(ss, 1, (Len(ss) - 1))
            inte1 += 1
            'يتم الحصول على كلمة المرور حتى يتم التاكد من صحتها '
10:         Password = row.Cells(2).Value ' InputBox("هذا الملف محمي بكلمة مرور قم بوضع كلمة المرور حت يتم التاكد منها", "كلمة المرور")
            'يتم التحقق من كلمة المرور في حال كانة صحيحة يتم ازالتها من الملف والا يتم الخروج دون التغيير في الملف
            If Password = sss Then
                If ExitDel = "Exit Sub" Then
                    Exit Sub
                End If
                'يتم قطع القيمة السابقة من الملف لكي يتم اعادته بدون كلمة مرور '
                ContentFile = Mid(ContentFile, i + 1, Len(ContentFile))
                'يتم تخزين الملف بدون كلمة مرور '
                FileOpen(FileNumber, Trim(row.Cells(1).Value), OpenMode.Binary)
                FilePut(FileNumber, ContentFile, 1)
                FileClose(FileNumber)
            Else
                'اظهار رسالة '
                If MsgBox("كلمة السر هذه خاطئة هل تود المحاولة مرة اخرى ", MsgBoxStyle.YesNo, "كلمة خاطئة") = MsgBoxResult.Yes Then
                    'يتم اعادته الى مربع ادخال كلمة السر من جديد '
                    GoTo 10
                Else
                    'يتم الخروج دون تعديل الملف '
                    Exit Sub
                End If
            End If
        Next
        MsgBox("Winnnnnnnn...........")
    End Sub 

جزيت خيرا اخي الفاضل

قمت بالتطبيق علي فتح الملفات من خلال فولدر

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

عند فك التشفير

تظهر لي هذه الرسالة

ضع في قسم التصاريح :

كود :

   Dim inte1 As Integer = 0

    Dim ExitDel As String = String.Empty

جزاك الله خيرا كثيرا الان كل شي مظبوط اكرمك الله عزوجل بكل خير

مرحبا في عندي سؤال وانا جديده على موقع سؤالي بلغه فجول انو كيف افتح مستند txt عن طريق مربع الحوار open رجاءا الي يعرف يجاوب

منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

dametucorazon

dametucorazon

asemshahen5

asemshahen5

dametucorazon

asemshahen5

dametucorazon

Asraa