ASP编写的MISC函数集 （转）

[zhaoweiwei]

ASP编写的MISC函数集
抛砖引玉，可能有些错误，大概流程是这样
MISCFun.asp
<!--#include File="Const.asp"-->
<%
Function GetXmlNodevalue(XmlString,CurrentNode,NodeType)
dim n,xml
set xml = xmlString
if NodeType="1" Then
GetXmlNodevalue=xml.selectSingleNode("misc_command/command_name").text
else
set N = xml.selectsinglenode("misc_command/command_data_block")
if not N is nothing then
GetXmlNodevalue = N.selectsingleNode(CurrentNode).text
end if
end if
End Function

Function PostXmlAndGetResponse(PostToUrl,XmlBody)
set xhttp = createObject("msxml2.XMLHTTP")
xhttp.open "POST", PostToUrl, False
xhttp.send XmlBody
' set PostXmlAndGetResponse= xhttp.responseXML
PostXmlAndGetResponse= xhttp.responseText
set xhttp=nothing
' call writepostdata(PostXmlAndGetResponse)
End Function

' 发送SSO请求
function http_request(commandname,sid,service_id,sp_password,wapgateway)
xmlstr="<?xml version = ""1.0"" ?>"&vbcrlf
xmlstr=xmlstr+"<misc_command version=""1.5"">"&Vbcrlf
xmlstr=xmlstr+"<command_name>"+commandname+"</command_name>"&Vbcrlf
xmlstr=xmlstr+"<command_data_block>"&vbcrlf
xmlstr=xmlstr+"<sid>"+sid+"</sid>"&vbcrlf
xmlstr=xmlstr+"<service_id>"+service_id+"</service_id>"&vbcrlf
xmlstr=xmlstr+"<sp_id>"+sp_id+"</sp_id>"&vbcrlf
xmlstr=xmlstr+"<sp_password>"+sp_password+"</sp_password>"&vbcrlf
xmlstr=xmlstr+"</command_data_block>"&vbcrlf
xmlstr=xmlstr+"</misc_command>"
http_request=PostXmlAndGetResponse(wapgateway,XmlStr)
end function

'处理provision
function provision_return(actionid,serviceid,mid,mobileid,accessmode,gateway)
xmlstr="<?xml version = ""1.0"" ?>"&vbcrlf
xmlstr=xmlstr+"<misc_command version=""1.5"">"&Vbcrlf
xmlstr=xmlstr+"<command_name>provision</command_name>"&Vbcrlf
xmlstr=xmlstr+"<command_data_block>"&vbcrlf
xmlstr=xmlstr+"<action_id>"+actionid+"</action_id>"&vbcrlf
xmlstr=xmlstr+"<service_id>"+serviceid+"</service_id>"&vbcrlf
xmlstr=xmlstr+"<access_mode>"+accessmode+"</access_mode>"&vbcrlf
xmlstr=xmlstr+"<mid>"+mid+"</mid>"&vbcrlf
xmlstr=xmlstr+"<mobile_id>"+mobileid+"</mobile_id>"&vbcrlf
xmlstr=xmlstr+"<sp_id>"+sp_id+"</sp_id>"&vbcrlf
xmlstr=xmlstr+"<sp_password>"+sp_password+"</sp_password>"&vbcrlf
xmlstr=xmlstr+"</command_data_block>"&vbcrlf
xmlstr=xmlstr+"</misc_command>"
provision_return=PostXmlAndGetResponse(gateway,xmlstr)
'provision_return=xmlstr
end function


'服务状态正向管理时返回XML至广东移动网关

'取得移动网关POST过来的数据,并将参数返回出。
Function GetXmlPostData(command_name,action_ID,Service_ID,m_Id,Mobile_ID,Access_Mode)
dim nodes,ReturnData
Set xml = Server.CreateObject("msxml2.DOMdocument．quot;)
xml.async = False
xml.Load Request
command_name=getXmlNodevalue(xml,"command_name",1)

action_ID=getXmlNodevalue(xml,"action_id",2)
service_ID=getXmlNodevalue(xml,"service_id",2)
m_id=getXmlNodevalue(xml,"mid",2)
Mobile_ID=getXmlNodevalue(xml,"mobile_id",2)
access_mode=getXmlNodevalue(xml,"access_mode",2)

End Function


sub Provision_Response(byval result_id,byval result_string)
dim XmlStr,xhttp
Response.ContentType="text/xml"
XmlStr=XmlStr+"<?xml version = ""1.0"" ?>"&vbcrlf
XmlStr=XmlStr+"<misc_command version=""1.3"">"&Vbcrlf
XmlStr=XmlStr+"<command_name>provision_response</command_name>"&Vbcrlf
XmlStr=XmlStr+"<command_data_block>"&vbcrlf
XmlStr=XmlStr+"<result_id>"+result_Id+"</result_id>"&vbcrlf
XmlStr=XmlStr+"<result_string>"+result_string+"</result_string>"&vbcrlf
XmlStr=XmlStr+"</command_data_block>"&vbcrlf
XmlStr=XmlStr+"</misc_command>"
response.write xmlstr
End sub


'服务状态反向管理时向移动网关发送请求
Function sp_Provision( result_id, result_string)
dim XmlStr,xhttp
XmlStr=XmlStr+"<?xml version = ""1.0"" ?>"&vbcrlf
XmlStr=XmlStr+"<misc_command version=""1.3"">"&Vbcrlf
XmlStr=XmlStr+"<command_name>sp_provision</command_name>"&Vbcrlf
XmlStr=XmlStr+"<command_data_block>"&vbcrlf
XmlStr=XmlStr+"<action_Id>"+action_Id+"</action_Id>"&vbcrlf
XmlStr=XmlStr+"<service_id>"+service_id+"</service_id>"&vbcrlf
XmlStr=XmlStr+"<access_mode>"+access_mode+"</access_mode>"&vbcrlf
XmlStr=XmlStr+"<mid>"+m_id+"</mid>"&vbcrlf
XmlStr=XmlStr+"<mobile_id>"+mobile_id+"</mobile_id>"&vbcrlf
XmlStr=XmlStr+"<sp_id>"+sp_id+"</sp_id>"&vbcrlf
XmlStr=XmlStr+"<sp_password>"+sp_password+"</sp_password>"&vbcrlf
XmlStr=XmlStr+"</command_data_block>"&vbcrlf
XmlStr=XmlStr+"</misc_command>"
call writepostdata(xmlstr)
xmlString=PostXmlAndGetResponse(ProviSionWapGateWay,XmlStr)
Result_ID=GetNodevalue(xmlstring,"<result_id>")
result_string=GetNodevalue(xmlstring,"<result_string>")


' set xmlString=PostXmlAndGetResponse(ProviSionWapGateWay,XmlStr)
' Result_ID=GetXmlNodevalue(XmlString,"result_id","2")
' result_string=GetXmlNodevalue(XmlString,"result_string","2")

End Function

Function GetNodevalue(XMLStr,Node)
BeginData=instr(xmlstr,node)+Len(node)+1
EndData=instr(BeginData,xmlstr,"<")
DataLen=EndData-BeginData
if datalen>0 Then
GetNodevalue=mid(xmlstr,Begindata,DataLen)
Else
GetNodevalue="Err:Parameters Lost!"
End IF
End Function

Sub writepostdata(str) '用于调试时观察数据

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\postdata.txt", forwriting,1)
f.Write str
f.Close
End Sub
'-----------------------------------------------------------------

%>
----------------------------------------------------------------------------------
const.asp
<%
const sp_id="888888
Const sp_password="FDkjfDsfdslfas32"
'Const wapgateway="网关地址"
Const ssogateway="网关地址"
Const echogateway="网关地址"
Const provisiongateway="网关地址"
%>

[zhaoweiwei]

Provision Function


<%
(2002-5-20)
'判断是否已定制用户
function ismonthuser(mid,serviceid,flag)
set cmm=server.createobject("adodb.command")
'set rs=server.createobject("adodb.recordset")
with cmm
.activeconnection=application("cnnstr")
.commandtype=4
.commandtext="wap_monthservice"
.parameters(1)=1
.parameters(2)=mid
.parameters(3)=serviceid
.parameters(4)=flag
.execute
ismonthuser=.parameters(6)
end with
'if not(rs.eof and rs.bof) then
' ismonthuser="0" '已定制
'else
' ismonthuser="1" '未定制
'end if
'set rs=nothing
set cmm.activeconnection=nothing
set cmm=nothing
if ismonthuser="" then ismonthuser=1
end function


Function Provision(action_ID,Service_ID,M_ID,Mobile_ID,Access_Mode,Result_ID,Result_string)
set cm=server.createobject("adodb.command")
with cm
.activeconnection=conn
.commandtype=4
.commandtext="Wap_MonthServe"
.parameters(1)=Action_ID
.parameters(2)=Mobile_ID
.parameters(3)=service_ID
.parameters(4)=M_Id
.parameters(5)=Access_Mode
set rs=.execute
end with
Result_ID=cstr(rs(0))
Result_string=cstr(rs(1))
rs.close
set rs=nothing
set cm.activeconnection=nothing
set cm=nothing
End Function

function unicode(str)
dim i,j,c,i1,i2,u,fs,f,p
unicode=""
p=""
str= Server.HTMLEncode(str)
for i=1 to len(str)
c=mid(str,i,1)
j=ascw(c)
if j<0 then
j=j+65536
end if
if j>=0 and j<=128 then
if p="c" then
unicode=" "&unicode
p="e"
end if
unicode=unicode&c
else
if p="e" then
unicode=unicode&" "
p="c"
end if
unicode=unicode&"&#"&j&";"
end if
next
end function


function Subscript(tp,m_id,SerID,flag)
set cm=server.createobject("adodb.command")
with cm
.activeconnection=application("cnnstr")
.commandtype=4
.commandtext="Wap_MonthService"
.parameters(1)=tp
.parameters(2)=m_id
.parameters(3)=serid
.parameters(4)=flag
.execute
subscript=.parameters(6)
end with
set cm.activeconnection=nothing
set cm=nothing
End Function


Function readfiles(service_ID,position)
Set fs = CreateObject("Scripting.FileSystemObject")
filename=server.mappath("..\pub\fee.txt")
Set readfile=fs.OpenTextFile(filename,1,False)
Do while not readfile.atendofstream
Text=readfile.readline
arrStr= split(Text, ";")
IF trim(arrstr(0))=Service_ID Then
readFiles=trim(arrstr(position))
exit do
End IF
loop
readfile.close
set readfile=nothing
set fs=nothing
End Function


Function IsSimulator '是否模拟器
IsSimulator=False
browser=array("msie","nokia toolkit","m3gate","waplite","EnterOtherSimulator")
Browserinfo=lcase(request.servervariables("HTTP_USER_AGENT"))
for i=0 to ubound(browser)
if instr(Browserinfo,browser(i))>0 then
IsSimulator=True
exit for
End IF
I=I+1
next
End Function


function AllowPhone(byval AllowPhones,byval AllowSimulator) '参数一：充许手机串，以“;”为分隔符，参数二：是否充许模拟器;
dim allow,i,browserinfo
IF Allowphones="" Then
allow=true
else
allow=false
Browse=split(AllowPhones, ";")
Browserinfo=lcase(request.servervariables("HTTP_USER_AGENT"))
for i=0 to ubound(browse)
if instr(Browserinfo,browse(i))>0 then
allow=True
exit for
End IF
I=I+1
next
end if

'是模拟器且不充许模拟器访问或不是模拟器且含有不充许的手机串，则：
IF (ISSimulator and (not allowSimulator)) or ((not ISSImulator) and (not allow)) Then
'call showerrCard("手机类型有误，访问拒绝!"&request.servervariables("HTTP_USER_AGENT"))
'response.write "</wml>"
'response.end
allowphone=false
else
allowphone=true
End IF
end function
%>

[mzqali1]

不错不错

[mzqali1]

注：这是MISC1.5版本的，现在MISC升级到了1.6,其中的SSO认证部分可以跳过，对GPRS浏览速度有了很大的提高。

[clh1981]

THANK YOU!!!

[clh1981]

XML以前没有学过，我现在正晕着。请楼主把调用函数那部份代码也奉献出来吧!
万分感谢！！！

[weilysunhg]

学习

[mygia]

这个东西用来干嘛的？

[gsen]

mark

[YAOHE]

感激，正在找相关信息，谢谢！

[hf23]

如何能把分送给楼猪?

[qsfsea]

gz

[妖怪]

顶

[mygia]

好东西不能沉底

[godfox]

怎么理解呢

[shanhe]

多谢

[mygia]

再次学习再次关注再次顶！

[qiri07]

有.net 版的么

[广州秀才]

顶,多谢楼主无私贡献