Option PublicOption Explicit% REM character conversion function or file is in Base64 format% END REMConst b64chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 /" Sub Initialize 'example: Agent Dim eString As String, dString As StringDim isOkay As IntegereString = "QUJDREVGRw =="' ** ABCDEFGdString = DecodeBase64 (eString) isOkay = IsBase64 (eString) eString = EncodeBase64 ( "AbCdEfG" & Chr (0) & "123") eString = BreakString (eString, 5) dString = DecodeBase64 (eString) isOkay = IsBase64 (RemoveWhitespace (eString)) Isokay = isbase64 (dstring) isokay = encodefile ("c: /autoexec.bat", "c: /autoexec.enc") isokay = decodefile ("c: /autoexec.enc", "c: /autoexec.dec") End subFunction DecodeBase64 (Byval encText As String) As String On Error Goto endOfFunctionDim encNum As LongDim decText As StringDim i As Integer '** delete space characters encText = RemoveWhitespace (encText) For i = 1 To Len (encText) Step 4' ** Encnum = (Instr (B64Chars, MID $ (EncText, I, 1)) - 1) * (2 ^ 18) Encnum = Encnum OR ((INSTR (B64Chars, MID $ (EncText, i 1, 1)) - 1 ) * (2 ^ 12)) '** if (MID $ (ENCTE) XT, I 2, 1) = "=") Thendectext = DECTEXT & CHR (FIX (Encnum / (2 ^ 16)) and & HFF) Elseif (MID $ (EncText, i 3, 1) = "=") Thenencnum = Encnum OR ((INSTR (B64CHARS, MID $ (EncText, i 2, 1)) - 1) * (2 ^ 6)) DECTEXT = DECTEXT & CHR (FIX (Encnum / (2 ^ 16)) and & HFF ) DECText = DECTEXT & CHR (FIX (Encnum / (2 ^ 8)) and & hff) ElseENCNUM = Encnum OR ((INSTR (B64Chars, MID $ (EncText, i 2, 1)) - 1) * (2 ^ 6 Encnum = Encnum OR (Instr (B64Chars, MID $ (EncText, i 3, 1)) - 1) Dectext = DECText &
Chr (Fix (encNum / (2 ^ 16)) And & HFF) decText = decText & Chr (Fix (encNum / (2 ^ 8)) And & HFF) decText = decText & Chr (encNum And & HFF) End IfNextendOfFunction: DecodeBase64 = decTextExit FunctionEnd FunctionFunction EncodeBase64 (decText As String) As String 'encrypted character' On Error Goto endOfFunctionDim decNum As LongDim encText As StringDim chunk As StringDim i As IntegerFor i = 1 To Len (decText) Step 3 chunk = Left $ (Mid $ (decText, I, 3) & chr (0) & chr (0), 3) DECNUM = ASC (MID $ (CHUNK, 1, 1)) * (2 ^ 16) Decnum = DECNUM OR ASC (MID $ (CHUNK, 2, 1)) * (2 ^ 8) Decnum = Decnum or ASC (MID $ (CHUNK, 3, 1)) ENCTEXT = EncText & Mid $ (B64chars, (FIX (Decnum / (2 ^ 18)) And & H3F) 1 1) EncText = Enctext & Mid $ (B64Chars, (FIX (Decnum / (2 ^ 12)) and & H3F) 1, 1)
SELECT CASE (LEN (DECTEXT) - I) Case 0: EncText = EncText & "==" Case 1: EncText = EncText & Mid $ (B64chars, (FIX (Decnum / (2 ^ 6)) and & H3F) 1, 1) encText = enctext & "=" Case Else: EncText = EncText & Mid $ (B64Chars, (FIX (Decnum / (2 ^ 6)) and & H3F) 1, 1) ENCTEXT = EncText & Mid $ (B64chars, decNum And & H3F) 1, 1) End SelectNextendOfFunction: EncodeBase64 = encTextExit FunctionEnd FunctionFunction IsBase64 (someString As String) As Integer'Dim legalString As StringDim i As IntegerIsBase64 = FalselegalString = b64chars & "=" 'If (Len (someString) Mod 4 > 0) Thenexit FunctionEND IFOR I = 1 To Len (SomeString) IF (INSTR (LEGALSTRING, MID $ (SomeString, I, 1)) = 0) Thenexit Functionend Ifnext'Select Case (Instring, "=") Case 0: 'Case IS <(LEN (SomeString) - 1): Exit Function Case (Len (SomeString) - 1): IF (SomeString, 1) <> "=") Theexit Functionend IFEND SELECT' ISBASE64 = Trueend FunctionFunction Breakstring (Text As String, LineLength AS Integer) AS String% Rem @Author: @date: @d escription:% end remDim newText As StringDim lineTerm As StringDim i As IntegerlineTerm = Chr (13) & Chr (10) For i = 1 To Len (text) Step lineLengthnewText = newText & Mid $ (text, i, lineLength) & lineTermNextnewText = LEFT $ (NewText, Len (NewText) - Len (LINETERM) Breakstring = NewTextend FunctionFunction RemoveWhitespace (Byval Text As String) AS String '**
% Rem @Author: @date: @Description:% end trans
Call ReplaceSubstring (Text, Chr (13), "") Call ReplaceSubstring (Text, Chr (10), "") Call ReplaceSubstring (Text, Chr (9), "") Call ReplaceSubstring (Text, "," "" RemoveWhitespace = textEnd FunctionFunction ReplaceSubstring (text As String, find As String, replace As String) Dim pos As Integerpos = Instr (text, find) Do While (pos> 0) text = Left $ (text, pos - 1) & replace & Mid $ (text, pos Len (find)) pos = Instr (pos Len (replace), text, find) loopEnd FunctionFunction EncodeFile (fileIn As String, fileOut As String) As Integer On Error Goto processErrorDim fin As Integer, fout As IntegerDim finOpen As Integer, foutOpen As IntegerDim datain As String, dataout As StringDim worktext As String, leftover As StringConst CHUNKSIZE = 15000 fin = Freefile () Open fileIn For Input As finfinOpen = Truefout = FreefileOpen fileOut For Output As foutfoutOpen = True'datain = Getfilechunk (fin, chunksize) Do while (dia "> 0) Leftover = Leftover & DatainWhile (LEFTOVER)> 57) Worktext = Left $ (Leftover, 57) L eftover = Mid $ (leftover, 58) dataout = EncodeBase64 (worktext) Print #fout, dataoutWenddatain = GetFileChunk (fin, CHUNKSIZE) Loop If (Len (leftover)> 0) ThenPrint #fout, EncodeBase64 (leftover) End IfClose #fin, #foutencodefile = truexit functionProcesserror: if (finopen) Then close #finif (foutopen) Then Close #foutencodefile =
FalseExit FunctionEnd FunctionFunction DecodeFile (fileIn As String, fileOut As String) As Integer On Error Goto processErrorDim fin As Integer, fout As IntegerDim finOpen As Integer, foutOpen As IntegerDim datain As String, dataout As StringDim worktext As String, leftover As StringConst CHUNKSIZE = 16000 'Dim session As New NotesSessionDim lineTermLen As IntegerIf ThenlineTermLen = 2ElselineTermLen = 1End If fin (Instr (session.Platform, "Windows")> 0) = Freefile () Open fileIn For Input As finfinOpen = Truefout = FreefileOpen fileOut For Output As foutfoutOpen = true datain = GetFileChunk (fin, CHUNKSIZE) Do While (Len (datain)> 0) datain = RemoveWhitespace (datain) leftover = leftover & datainworktext = Left $ (leftover, Len (leftover) - (Len (leftover) Mod 4)) leftover = Right $ (leftover, Len (leftover) Mod 4) dataout = DecodeBase64 (worktext) Print #fout, dataout 'Seek #fout, Seek (fout) - lineTermLendatain = GetFileChunk (fin, CHUNKSIZE) Loop If (Len (leftover) > 0) Thenprint #fout, Leftoverend IfClose #fin, #foutfinOpen = FalsefoutOpen = False Call TrimBytesFromFile (fileOut, lineTermLen) DecodeFile = TrueExit FunctionprocessError: If (finOpen) Then Close #finIf (foutOpen) Then Close #foutDecodeFile = FalseExit FunctionEnd FunctionFunction GetFileChunk (fileNum As Integer, size As Integer ) As String On Error Goto processErrorDim dataLength As LongdataLength = Lof (fileNum) - Seek (fileNum) 1Select Case (dataLength) Case Is <= 0GetFileChunk = "" Case Is> sizeGetFileChunk = Input $ (size, fileNum) Case ElseGetFileChunk =
