(str / code *SCR DATA)
;大于20kb后速度很慢
(if (and STR (= (type str) 'str))
(if(or
*SCR
(setq
*SCR (vlax-create-object
"Aec32BitAppServer.AecScriptControl.1"
)
)
(setq *SCR (vlax-create-object "ScriptControl"))
)
(progn
(vlax-put *SCR 'language "VBScript")
(setq code
"Base64Encode(str)
Function Base64Encode(byVal s)
b=\"\"
h=\"\"
bs=\"\"
n=0
For i=1 to len(s)
h=h & StrToHex(Mid(s, i, 1))
Next
For i=1 to len(h) Step 2
b=b & HexToBin(Mid(h,i,2))
Next
For i=1 to len(b) Step 6
n=n+1
t=(Mid(b,i,6))
If len(t) <> 6 Then
t=Left(t & \"000000\", 6)
End If
bs=bs & BinToChr(BinToDec(t))
Next
m=n Mod 4
If m =2 Then
bs=bs & \"==\"
End If
If m =3 Then
bs=bs & \"=\"
End If
Base64Encode=bs
End Function
Function StrToHex(byVal s)
h=\"\"
c=\"&H\" & Hex(AscW(s))
If c >= &H0001 And c <= &H007F Then
h=h & Hex(c)
ElseIf c > &H07FF Then
h=h & Hex(&HE0 Or (c\\(2^12) And &H0F))
h=h & Hex(&H80 Or (c\\(2^6) And &H3F))
h=h & Hex(&H80 Or (c\\(2^0) And &H3F))
Else
h=h & Hex(&HC0 Or (c\\(2^6) And &H1F))
h=h & Hex(&H80 Or (c\\(2^0) And &H3F))
End If
StrToHex=h
End Function
Function HexToBin(byVal s)
b=\"\"
dec=Clng(\"&H\" & s)
Do While dec > 0
b=dec Mod 2 & b
dec=dec \\ 2
Loop
b=Right(\"00000000\" & CStr(b), 8)
HexToBin=b
End Function
Function BinToDec(byVal s)
d=0
For i=6 to 1 Step -1
d=d + CInt(Mid(s, i, 1)) * 2 ^ (6 - i)
Next
BinToDec=d
End Function
Function BinToChr(byVal s)
dic=\"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
BinToChr=Mid(dic, s+1, 1)
End Function"
)
(if (and
(not (vl-catch-all-error-p
(vl-catch-all-apply
'vlax-invoke
(list *SCR
'addcode
code
)
)
)
)
(not (vl-catch-all-error-p
(setq str (vl-catch-all-apply
'vlax-invoke
(list *SCR
'run
"Base64Encode"
str
)
)
)
)
)
)
()
(setq str nil)
)
(if *SCR
(vlax-release-object *SCR)
)
)
(progn (print "调用VBScript转码失败，组件未找到"))
)
)
str
)
感谢分享！！！！！！
页:
1
[2]