文件加密

Question

编写文件加密、解密程序。经加密后文件变成乱码，不可读，只有解密后才能读。文件解密时，也要输入密码。谁能提供代码

Answer 1

Private Sub cmdStart_Click()
If Action = 0 Then
    reaction = MsgBox("You have not specified the action to take!", vbCritical)
End IfIf FreeFile = 3 Then
    Call new_coderen
Else
    reaction = MsgBox("First specify BOTH the input and output file name!", vbCritical)
End IfEnd SubPrivate Sub Command1_Click()
Close #1CommonDialog1.DialogTitle = "Choose the input file name"
CommonDialog1.Filter = "All files (*.*)|*.*"
CommonDialog1.ShowOpentxtInput.Text = CommonDialog1.FileName
Open CommonDialog1.FileName For Random As #1
End Sub
Private Sub Command2_Click()
Close #2CommonDialog1.DialogTitle = "Choose the output file name"
CommonDialog1.Filter = "All files (*.*)|*.*"
CommonDialog1.ShowSavetxtOutput.Text = CommonDialog1.FileName
Open CommonDialog1.FileName For Random As #2
End SubPrivate Sub Combo1_Click()
Action = Combo1.ListIndex + 1
End Sub
Private Sub Form_Load()
For x = 1 To 150
    List1.AddItem Str(x)
Next
List1.ListIndex = 0End Sub
Private Sub List1_Click()
maxnumber = List1.ListIndex
End Sub
模块---------------------------------------------------------------------------
Public actie As Integer
Public zin As String
Public maxnummer As Integer
Public nieuwzin As String
Public letter As String * 1
Public nieuwletter As String * 1Public Sub new_coderen()
Dim x As Integererbij = Val(Right(Str(maxnummer), 1))
If erbij = 0 Then erbij = 2
If erbij = maxnummer Then erbij = 1Do Until EOF(1)
    Get #1, , letter
If erbij = 0 Then erbij = 2
    If erbij = maxnummer Then erbij = 1
    
    'Het eigenlijk (de)coderen begint hier
    If actie = 1 Then   'coderen van de tekst
        extra = extra + erbij
        If extra >= maxnummer Then extra = 1
        nieuwletter = Chr((Asc(letter) + extra))
    Else                'decoderen van de tekst
        extra = extra + erbij
        If extra >= maxnummer Then extra = 1
        nieuwwaarde = (Asc(letter) - extra)
        If nieuwwaarde > 0 Then
            nieuwletter = Chr(nieuwwaarde)
        End If
    End If
    Put #2, , nieuwletter
LoopClose
reactie = MsgBox("Action completed", vbInformation) 
End Sub

Answer 2

楼上的注释用的什么语言啊?
'coderen van de tekst
 
看不 懂凯撒 密码?楼主可以去找找 一些强度 比较高的算法

Answer 3

http://www.csdn.net/Develop/list_article.asp?author=jlum99经典加密算法在VB中的实现（4）- DES （jlum99收藏）  Visual Basic 2267 2001-6-17  
 
经典加密算法在VB中的实现（3）- RC4 （jlum99收藏）  Visual Basic 1638 2001-6-17  
 
经典加密算法在VB中的实现（2）- MD5 （jlum99收藏）  Visual Basic 1978 2001-6-17  
 
经典加密算法在VB中的实现（1）- Base64 （jlum99收藏）  

Answer 4

经典加密算法在VB中的实现（3）- RC4     public sub main() 
dim key as string 
for i = 1 to 16 
    randomize 
    key = key & chr(rnd * 255) 
next i 
msgbox rc4(rc4("welcome to plindge studio!", key), key) 
end sub 
public function rc4(inp as string, key as string) as string 
dim s(0 to 255) as byte, k(0 to 255) as byte, i as long 
dim j as long, temp as byte, y as byte, t as long, x as long 
dim outp as string for i = 0 to 255 
    s(i) = i 
next j = 1 
for i = 0 to 255 
    if j > len(key) then j = 1 
    k(i) = asc(mid(key, j, 1)) 
    j = j + 1 
next i j = 0 
for i = 0 to 255 
    j = (j + s(i) + k(i)) mod 256 
    temp = s(i) 
    s(i) = s(j) 
    s(j) = temp 
next i i = 0 
j = 0 
for x = 1 to len(inp) 
    i = (i + 1) mod 256 
    j = (j + s(i)) mod 256 
    temp = s(i) 
    s(i) = s(j) 
    s(j) = temp 
    t = (s(i) + (s(j) mod 256)) mod 256 
    y = s(t) 
     
    outp = outp & chr(asc(mid(inp, x, 1)) xor y) 
next 
rc4 = outp 
end function 
一个简单实用的 vb 加密/解密算法  Function UserCode(password As String) As String
'用户口令加密
    Dim il_bit, il_x, il_y, il_z, il_len, i As Long
    Dim is_out As String
    il_len = Len(password)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len
        il_bit = AscW(Mid(password, i, 1))    'W系列支持unicode
        
        il_y = (il_bit * 13 Mod 256) + il_x
        is_out = is_out & ChrW(Fix(il_y))  '取整 int和fix区别: fix修正负数
        il_x = il_bit * 13 / 256
    Next
    is_out = is_out & ChrW(Fix(il_x))
    
    password = is_out
    il_len = Len(password)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len
        il_bit = AscW(Mid(password, i, 1))
        '取前4位值
        il_y = il_bit / 16 + 64
        is_out = is_out & ChrW(Fix(il_y))
        '取后4位值
        il_y = (il_bit Mod 16) + 64
        is_out = is_out & ChrW(Fix(il_y))
    Next
    UserCode = is_out
End Function
Function UserDeCode(password As String) As String
'口令解密
    Dim is_out As String
    Dim il_x, il_y, il_len, i, il_bit As Long    il_len = Len(password)
    il_x = 0
    il_y = 0
    is_out = ""
    For i = 1 To il_len Step 2
        il_bit = AscW(Mid(password, i, 1))
        '取前4位值
        il_y = (il_bit - 64) * 16
        '取后4位值
        'dd = AscW(Mid(password, i + 1, 1)) - 64
        il_y = il_y + AscW(Mid(password, i + 1, 1)) - 64
        is_out = is_out & ChrW(il_y)
    Next    il_x = 0
    il_y = 0
    password = is_out
    is_out = ""    il_len = Len(password)
    il_x = AscW(Mid(password, il_len, 1))       For i = (il_len - 1) To 1 Step -1
        il_y = il_x * 256 + AscW(Mid(password, i, 1))
        il_x = il_y Mod 13
        is_out = ChrW(Fix(il_y / 13)) & is_out
    Next
    UserDeCode = is_out
End Function