文字加密.bas

一个桌面记事本 很方便使用 可以记日记

Attribute VB_Name = "Module2"
'加密密码保存变量。
Public Password1 As String
Public Filenamex1 As String
Public Pathh As String
'加密变量定义
Public intForm, intTo As Integer
Public IntType As Integer
Public Seed(1 To 24) As Integer
Public Seedlong As Integer
Public FalX As Boolean
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()

'- 密码   -
'----------
Public Sub getseed(password)
Dim i As Long
Seedlong = Len(password)
For i = 1 To Seedlong
Seed(i) = Asc(Mid(password, i, 1)) Xor i
Next i
End Sub
'加密调用的过程。
Public Sub mi()
temp = ""
Dim intlen
Dim latter
intForm = 10
intTo = intTo + 2
intlen = Len(Form6.RichTextBox1)
Z1 = Mid(Form6.RichTextBox1.Text, 1, intForm - 1)
Z2 = Mid(Form6.RichTextBox1.Text, intForm, intTo - intForm)
z3 = Mid(Form6.RichTextBox1.Text, intTo, intlen)
a = Len(Z2)
For i = 0 To a Step Seedlong
For j = 1 To Seedlong
On Error GoTo c
latter = Asc(Mid(Z2, i + j, 1))
a: latter = Seed(j) Xor Asc(Mid(Z2, i + j, 1))
b: temp = temp & Chr(latter)
Next j
c: Next i

Form6.RichTextBox1.Text = Z1 & temp & z3
Mytext = Form6.RichTextBox1.Text
If FalX = False Then Exit Sub
On Error GoTo bye
Open Filenamex1 For Output As #1
Print #1, Mytext
Close #1
bye:
Form6.MousePointer = 1
dirty = False
Exit Sub
End Sub

'建立多级目录文件来引用函数代码。
Public Function MkDirs(ByVal PathIn As String) As Boolean
Dim nPos As Long
MkDirs = True '先假设成功
If Right$(PathIn, 1) <> "\" Then PathIn = PathIn + "\"
nPos = InStr(1, PathIn, "\")
Do While nPos > 0
If Dir$(Left$(PathIn, nPos), vbDirectory) = "" Then
On Error GoTo Failed
MkDir Left$(PathIn, nPos)
On Error GoTo 0
End If
nPos = InStr(nPos + 1, PathIn, "\")
Loop
Exit Function
Failed:
MkDirs = False
End Function
'查找文件是否存在.
Function FileExists(filename As String) As Boolean

On Error Resume Next

FileExists = Dir$(filename, vbReadOnly + vbHidden + vbSystem) <> ""

If Err.Number <> 0 Then

FileExists = False

End If

On Error GoTo 0

End Function