Option Explicit
'Sorue为原字符串路径
'Code为与或的字符长度
Private Function UnPass(SoruePath As String, Code As String) As String '解密过程
Dim FileNo As Integer
Dim Number As String
FileNo = FreeFile
If SoruePath <> "" Then
If Code = "" Then Exit Function 'if Cancel chosen, exit sub
Screen.MousePointer = 13 '让系统鼠标变成忙
On Error GoTo Problem:
Open SoruePath For Input As #FileNo
Do Until EOF(1)
Input #FileNo, Number
UnPass = UnPass & Chr(Number Xor Code)
LoopCleanUp: 'when finished...
Screen.MousePointer = 0 '让系统鼠标变成正常
Close #FileNo
End If
Exit Function
Problem:
If Err.Number = 5 Then
MsgBox ("Incorrect Encryption Key")
Else
MsgBox "Error Opening File", , Err.Description
End If
Resume CleanUp:
End Function
'Sorue为原字符串
'Code为与或的字符长度
Private Function Pass(Sorue As String, Code As String) As String '加密过程
Dim CharsInFile As Integer
Dim i As Integer
Dim Letter As String
If Sorue <> "" Then
If Code = "" Then Exit Function
Screen.MousePointer = 13 '让系统鼠标变成忙
CharsInFile = Len(Sorue) '字符串的长度
For i = 1 To CharsInFile '循环字符串的长度
Letter = Mid(Sorue, i, 1) '取出字符
Pass = Pass & (Asc(Letter$) Xor Code) ' 进行与或加密
Next i%
Screen.MousePointer = 0 '让系统鼠标变成正常
End If
End Function
'Sorue为原字符串路径
'Code为与或的字符长度
Private Function UnPass(SoruePath As String, Code As String) As String '解密过程
Dim FileNo As Integer
Dim Number As String
FileNo = FreeFile
If SoruePath <> "" Then
If Code = "" Then Exit Function 'if Cancel chosen, exit sub
Screen.MousePointer = 13 '让系统鼠标变成忙
On Error GoTo Problem:
Open SoruePath For Input As #FileNo
Do Until EOF(1)
Input #FileNo, Number
UnPass = UnPass & Chr(Number Xor Code)
LoopCleanUp: 'when finished...
Screen.MousePointer = 0 '让系统鼠标变成正常
Close #FileNo
End If
Exit Function
Problem:
If Err.Number = 5 Then
MsgBox ("Incorrect Encryption Key")
Else
MsgBox "Error Opening File", , Err.Description
End If
Resume CleanUp:
End Function
'Sorue为原字符串
'Code为与或的字符长度
Private Function Pass(Sorue As String, Code As String) As String '加密过程
Dim CharsInFile As Integer
Dim i As Integer
Dim Letter As String
If Sorue <> "" Then
If Code = "" Then Exit Function
Screen.MousePointer = 13 '让系统鼠标变成忙
CharsInFile = Len(Sorue) '字符串的长度
For i = 1 To CharsInFile '循环字符串的长度
Letter = Mid(Sorue, i, 1) '取出字符
Pass = Pass & (Asc(Letter$) Xor Code) ' 进行与或加密
Next i%
Screen.MousePointer = 0 '让系统鼠标变成正常
End If
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货