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