'看过很多的用AspDECODE BASE64的,某天突发奇想,想用VbsCRIPT下写一个DECODE
'结果发生了让我措手不及的问题:
'具体的代码如下:
<HTML>
<body>
</body>
</HTML>
<script language='VBScript'>
On Error Resume Next
Main()'十进制转换为二进制
Function Dec2Bin(Value, MaxBit)
Dec2Bin=""
Do while (Value>0)
K=Int(Value/2)*2
If (K=Value) then
Dec2Bin= "0"+Dec2Bin
else
Dec2Bin= "1"+Dec2Bin
End If
Value=Int(Value/2)
Loop
'平整代码
Do while (Len(Dec2Bin)<MaxBit)
Dec2Bin="0"+Dec2Bin
Loop
End FunctionFunction Power(Base,Exp)
Power=1
If Exp>0 then
'Else
For I=1 to Exp
Power=Power*Base
Next
End If
End Function'二进制转换为十进制
Function Bin2Dec(Value)
Dim nIndex, nLength
Bin2Dec=0
nLength=Len(Value)
For nIndex=1 to nLength
if Mid(Value,(nLength-nIndex+1),1)="1" then
Bin2Dec=Bin2Dec+Power(2, nIndex-1)
End If
Next
End FunctionFunction UnMimeCode(MimeString)
Base64 ="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
CurrentChar=""
CurrentPos=0
UnMimeCode=""
strBin="" nLength=Len(MimeString)
For nIndex=1 to nLength
CurrentChar=Mid(MimeString,nIndex,1)
CurrentPos=InStr(1,Base64,CurrentChar)
If (CurrentPos > 0) then
strBin=strBin+Dec2Bin(CurrentPos-1,6)
ElseIf (CurrentChar="=") then
strBin=strBin+"000000"
End If
Next For nIndex=1 to Int(Len(strBin)/8)
Temp=Mid(strBin,(nIndex-1)*8+1,8)
UnMimeCode=UnMimeCode+Chr(Bin2Dec(Temp))
'好象是Chr这个函数作怪。 我在Delphi下用该方法，得到了正确结果
'根据和DELPHI内执行的数据来看，Bin2Dec(Temp)的结果是一样的，但是加上
'函数Chr(),怎么就不行了？？ VbScript的Chr不支持 UniCode??
Next
End FunctionSub Main()
dstString="veLC67PJuabBy6OhuafPsqOhx+u9+NDQv8nWtNDQzsS8/rOiytSjoQ=="
MsgBox "对["+dstString+"]解码的结果为："+Chr(13)+UnMimeCode(dstString)+" :)",0 End Sub</script>
'**********************************
'附,以上的解码思想在DELPHI6下顺利通过!
'难道 VBS 的CHr 函数有问题？
'结果发生了让我措手不及的问题:
'具体的代码如下:
<HTML>
<body>
</body>
</HTML>
<script language='VBScript'>
On Error Resume Next
Main()'十进制转换为二进制
Function Dec2Bin(Value, MaxBit)
Dec2Bin=""
Do while (Value>0)
K=Int(Value/2)*2
If (K=Value) then
Dec2Bin= "0"+Dec2Bin
else
Dec2Bin= "1"+Dec2Bin
End If
Value=Int(Value/2)
Loop
'平整代码
Do while (Len(Dec2Bin)<MaxBit)
Dec2Bin="0"+Dec2Bin
Loop
End FunctionFunction Power(Base,Exp)
Power=1
If Exp>0 then
'Else
For I=1 to Exp
Power=Power*Base
Next
End If
End Function'二进制转换为十进制
Function Bin2Dec(Value)
Dim nIndex, nLength
Bin2Dec=0
nLength=Len(Value)
For nIndex=1 to nLength
if Mid(Value,(nLength-nIndex+1),1)="1" then
Bin2Dec=Bin2Dec+Power(2, nIndex-1)
End If
Next
End FunctionFunction UnMimeCode(MimeString)
Base64 ="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
CurrentChar=""
CurrentPos=0
UnMimeCode=""
strBin="" nLength=Len(MimeString)
For nIndex=1 to nLength
CurrentChar=Mid(MimeString,nIndex,1)
CurrentPos=InStr(1,Base64,CurrentChar)
If (CurrentPos > 0) then
strBin=strBin+Dec2Bin(CurrentPos-1,6)
ElseIf (CurrentChar="=") then
strBin=strBin+"000000"
End If
Next For nIndex=1 to Int(Len(strBin)/8)
Temp=Mid(strBin,(nIndex-1)*8+1,8)
UnMimeCode=UnMimeCode+Chr(Bin2Dec(Temp))
'好象是Chr这个函数作怪。 我在Delphi下用该方法，得到了正确结果
'根据和DELPHI内执行的数据来看，Bin2Dec(Temp)的结果是一样的，但是加上
'函数Chr(),怎么就不行了？？ VbScript的Chr不支持 UniCode??
Next
End FunctionSub Main()
dstString="veLC67PJuabBy6OhuafPsqOhx+u9+NDQv8nWtNDQzsS8/rOiytSjoQ=="
MsgBox "对["+dstString+"]解码的结果为："+Chr(13)+UnMimeCode(dstString)+" :)",0 End Sub</script>
'**********************************
'附,以上的解码思想在DELPHI6下顺利通过!
'难道 VBS 的CHr 函数有问题？
我忙了一个下午,改来改去,参考函数查找了N遍还是不行
后来我发现,假如 需要解码的是正常的 ASCII码,就不会出问题.
只要有中文的,一律不行,给我理由先??Ps:如上,dstString='veLC67PJuabBy6OhuafPsqOhx.......'
在执行的时候,是以什么方式存储的呢?? ANSI? UNICODE?还有啊,水能给我一个VBS写的BASE64DECODE?
比如你用到的 Mid(Midb) 函数,Len(Lenb) 函数等等；
还有一个最有用的函数 StrConv .好好研究吧.
I can't type Chinese!
Can you try to modify my code?
I have downloaded a lot of information about this,Yet I still can't solute the problem.
I also have downloaded a program written by a foreigner,But the same problem appear!Help!
If OneChar = "" Then MyAsc = 0 Else MyAsc = Asc(OneChar)
End Function
Function B64E(inData)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim sOut, cOut, iFor i = 1 To Len(inData) Step 3
Dim nGroup As Long
Dim pOut, sGroupnGroup = &H10000 * Asc(Mid(inData, i, 1)) + &H100 * MyAsc(Mid(inData, i + 1, 1)) + MyAsc(Mid(inData, i + 2, 1))
sGroup = Oct(nGroup)
sGroup = String(8 - Len(sGroup), "0") + sGrouppOut = Mid(Base64, CLng("&o" + Mid(sGroup, 1, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 3, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 5, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 7, 2)) + 1, 1)
'Mid(Base64, CLng("&o" + Mid(sGroup, 7, 2)) + 1, 1)
'
' Mid(Base64, CLng("&o" + Mid(sGroup, 3, 2)), 1)
'
'+ Mid(Base64, CLng("&o" + Mid(sGroup, 7, 2)) + 1, 1) + Mid(Base64, CLng("&o" + Mid(sGroup, 7, 2)) + 1, 1)
sOut = sOut + pOut
If (i + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next i
Select Case Len(inData) Mod 3
Case 1
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
B64E = sOut
End Function
能看看我写的那个程序么？主要问题就是 UNICODE的问题。 怎么让 VBS 生成 编码>255的字符？？
即半个汉字问题？？
Dim s As String
Dim a As New Class1
s = a.Encode(StrConv("我爱北京天安门", vbUnicode))
MsgBox StrConv(a.Decode(s), vbFromUnicode)
End Sub
class1是一个老外关于base64的类vb6调试通过
你看看你是不是有上边问题
好象VBS和VB有点差别哦！ ：）
我是学DELPHI的，对VB不是很熟悉！
x = "好"
c = Asc(x)'高位
h = (c And &HFF00) / 256
'低位
l = c And &HFF
MsgBox h
MsgBox l'还原
MsgBox Chr(h * 256 + l)
http://www.aslike.net