حماية ملفات المرفقة مع البرنامج.

اخواني الاكارم تحية طيبة...

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

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

لقد استعملت لذلك RichTextBox لعرض المعلومات, فاستخدمت تنسيق rtf الذي يدعمه RichTextBox .

والسؤال هو كيف امنع المستخدم من فتح ملفات الـrtf والتعديل عليها.

أو هل هناك طريقة لتشفير ملفات الـrtf مع العلم انها تحوي صور.

علماً اني قمت بنسخ ملفات الـ rtf الى الـCD مع البرنامج.

طبعاً لا أستطيع ادراج ملفات الـ rtf ضمن code البرنامج أو ضمن Resource file لان ذلك يؤدي الى زيادة حجم الملف التنفيذي بمقدار الملفات و بطىء تحميل وعمل الملف التنفيذية.

فكرت بطريقة ولكنها بطيئة:

Public Function AsciText(SourceText As String) As String

Dim intLength As Integer, intCntr As Integer, intResult As String, Asci As Integer

    intLength = Len(SourceText)

    intResult = ""

    For intCntr = 1 To intLength

        intResult = intResult & Format(Asc(Mid(SourceText, intCntr, 1)), "000")

    Next intCntr

    AsciText = intResult



End Function



Public Function ReAsciText(SourceAsciText As String) As String



Dim intLengthRe As Integer, intCntrRe As Integer, intResultRe As String

    intLengthRe = Len(SourceAsciText)

     intResultRe = ""

    For intCntrRe = 1 To intLengthRe Step 3

        intResultRe = intResultRe & Chr(Mid(SourceAsciText, intCntrRe, 3))

    Next intCntrRe

    ReAsciLesson = intResultRe



End Function

نضع هذا الكود للتشفير:

Private Sub Command1_Click()

Dim strText As String, strCodeTxt As String, LOtext As Long, sLine As String, I As Long

For N = 1 To 40

    Label3.Caption = N

    strText = "   "   ' مسار الملف المراد تشفيره

    strCodeTxt = "    "   'مسار الملف الجديد المشفر

    Open strText For Input As #1

        While Not EOF(1)

            Line Input #1, sLine

            LOtext = LOtext + 1

        Wend

    Close #1

    sLine = ""

    Open strText For Input As #1

    Open strCodeTxt For Output As #2

        While Not EOF(1)

            Line Input #1, sLine

            Print #2, AsciText(sLine)

            I = I + 1

            ProgressBar1.Value = (100 * I) / LOtext

        Wend



    Close #2

    Close #1

    ProgressBar1.Value = 0

Next N



End Sub

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

Private Sub Command2_Click()

Dim LOtext As Long, sLine As String, I As Long

Open " 'مسار الملف المراد فك تشفيره" For Input As #1

While Not EOF(1)

    Line Input #1, sLine

    LOtext = LOtext + 1

Wend

Close #1

sLine = ""

Open " 'مسار الملف المراد فك تشفيره" For Input As #1

Open " 'مسار الملف الجديد بعد فك التشفير" For Output As #2

While Not EOF(1)

    Line Input #1, sLine

    Print #2, ReAsciText(sLine, 3)

    I = I + 1

    ProgressBar1.Value = (100 * I) / LOtext

Wend



Close #2

Close #1



ProgressBar1.Value = 0

End Sub

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

نضع الكود التالي عند حماية الملف:

Private Sub Command1_Click()

Dim ContentFile As String

Dim Password As String

Dim FileNumber As Long



LessonName = "'مسار الملف المراد حمايته"



    FileNumber = FreeFile

    

    'تهيءة المتحول بحجم الملف الذي سوف يفتح لكي يتم وضع المحتويات به

    ContentFile = Space$(FileLen(Trim$(LessonName)))

    

    Open Trim$(LessonName) For Binary As FileNumber

        Get #FileNumber, 1, ContentFile

    Close #FileNumber

    

    Password = "'c5"

    ContentFile = Password & "#" & ContentFile

    Open Trim$(LessonName) For Binary As FileNumber

        Put #FileNumber, 1, ContentFile

    Close #FileNumber

    

End Sub

وهذا الكود لفك الحماية:

Public Function OpenText(SurceTextPath As String) As String



Dim ContentFile As String

Dim FileNumber As Long

Dim i As Long

Dim ss As String

Dim RongPAssword As Integer



ContentFile = ""

    'تعريف رقم ملف جديد لدى ويندوز

    FileNumber = FreeFile

    'تهيءة المتحول بحجم الملف الذي سوف يفتح لكي يتم وضع المحتويات به

    ContentFile = Space$(FileLen(Trim$(SurceLessonPath)))

    

    'فتح الملف بشكل ثنائي ووضعه داخل المتحول

    Open Trim$(SurceLessonPath) For Binary As FileNumber

        Get #FileNumber, 1, ContentFile

    Close #FileNumber

    

    

    'يتم قرائة الملف من البداية حتى يتم التاكد من بداية الحرف

    'كلمة المرو#

    

    For i = 1 To Len(ContentFile)

        'يتم قطع عدد من الاحرف بمقدار الدوارة ووضعها داخل المتغيير حتى يتم اختبار وجود الحرف حتى تاتي العملية التالية

        ss = Mid$(ContentFile, 1, i)

        'في حال تم وجود هذا الحرف يتم الخروج من الدوارة كلي تاتي العملية التالية

        If Right$(ss, 1) = "#" Then Exit For

    Next



    'يتم قطع القيمة السابقة من الملف لكي يتم اعادته بدون كلمة مرور

    ContentFile = Mid$(ContentFile, i + 1, Len(ContentFile))

    

    'يتم تخزين الملف بدون كلمة مرور

    OpenLesson = ContentFile



End Function

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

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

فما الحل برأيكم دام فضلكم...

© ;)