vb101
04-10-2009, 03:18 PM
السلام عليكم
لمن يريد أن يعرف كيفية تشفير الملفات أي نوع هذه هي الطريقة:
أولا افتح برنامج فيوال بيسك 6.0
وضع على الفورم الأول زرين أمر وأداة CommonDialog1
ضع في زر الأمر الأول (لتشفير ملف) الكود التالي:
Private Sub command1_Click()
Dim ContentFile As String
Dim Password As String
Dim FileNumber As Long
With CommonDialog1
.Filter = "كل الملفات (*.*)|*.*|"
.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or cdlOFNPathMustExist
.DialogTitle = "حدد الملف المراد حذفه"
.FileName = ""
.ShowOpen
If .FileName = "" Then Exit Sub
Caption = .FileName
End With
FileNumber = FreeFile
ContentFile = Space$(FileLen(Trim$(Caption)))
Open Trim$(Caption) For Binary As FileNumber
Get #FileNumber, 1, ContentFile
Close #FileNumber
Password = InputBox("ضع كلمة المرور على ألا تزيد على ثمانية حروف أو أرقام", "كلمة مرور")
ContentFile = Password & "#" & ContentFile
Open Trim$(Caption) For Binary As FileNumber
Put #FileNumber, 1, ContentFile
Close #FileNumber
End Sub
وفي زر الأمر الثاني (لإلغاء تشفير الملف) الكود التالي:
Private Sub command2_Click()
Dim ContentFile As String
Dim Password As String
Dim FileNumber As Long
Dim i As Long
Dim ss As String
Dim sss As String
Dim RongPAssword As Integer
With CommonDialog1
.Filter = "كل الملفات (*.*)|*.*|"
.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or cdlOFNPathMustExist
.DialogTitle = "تحدد الملف المراد حذفه"
.FileName = ""
.ShowOpen
If .FileName = "" Then Exit Sub
Caption = .FileName
End With
FileNumber = FreeFile
ContentFile = Space$(FileLen(Trim$(Caption)))
Open Trim$(Caption) 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
sss = Mid$(ss, 1, (Len(ss) - 1))
10 Password = InputBox("هذا الملف محمي بكلمة مرور قم بوضع كلمة المرور حت يتم التاكد منها", "كلمة المرور")
If Password = sss Then
MsgBox "كلمة المرور صحيحة وسوف يتم ازالة الحماية عن الملف"
Else
RongPAssword = MsgBox("كلمة السر هذه خاطئة هل تود المحاولة مرة اخرى ", vbYesNo, "كلمة خاطئة")
If RongPAssword = vbYes Then
GoTo 10
Else
Exit Sub
End If
End If
ContentFile = Mid$(ContentFile, i + 1, Len(ContentFile))
Open Trim$(Caption) For Binary As FileNumber
Put #FileNumber, 1, ContentFile
Close #FileNumber
End Sub
إن شاء الله تكونون فهمت الكود وإذا فيه سأل إن شاء الله أنا حاضر
أخوكم:
الشرعبي
:D:D:D:D
لمن يريد أن يعرف كيفية تشفير الملفات أي نوع هذه هي الطريقة:
أولا افتح برنامج فيوال بيسك 6.0
وضع على الفورم الأول زرين أمر وأداة CommonDialog1
ضع في زر الأمر الأول (لتشفير ملف) الكود التالي:
Private Sub command1_Click()
Dim ContentFile As String
Dim Password As String
Dim FileNumber As Long
With CommonDialog1
.Filter = "كل الملفات (*.*)|*.*|"
.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or cdlOFNPathMustExist
.DialogTitle = "حدد الملف المراد حذفه"
.FileName = ""
.ShowOpen
If .FileName = "" Then Exit Sub
Caption = .FileName
End With
FileNumber = FreeFile
ContentFile = Space$(FileLen(Trim$(Caption)))
Open Trim$(Caption) For Binary As FileNumber
Get #FileNumber, 1, ContentFile
Close #FileNumber
Password = InputBox("ضع كلمة المرور على ألا تزيد على ثمانية حروف أو أرقام", "كلمة مرور")
ContentFile = Password & "#" & ContentFile
Open Trim$(Caption) For Binary As FileNumber
Put #FileNumber, 1, ContentFile
Close #FileNumber
End Sub
وفي زر الأمر الثاني (لإلغاء تشفير الملف) الكود التالي:
Private Sub command2_Click()
Dim ContentFile As String
Dim Password As String
Dim FileNumber As Long
Dim i As Long
Dim ss As String
Dim sss As String
Dim RongPAssword As Integer
With CommonDialog1
.Filter = "كل الملفات (*.*)|*.*|"
.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist Or cdlOFNPathMustExist
.DialogTitle = "تحدد الملف المراد حذفه"
.FileName = ""
.ShowOpen
If .FileName = "" Then Exit Sub
Caption = .FileName
End With
FileNumber = FreeFile
ContentFile = Space$(FileLen(Trim$(Caption)))
Open Trim$(Caption) 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
sss = Mid$(ss, 1, (Len(ss) - 1))
10 Password = InputBox("هذا الملف محمي بكلمة مرور قم بوضع كلمة المرور حت يتم التاكد منها", "كلمة المرور")
If Password = sss Then
MsgBox "كلمة المرور صحيحة وسوف يتم ازالة الحماية عن الملف"
Else
RongPAssword = MsgBox("كلمة السر هذه خاطئة هل تود المحاولة مرة اخرى ", vbYesNo, "كلمة خاطئة")
If RongPAssword = vbYes Then
GoTo 10
Else
Exit Sub
End If
End If
ContentFile = Mid$(ContentFile, i + 1, Len(ContentFile))
Open Trim$(Caption) For Binary As FileNumber
Put #FileNumber, 1, ContentFile
Close #FileNumber
End Sub
إن شاء الله تكونون فهمت الكود وإذا فيه سأل إن شاء الله أنا حاضر
أخوكم:
الشرعبي
:D:D:D:D