LotusScript(3)-编码为BASE64格式
来源:互联网 发布:网络用语jd是什么意思 编辑:程序博客网 时间:2024/04/30 08:42
Option Public
Option Explicit
%REM
函数转换字符或文件为Base64格式
%END REM
Const b64chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Sub Initialize
'例子:代理
Dim eString As String, dString As String
Dim isOkay As Integer
eString = "QUJDREVGRw==" '** ABCDEFG
dString = 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 Sub
Function DecodeBase64 (Byval encText As String) As String
On Error Goto endOfFunction
Dim encNum As Long
Dim decText As String
Dim i As Integer
'** 删除空字符
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$(encText, i+2, 1) = "=") Then
decText = decText & Chr(Fix(encNum / (2 ^ 16)) And &HFF)
Elseif (Mid$(encText, i+3, 1) = "=") Then
encNum = 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)
Else
encNum = 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 If
Next
endOfFunction:
DecodeBase64 = decText
Exit Function
End Function
Function EncodeBase64 (decText As String) As String
'加密字符
'
On Error Goto endOfFunction
Dim decNum As Long
Dim encText As String
Dim chunk As String
Dim i As Integer
For 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 Select
Next
endOfFunction:
EncodeBase64 = encText
Exit Function
End Function
Function IsBase64 (someString As String) As Integer
'
Dim legalString As String
Dim i As Integer
IsBase64 = False
legalString = b64chars & "="
'
If (Len(someString) Mod 4 > 0) Then
Exit Function
End If
'
For i = 1 To Len(someString)
If (Instr(legalString, Mid$(someString, i, 1)) = 0) Then
Exit Function
End If
Next
'
Select Case (Instr(someString, "="))
Case 0 :
'
Case Is < (Len(someString) - 1) :
Exit Function
Case (Len(someString) - 1) :
If (Right$(someString, 1) <> "=") Then
Exit Function
End If
End Select
' IsBase64 = True
End Function
Function BreakString (text As String, lineLength As Integer) As String
%Rem @Author:
@Date:
@Description:
%end rem
Dim newText As String
Dim lineTerm As String
Dim i As Integer
lineTerm = Chr(13) & Chr(10)
For i = 1 To Len(text) Step lineLength
newText = newText & Mid$(text, i, lineLength) & lineTerm
Next
newText = Left$(newText, Len(newText) - Len(lineTerm))
BreakString = newText
End Function
Function RemoveWhitespace (Byval text As String) As String
'**
%Rem @Author:
@Date:
@Description:
%end rem
Call ReplaceSubstring(text, Chr(13), "")
Call ReplaceSubstring(text, Chr(10), "")
Call ReplaceSubstring(text, Chr(9), "")
Call ReplaceSubstring(text, " ", "")
RemoveWhitespace = text
End Function
Function ReplaceSubstring (text As String, find As String, replace As String)
Dim pos As Integer
pos = 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)
Loop
End Function
Function EncodeFile (fileIn As String, fileOut As String) As Integer
On Error Goto processError
Dim fin As Integer, fout As Integer
Dim finOpen As Integer, foutOpen As Integer
Dim datain As String, dataout As String
Dim worktext As String, leftover As String
Const CHUNKSIZE = 15000
fin = Freefile()
Open fileIn For Input As fin
finOpen = True
fout = Freefile
Open fileOut For Output As fout
foutOpen = True
'
datain = GetFileChunk(fin, CHUNKSIZE)
Do While (Len(datain) > 0)
leftover = leftover & datain
While (Len(leftover) > 57)
worktext = Left$(leftover, 57)
leftover = Mid$(leftover, 58)
dataout = EncodeBase64(worktext)
Print #fout, dataout
Wend
datain = GetFileChunk(fin, CHUNKSIZE)
Loop
If (Len(leftover) > 0) Then
Print #fout, EncodeBase64(leftover)
End If
Close #fin, #fout
EncodeFile = True
Exit Function
processError:
If (finOpen) Then Close #fin
If (foutOpen) Then Close #fout
EncodeFile = False
Exit Function
End Function
Function DecodeFile (fileIn As String, fileOut As String) As Integer
On Error Goto processError
Dim fin As Integer, fout As Integer
Dim finOpen As Integer, foutOpen As Integer
Dim datain As String, dataout As String
Dim worktext As String, leftover As String
Const CHUNKSIZE = 16000
'
Dim session As New NotesSession
Dim lineTermLen As Integer
If (Instr(session.Platform, "Windows") > 0) Then
lineTermLen = 2
Else
lineTermLen = 1
End If
fin = Freefile()
Open fileIn For Input As fin
finOpen = True
fout = Freefile
Open fileOut For Output As fout
foutOpen = True
datain = GetFileChunk(fin, CHUNKSIZE)
Do While (Len(datain) > 0)
datain = RemoveWhitespace(datain)
leftover = leftover & datain
worktext = 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) - lineTermLen
datain = GetFileChunk(fin, CHUNKSIZE)
Loop
If (Len(leftover) > 0) Then
Print #fout, leftover
End If
Close #fin, #fout
finOpen = False
foutOpen = False
Call TrimBytesFromFile(fileOut, lineTermLen)
DecodeFile = True
Exit Function
processError:
If (finOpen) Then Close #fin
If (foutOpen) Then Close #fout
DecodeFile = False
Exit Function
End Function
Function GetFileChunk (fileNum As Integer, size As Integer) As String
On Error Goto processError
Dim dataLength As Long
dataLength = Lof(fileNum) - Seek(fileNum) + 1
Select Case (dataLength)
Case Is <= 0
GetFileChunk = ""
Case Is > size
GetFileChunk = Input$(size, fileNum)
Case Else
GetFileChunk = Input$(Cint(dataLength), fileNum)
End Select
Exit Function
processError:
GetFileChunk = ""
Exit Function
End Function
Function TrimBytesFromFile (fileName As String, bytesToTrim As Integer)
On Error Goto processError
Dim tempFileName As String
Dim fin As Integer, fout As Integer
Dim finOpen As Integer, foutOpen As Integer
Dim dataLength As Long
Dim lineLength As Integer
Dim data As String
Dim dataInt As Integer
Const CHUNKSIZE = 15000
tempFileName = fileName & ".tmp"
fin = Freefile()
Open fileName For Binary As fin
finOpen = True
fout = Freefile()
Open tempFileName For Binary As fout
foutOpen = True
dataLength = Lof(fin) - Seek(fin) + 1 - bytesToTrim
Do While (dataLength > 1)
If (dataLength > CHUNKSIZE) Then
lineLength = CHUNKSIZE
Else
lineLength = Cint(dataLength)
End If
data = Space$(Fix(lineLength / 2))
Get #fin, , data
Put #fout, , data
dataLength = Lof(fin) - Seek(fin) + 1 - bytesToTrim
Loop
If (dataLength = 1) Then
Seek #fin, Seek(fin) - 1
Seek #fout, Seek(fout) - 1
Get #fin, , dataInt
Put #fout, , dataInt
End If
Close #fin, #fout
finOpen = False
foutOpen = False
'
Kill fileName
Name tempFileName As fileName
Exit Function
processError:
If (finOpen) Then Close #fin
If (foutOpen) Then Close #fout
Exit Function
End Function
- LotusScript(3)-编码为BASE64格式
- 图片转化为Base64格式
- 图像转换为Base64编码
- image转换为base64编码
- 图片转换为Base64编码
- 编码格式转换--base64 格式的解码和编码
- Base64编码格式 和 String的转换
- 获取base64编码格式字符数据
- 将图片转为base64编码格式
- js base64编码格式图片另存为下载
- Base64编码实现-3
- base64编码的字符串解析为UIImage
- 图片文件转换为base64编码
- php将image转换为base64编码
- js 将图片转换为base64编码
- 转化本地图片为base64编码
- js将图片转为base64编码 && js将base64编码图片转为Blob格式
- ionic2/3 base64编码/解码
- 公布 vs2005的 本地安装包下载地址:
- 求好心的大侠提供肠镜及胃镜的诊断模板,万分感谢!!!
- sas 位操作
- 又是面试!
- 如何突破 form提交变量,大小不能超过64k的限制?
- LotusScript(3)-编码为BASE64格式
- SAP IDES 4.6 C 的ACCESS KEY破解一步一步来
- How subscription works in biztalk2004 - Part1
- 一些国外的BCB编程资源网站
- 关于Unix起源的文章
- 最佳优化你的CS
- 实现千万级数据的分页显示!
- 通用存储过程.查找删除非唯一的记录
- Oracle特殊外連做法--帶條件外連接.