ASP编写的MISC函数集 （转）
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="网关地址"
%>
问题点数：0、回复次数：18Top
1 楼zhaoweiwei（if(轩辕剑^倚天剑)）回复于 2004-04-01 22:28:29 得分 0
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
%>
Top
2 楼mzqali1（梦网无限）回复于 2004-04-02 12:45:01 得分 0
不错不错Top
3 楼mzqali1（梦网无限）回复于 2004-04-02 12:47:00 得分 0
注：这是MISC1.5版本的，现在MISC升级到了1.6,其中的SSO认证部分可以跳过，对GPRS浏览速度有了很大的提高。Top
4 楼clh1981（玉猫）回复于 2004-07-19 16:28:03 得分 0
THANK YOU!!!Top
5 楼clh1981（玉猫）回复于 2004-07-19 16:58:25 得分 0
XML以前没有学过，我现在正晕着。请楼主把调用函数那部份代码也奉献出来吧!
万分感谢！！！Top
6 楼weilysunhg（一天到晚红烧的鱼）回复于 2004-07-20 23:31:49 得分 0
学习Top
7 楼mygia（www.gzcost.com）回复于 2004-07-22 17:35:09 得分 0
这个东西用来干嘛的？Top
8 楼gsen（进入就是上帝）回复于 2004-07-24 22:40:14 得分 0
markTop
9 楼YAOHE（吆喝）回复于 2004-08-03 20:57:17 得分 0
感激，正在找相关信息，谢谢！Top
10 楼hf23（原来生命，真的是一场闹哄！）回复于 2004-08-11 09:46:08 得分 0
如何能把分送给楼猪?Top
11 楼qsfsea（忍）回复于 2004-08-18 12:25:10 得分 0
gzTop
12 楼mygia（www.gzcost.com）回复于 2004-09-02 09:40:47 得分 0
好东西不能沉底Top
13 楼dxjwolf（啸月孤狼）回复于 2004-09-02 18:39:35 得分 0
顶
Top
14 楼godfox（龙在天涯）回复于 2004-09-03 15:10:35 得分 0
怎么理解呢
Top
15 楼shanhe（TNT）回复于 2004-09-07 10:25:15 得分 0
多谢Top
16 楼mygia（www.gzcost.com）回复于 2004-09-07 12:11:57 得分 0
再次学习再次关注再次顶！Top
17 楼qiri07（俺家金毛de地位比俺高）回复于 2004-09-09 10:32:32 得分 0
有.net 版的么Top
18 楼moqiong（秀才）回复于 2004-09-15 17:42:19 得分 0
顶,多谢楼主无私贡献Top
