網路上有各種Base64編碼、解碼的例子原始碼，編碼後雖然也可以通過大部分解碼程式解碼，但編碼後的結果卻各有不同。

轉載請說明來源於：http://blog.csdn.net/aminfo/article/details/70478053

由於工作需要，在呼叫某API時，網路上的Base64編碼結果不符合要求，於是自寫一個基於VBS的BASE64 Encode和Decode，已經過初次測試。程式碼如下供參考：

<%'基於VBS、ASP的Base64 Encode 和 Base64 Decode
Dim sc
Set sc = CreateObject("MSScriptControl.ScriptControl")
sc.Language = "JScript"

Dim tmpStr, tmpResult
tmpStr = "··ASCII第···一次以規範標準的型態發表是在1967年,1234567890-=`~！·#￥%……—*（）——
 
[email protected]#$%^&*()_+[]{};'\:""|,./<>?《》？：“|{}，。/；‘、][ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ最後一次更新則是在1986年,至今為止共定義了128個字元,其中33個字元無法顯示(這是以現今作業系統為依歸,但在DOS模式··"
tmpResult = vbsBase64Encode(StringToByteArray(tmpStr))
Response.write "編碼： " & tmpResult & "<BR>"
tmpResult = ByteArrayToString(vbsBase64Decode(tmpResult))
Response.write "解碼：" & tmpResult & "<BR>"
Response.write "原串：" & tmpStr & "<BR>"

If tmpStr <> tmpResult Then
	Response.write "結果不同"
Else
	Response.write "結果相同"
End If

'編碼
Function vbsBase64Encode(byteArray)
	Dim last2byte : last2byte = 3
	Dim last4byte : last4byte = 15
	Dim last6byte : last6byte = 63
	Dim lead6byte : lead6byte = 252
	Dim lead4byte : lead4byte = 240
	Dim lead2byte : lead2byte = 192
	Dim encodeTable : encodeTable = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,0,1,2,3,4,5,6,7,8,9,+,/", ",")
	Dim objectStr : objectStr = ""
	Dim num
	num = 0
	Dim currentByte
	currentByte = 0
	Dim i
	For i = 0 to ubound(byteArray)
		num = num mod 8
		do while(num < 8)
			Select Case num
			 Case 0
			 	currentByte = byteArray(i) and lead6byte
				currentByte = uRShift(currentByte, 2)
			 Case 2
			 	currentByte = byteArray(i) and last6byte
			 Case 4
			 	currentByte = byteArray(i) and last4byte
			 	currentByte = LShift(currentByte, 2)
			 	If ((i + 1) <= ubound(byteArray)) Then
			 		currentByte = currentByte or uRShift(byteArray(i + 1) and lead2byte, 6)
				End If
			 Case 6
				currentByte = byteArray(i) and last2byte
				currentByte = LShift(currentByte, 4)
				If ((i + 1) <= ubound(byteArray)) Then
					currentByte = currentByte or uRShift(byteArray(i + 1) and lead4byte, 4)
				End If
			End Select
			objectStr = objectStr & encodeTable(currentByte)
			num = num + 6
		Loop
	Next
	If (Len(objectStr) mod 4 <> 0) Then
		For i = (4 - Len(objectStr) mod 4) to 1 step - 1
			objectStr = objectStr & "="
		Next
	End If
	vbsBase64Encode = objectStr
End Function
'轉載請說明來源於：http://blog.csdn.net/aminfo/article/details/70478053
'解碼
Function vbsBase64Decode(str)
	Dim delta
	Dim ALPHABET : ALPHABET = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
	If Right(str, 2) = "==" Then
		delta = 2
	ElseIf Right(str, 1) = "=" Then
		delta = 1
	Else
		delta = 0
	End If
	Redim buffer(Len(str) * 3 / 4 - delta)
	Dim mask : mask = &HFF
	Dim index : index =0
	Dim i, c0, c1, c2, c3
	For i = 1 to Len(str) step 4
		c0 = Instr(ALPHABET, mid(str, i, 1)) - 1
		c1 = Instr(ALPHABET, mid(str, i + 1, 1)) - 1
		buffer(index) = (LShift(c0, 2) or RShift(c1, 4)) and mask
		If buffer(index)>127 Then
			buffer(index) = buffer(index) - 256
		End If
		index = index + 1
		If(index >= ubound(buffer)) Then
			Exit For
		End If
		
		c2 = Instr(ALPHABET, mid(str, i + 2, 1)) - 1
		buffer(index) = (LShift(c1, 4) or RShift(c2, 2)) and mask
		If buffer(index)>127 Then
			buffer(index) = buffer(index) - 256
		End If
		index = index + 1
		If(index >= ubound(buffer)) Then
			Exit For
		End If
		
		c3 = Instr(ALPHABET, mid(str, i + 3, 1)) - 1
		buffer(index) = (LShift(c2, 6) or c3) and mask
		If buffer(index)>127 Then
			buffer(index) = buffer(index) - 256
		End If
		index = index + 1
	Next
	vbsBase64Decode = buffer
End Function
	
Function LShift(Value, Shift)
	LShift = sc.Eval(Value & "<<" & Shift)
End Function

Function RShift(Value, Shift)
	RShift = sc.Eval(Value & ">>" & Shift)
End Function

Function uLShift(Value, Shift)
	uLShift = sc.Eval(Value & "<<<" & Shift)
End Function

Function uRShift(Value, Shift)
	uRShift = sc.Eval(Value & ">>>" & Shift)
End Function
'轉載請說明來源於：http://blog.csdn.net/aminfo/article/details/70478053
'------------------------------------------
Function ArrayAdd(byteArray1, byteArray2)
	Dim i, tmpStr
	tmpStr = ""
	For i = 0 to ubound(byteArray1)
		If i>0 Then
			tmpStr = tmpStr & ","
		End If
		tmpStr = tmpStr & byteArray1(i)
	Next
	For i = 0 to ubound(byteArray2)
		tmpStr = tmpStr & "," & byteArray2(i)
	Next
	ArrayAdd = Split(tmpStr, ",")
End Function

'Bin字串轉陣列
Function BinToByteArray(szInput)
	Dim i, byteArray, wch, nAsc
	byteArray = ""
	For i=1 To Len(szInput)
		wch = Mid(szInput, i, 1)
		nAsc = AscW(wch)
		'Response.write "<BR>wch = " &  nAsc
		If nAsc>127 Then
			byteArray = byteArray & "," & (nAsc - 256)
		Else
			byteArray = byteArray & "," & nAsc
		End If
	Next
	If Left(byteArray, 1) = "," Then
		byteArray = Right(byteArray, Len(byteArray) - 1)
	End If
	BinToByteArray = Split(byteArray, ",")
End Function

'字串轉陣列
Function StringToByteArray(szInput)
	Dim i, byteArray, wch, nAsc
	byteArray = ""
	For i=1 To Len(szInput)
		wch = Mid(szInput, i, 1)
		nAsc = AscW(wch)
		If nAsc < 0 Then
			nAsc = nAsc + 65536
		End If  
		If (nAsc And &HFF80) = 0 Then
			byteArray = byteArray & "," & AscW(wch)
		Else
			If (nAsc And &HF000) = 0 Then
				byteArray = byteArray & "," &  Cint("&H" & Hex(((nAsc \ 2 ^ 6)) Or &HC0)) - 256 & "," & Cint("&H" & Hex(nAsc And &H3F Or &H80))-256
			Else
				byteArray = byteArray & "," &  Cint("&H" & Hex((nAsc \ 2 ^ 12) Or &HE0)) - 256 & "," & Cint("&H" & Hex((nAsc \ 2 ^ 6) And &H3F Or &H80)) - 256 & "," & Cint("&H" & Hex(nAsc And &H3F Or &H80)) - 256
			End If
		End If
	Next
	If Left(byteArray, 1) = "," Then
		byteArray = Right(byteArray, Len(byteArray) - 1)
	End If
	StringToByteArray = Split(byteArray, ",")
End Function
'轉載請說明來源於：http://blog.csdn.net/aminfo/article/details/70478053
'陣列轉字串
Function ByteArrayToString(sArray)
	Dim i, tStr, byte1, byte2, byte3
	tStr = ""
	For i = 0 to ubound(sArray)
		If sArray(i)>0 and sArray(i)<128 Then
			tStr = tStr & Chr(sArray(i))
		Else
			If i < ubound(sArray) - 1 Then
				byte1 = ((sArray(i) + 256) And &H3F) * &H40
				If byte1<2048 Then
					byte1 = ((sArray(i) + 256) And &H3F) * &H40
					byte2 = (sArray(i + 1) + 256) And &H3F
					tStr = tStr & chrW(byte1 or byte2)
					i = i + 1
				Else
					byte1 = ((sArray(i) + 256) And &H0F) * &H1000
					byte2 = ((sArray(i + 1) + 256) And &H3F) * &H40
					byte3 = (sArray(i + 2) + 256) And &H3F
					tStr = tStr & chrW(byte1 or byte2 or byte3)
					i = i + 2				
				End If
			End If
		End If
	Next
	ByteArrayToString = tStr
End Function%>