移动MISC1.6平台的Provision接口（短信定制关系同步接口）

<%

sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)

Function strUnicodeLen(asContents)
@#计算unicode字符串的Ansi编码的长度
asContents1="a"&asContents
len1=len(asContents1)
k=0
for i=1 to len1
asc1=asc(mid(asContents1,i,1))
if asc1<0 then asc1=65536+asc1
if asc1>255 then
k=k+2
else
k=k+1
end if
next
strUnicodeLen=k-1
End Function

Function strUnicode2Ansi(asContents)
@#将Unicode编码的字符串，转换成Ansi编码的字符串
strUnicode2Ansi=""
len1=len(asContents)
for i=1 to len1
varchar=mid(asContents,i,1)
varasc=asc(varchar)
if varasc<0 then varasc=varasc+65536
if varasc>255 then
varHex=Hex(varasc)
varlow=left(varHex,2)
varhigh=right(varHex,2)
strUnicode2Ansi=strUnicode2Ansi & chrb("&H" & varlow ) & chrb("&H" & varhigh )
else
strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
end if
next
End function

Function strAnsi2Unicode(asContents)
@#将Ansi编码的字符串，转换成Unicode编码的字符串
strAnsi2Unicode = ""
len1=lenb(asContents)
if len1=0 then exit function
for i=1 to len1
varchar=midb(asContents,i,1)
varasc=ascb(varchar)
if varasc > 127 then
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
i=i+1
else
strAnsi2Unicode = strAnsi2Unicode & chr(varasc)
end if
next
End function

Function Base64encode(asContents)
@#将Ansi编码的字符串进行Base64编码
@#asContents应当是ANSI编码的字符串（二进制的字符串也可以）
Dim lnPosition
Dim lsResult
Dim Char1
Dim Char2
Dim Char3
Dim Char4
Dim Byte1
Dim Byte2
Dim Byte3
Dim SaveBits1
Dim SaveBits2
Dim lsGroupBinary
Dim lsGroup64
Dim m4,len1,len2

len1=Lenb(asContents)
if len1<1 then
Base64encode=""
exit Function
end if

m3=Len1 Mod 3
If M3 > 0 Then asContents = asContents & String(3-M3, chrb(0))
@#补足位数是为了便于计算

IF m3 > 0 THEN
len1=len1+(3-m3)
len2=len1-3
else
len2=len1
end if

lsResult = ""

For lnPosition = 1 To len2 Step 3
lsGroup64 = ""
lsGroupBinary = Midb(asContents, lnPosition, 3)

Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))

Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
lsGroup64 = Char1 & Char2 & Char3 & Char4

lsResult = lsResult & lsGroup64
Next

@#处理最后剩余的几个字符
if M3 > 0 then
lsGroup64 = ""
lsGroupBinary = Midb(asContents, len2+1, 3)

Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))

Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)

if M3=1 then
lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) @#用=号补足位数
else
lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) @#用=号补足位数
end if

lsResult = lsResult & lsGroup64
end if

Base64encode = lsResult

End Function


Function Base64decode(asContents)
@#将Base64编码字符串转换成Ansi编码的字符串
@#asContents应当也是ANSI编码的字符串（二进制的字符串也可以）
Dim lsResult
Dim lnPosition
Dim lsGroup64, lsGroupBinary
Dim Char1, Char2, Char3, Char4
Dim Byte1, Byte2, Byte3
Dim M4,len1,len2

len1= Lenb(asContents)
M4 = len1 Mod 4

if len1 < 1 or M4 > 0 then
@#字符串长度应当是4的倍数
Base64decode = ""
exit Function
end if

@#判断最后一位是不是 = 号
@#判断倒数第二位是不是 = 号
@#这里m4表示最后剩余的需要单独处理的字符个数
if midb(asContents, len1, 1) = chrb(61) then m4=3
if midb(asContents, len1-1, 1) = chrb(61) then m4=2

if m4 = 0 then
len2=len1
else
len2=len1-4
end if

For lnPosition = 1 To Len2 Step 4
lsGroupBinary = ""
lsGroup64 = Midb(asContents, lnPosition, 4)
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
lsGroupBinary = Byte1 & Byte2 & Byte3

lsResult = lsResult & lsGroupBinary
Next

@#处理最后剩余的几个字符
if M4 > 0 then
lsGroupBinary = ""
lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) @#chr(65)=A，转换成值为0
if M4=2 then @#补足4位，是为了便于计算
lsGroup64 = lsGroup64 & chrB(65)
end if
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
Byte3 = Chrb((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))

if M4=2 then
lsGroupBinary = Byte1
elseif M4=3 then
lsGroupBinary = Byte1 & Byte2
end if

lsResult = lsResult & lsGroupBinary
end if

Base64decode = lsResult

End Function

set conn=server.CreateObject("adodb.connection")
conn.Open "driver=SQL Server;uid=*;pwd=*;SERVER=*.*.*.*;database=*"

Set xml = Server.CreateObject ("Microsoft.XMLDOM")
xml.async = False
xml.Load Request
set root=xml.documentElement

TransactionID= root.childNodes.item(0).text
set obj = root.childNodes.item(1).childNodes.item(0)

MsgType= obj.childNodes.item(1).text
Send_Address_DeviceType= obj.childNodes.item(2).childNodes.item(0).text
Send_Address_DeviceID= obj.childNodes.item(2).childNodes.item(1).text
Dest_Address_DeviceType= obj.childNodes.item(3).childNodes.item(0).text
Dest_Address_DeviceID= obj.childNodes.item(3).childNodes.item(1).text
FeeUser_ID_UserIDType= obj.childNodes.item(4).childNodes.item(0).text
FeeUser_ID_MSISDN= obj.childNodes.item(4).childNodes.item(1).text
FeeUser_ID_PseudoCode= obj.childNodes.item(4).childNodes.item(2).text
DestUser_ID_UserIDType= obj.childNodes.item(5).childNodes.item(0).text
DestUser_ID_MSISDN= obj.childNodes.item(5).childNodes.item(1).text
DestUser_ID_PseudoCode= obj.childNodes.item(5).childNodes.item(2).text
LinkID= obj.childNodes.item(6).text
ActionID= obj.childNodes.item(7).text
ActionReasonID= obj.childNodes.item(8).text
SPID= obj.childNodes.item(9).text
SPServiceID= obj.childNodes.item(10).text
AccessMode= obj.childNodes.item(11).text
FeatureStr= strAnsi2Unicode(Base64decode(strUnicode2Ansi(obj.childNodes.item(12).text)))

conn.execute("provision @#"&MsgType&"@#,@#"&TransactionID&"@#,@#"&Send_Address_DeviceType&"@#,@#"&Send_Address_DeviceID&"@#,@#"&Dest_Address_DeviceType&"@#,@#"&Dest_Address_DeviceID&"@#,@#"&FeeUser_ID_UserIDType&"@#,@#"&FeeUser_ID_MSISDN&"@#,@#"&FeeUser_ID_PseudoCode&"@#,@#"&DestUser_ID_UserIDType&"@#,@#"&DestUser_ID_MSISDN&"@#,@#"&DestUser_ID_PseudoCode&"@#,@#"&LinkID&"@#,@#"&ActionID&"@#,@#"&ActionReasonID&"@#,@#"&SPID&"@#,@#"&SPServiceID&"@#,@#"&AccessMode&"@#,@#"&FeatureStr&"@#")
@#response.write "provision @#"&MsgType&"@#,@#"&TransactionID&"@#,@#"&Send_Address_DeviceType&"@#,@#"&Send_Address_DeviceID&"@#,@#"&Dest_Address_DeviceType&"@#,@#"&Dest_Address_DeviceID&"@#,@#"&FeeUser_ID_UserIDType&"@#,@#"&FeeUser_ID_MSISDN&"@#,@#"&FeeUser_ID_PseudoCode&"@#,@#"&DestUser_ID_UserIDType&"@#,@#"&DestUser_ID_MSISDN&"@#,@#"&DestUser_ID_PseudoCode&"@#,@#"&LinkID&"@#,@#"&ActionID&"@#,@#"&ActionReasonID&"@#,@#"&SPID&"@#,@#"&SPServiceID&"@#,@#"&AccessMode&"@#,@#"&FeatureStr&"@#"

dim XmlStr
Response.ContentType="text/xml"
XmlStr=XmlStr+"<?xml version=""1.0"" encoding=""utf-8""?>"&vbcrlf
XmlStr=XmlStr+"<SOAP-ENV:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:SOAP-ENC=""http://schemas.xmlsoap.org/soap/encoding/"">"&vbcrlf
XmlStr=XmlStr+"<SOAP-ENV:Header>"&vbcrlf
XmlStr=XmlStr+"<TransactionID xmlns=""http://www.monternet.com/dsmp/schemas/"">"&TransactionID&"</TransactionID>"&vbcrlf
XmlStr=XmlStr+"</SOAP-ENV:Header>"&vbcrlf
XmlStr=XmlStr+"<SOAP-ENV:Body>"&vbcrlf
XmlStr=XmlStr+"<SyncOrderRelationResp xmlns=""http://www.monternet.com/dsmp/schemas/"">"&vbcrlf
XmlStr=XmlStr+"<Version>1.5.0</Version>"&vbcrlf
XmlStr=XmlStr+"<MsgType>SyncOrderRelationResp</MsgType>"&vbcrlf
XmlStr=XmlStr+"<hRet>0</hRet>"&vbcrlf
XmlStr=XmlStr+"</SyncOrderRelationResp>"&vbcrlf
XmlStr=XmlStr+"</SOAP-ENV:Body>"&vbcrlf
XmlStr=XmlStr+"</SOAP-ENV:Envelope>"&vbcrlf
response.write XmlStr

%>

原文转自：http://www.ltesting.net