下面是我写的一文本文件加密器的代码，它可以加密任何字符
以下代码中的控件均采用系统默认名称。
这是加密部分：
Private Sub Command1_Click()
Dim fs As New FileSystemObject
Dim txtf As TextStream
Dim txtf2 As TextStream
Dim ans As Integer
Dim i As Integer
Dim s As String
Dim s2 As String
If Text1.Text = "" Then
ans = MsgBox("确定不设置密码吗?", vbOKCancel, "未设置密码!")
End If

If ans = vbCancel Then
Exit Sub
End If
If ans = vbOK Then
CommonDialog1.DialogTitle = "选择加密文件!"
CommonDialog1.Filter = "*.txt|*.txt|*.rtf|*.rtf|*.bak|*.bak|*.inf|*.inf|.ini|*.ini|*.sys|*.sys"
CommonDialog1.ShowOpen
If Err.Number = cdlCancel Then Exit Sub
If CommonDialog1.FileName = "" Then Exit Sub
Set txtf = fs.OpenTextFile(CommonDialog1.FileName, ForReading, False)
s = txtf.ReadAll
If s = "" Then
MsgBox "该文件没有内容!", vbOKOnly, "错误!"
Exit Sub
End If
txtf.Close
Set txtf2 = fs.CreateTextFile(CommonDialog1.FileName, True)
For i = 1 To Len(s)
s2 = StrConv(Mid(s, i), vbFromUnicode)
If AscB(StrConv(Mid(s, i), vbFromUnicode)) > 128 Then
If i <> Len(s) Then
txtf2.Write Str(AscB(MidB(s2, 1)) + 618) + "," + Str(AscB(MidB(s2, 2)) + 618) + ","
Else
txtf2.Write Str(AscB(MidB(s2, 1)) + 618) + "," + Str(AscB(MidB(s2, 2)) + 618)
End If
Else
If i <> Len(s) Then
txtf2.Write Str(AscB(s2) + 618) + ","
Else
txtf2.Write Str(AscB(s2) + 618)
End If
End If
DoEvents
Next
txtf2.Close
StatusBar1.Panels(1).Text = "文件加密完成!"
Text1.Text = ""
MsgBox "文本加密完成!", vbOKCancel, "加密完成"
Exit Sub
End If

CommonDialog1.DialogTitle = "选择加密文件!"
CommonDialog1.Filter = "*.txt|*.txt|*.rtf|*.rtf|*.bak|*.bak|*.inf|*.inf|.ini|*.ini|*.sys|*.sys"
CommonDialog1.ShowOpen
If Err.Number = cdlCancel Then Exit Sub
If CommonDialog1.FileName = "" Then Exit Sub
Set txtf = fs.OpenTextFile(CommonDialog1.FileName, ForReading, False)
s = txtf.ReadAll
If s = "" Then
MsgBox "该文件没有内容!", vbOKOnly, "错误!"
Exit Sub
End If
txtf.Close
Set txtf2 = fs.CreateTextFile(CommonDialog1.FileName, True)
For i = 1 To Len(s)
s2 = StrConv(Mid(s, i), vbFromUnicode)
If AscB(StrConv(Mid(s, i), vbFromUnicode)) > 128 Then
If i <> Len(s) Then
txtf2.Write Str(AscB(MidB(s2, 1)) + Val(Text1.Text)) + "," + Str(AscB(MidB(s2, 2)) + Val(Text1.Text)) + ","
Else
txtf2.Write Str(AscB(MidB(s2, 1)) + Val(Text1.Text)) + "," + Str(AscB(MidB(s2, 2)) + Val(Text1.Text))
End If
Else
If i <> Len(s) Then
txtf2.Write Str(AscB(s2) + Val(Text1.Text)) + ","
Else
txtf2.Write Str(AscB(s2) + Val(Text1.Text))
End If
End If
DoEvents
Next
txtf2.Close
Text1.Text = ""
StatusBar1.Panels(1).Text = "文件加密完成!"
MsgBox "文本加密完成!", vbOKCancel, "加密完成"
End Sub

下面是解密部分
Private Sub Command2_Click()
Dim fs As New FileSystemObject
Dim txtf As TextStream
Dim txtf2 As TextStream
Dim s As String
Dim i As Integer
Dim cells() As String
Dim barr(1) As Byte
If Text1.Text = "" Then
MsgBox "请输入解密密码!", vbOKOnly, "未输入密码!"
Exit Sub
End If
CommonDialog1.DialogTitle = "选择解密文件"
CommonDialog1.Filter = ""
CommonDialog1.ShowOpen
If Err.Number = cdlCancel Then Exit Sub
If CommonDialog1.FileName = "" Then Exit Sub
Set txtf = fs.OpenTextFile(CommonDialog1.FileName, ForReading, False)
On Error GoTo err1
s = txtf.ReadAll
txtf.Close
cells = Split(s, ",")
StatusBar1.Panels(1).Text = "正在对文件" + CommonDialog1.FileTitle + "进行解密..."
Set txtf2 = fs.CreateTextFile(CommonDialog1.FileName, True)
For i = 0 To UBound(cells)
If Val(cells(i)) = 0 Then GoTo errmsg
If (Val(cells(i)) - Val(Text1.Text)) <= 128 Then
txtf2.Write Chr(Val(cells(i)) - Val(Text1.Text))
Else
If Val(cells(i)) = 0 Then GoTo errmsg
barr(0) = Val(cells(i)) - Val(Text1.Text)
i = i + 1
barr(1) = Val(cells(i)) - Val(Text1.Text)
txtf2.Write StrConv(barr, vbUnicode)
End If
DoEvents
Next
txtf2.Close
StatusBar1.Panels(1).Text = "文件解密完成!"
Text1.Text = ""
MsgBox "文件解密完成!", vbOKOnly, "解密完成"
Exit Sub
errmsg:
txtf2.Write s
txtf2.Close
Text1.Text = ""
MsgBox "该加密文件遭到了破坏，无法进行解密操作！", vbOKOnly, "错误!"
Exit Sub
err1:
Text1.Text = ""
MsgBox "文件内容为空！", vbOKOnly, "错误"
End Sub

留下你的邮箱我可以把程序发给你

yaya@mail.ahnu.edu.cn

thank you ...