请各位大侠帮写一个操作XML的ASP

WangZWang 2007-04-06 10:06:52
// 下面是一段 Delphi 的过程,麻烦各位大虾转为为ASP, 感谢!

function TForm1.dg(Const tid,spid,dq,zhujiao,serverid:string):string;
{
Tid: 时间流水号,如:spid+FormatDatetime('yymmddmmss',Now)
SpID: 企业代码,如924579
Dq: SP所在地区,如XX省的DQ是0028
Zhujiao:手机号
Serviceid:业务代码
}
var
xhttp: Variant;
XmlBody:string;
SendText:TStringList;
hRet:string;
begin
SendText:=TStringList.Create;
Try
SendText.Add('<?xml version="1.0" encoding="UTF-8" ?>');
SendText.Add('<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/" ');
SendText.Add('xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd=http://www.w3.org/2001/XMLSchema" SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns="http://www.monternet.com/dsmp/schemas/">');
SendText.Add('<SOAP-ENV:Header>');
SendText.Add(Format('<TransactionID xmlns="http://www.monternet.com/dsmp/schemas/" xsi:type="xsd:string">%s</TransactionID>',[tid]));
SendText.Add('</SOAP-ENV:Header>');
SendText.Add('<SOAP-ENV:Body>');
SendText.Add('<SubscribeServiceReq xmlns="http://www.monternet.com/dsmp/schemas/">');
SendText.Add('<Version>1.5.0</Version>');
SendText.Add('<MsgType>SubscribeServiceReq</MsgType>');
SendText.Add('<Send_Address>');
SendText.Add('<DeviceType>400</DeviceType>');
SendText.Add(Format('<DeviceID>%s</DeviceID>',[spID]));
SendText.Add('</Send_Address>');
SendText.Add('<Dest_Address>');
SendText.Add('<DeviceType>0</DeviceType>');
SendText.Add(Format('<DeviceID>%s</DeviceID>',[dq]));
SendText.Add('</Dest_Address>');
SendText.Add('<FeeUser_ID>');
SendText.Add('<UserIDType>1</UserIDType>');
SendText.Add(Format('<MSISDN>%s</MSISDN>',[zhujiao]));
SendText.Add('<PseudoCode />');
SendText.Add('</FeeUser_ID>');
SendText.Add('<DestUser_ID>');
SendText.Add('<UserIDType>1</UserIDType>');
SendText.Add(Format('<MSISDN>%s</MSISDN>',[zhujiao]));
SendText.Add('<PseudoCode />');
SendText.Add('</DestUser_ID>');
SendText.Add('<Service_ID>');
SendText.Add('<ServiceIDType>1</ServiceIDType>');
SendText.Add(Format('<SPID>%s</SPID>',[spID]));
SendText.Add(Format('<SPServiceID>%s</SPServiceID>',[serverid]));
SendText.Add('<AccessNo />');
SendText.Add('</Service_ID>');
SendText.Add('<FeatureStr />');
SendText.Add('</SubscribeServiceReq>');
SendText.Add('</SOAP-ENV:Body>');
SendText.Add('</SOAP-ENV:Envelope>');
xhttp:= CreateOleObject('Microsoft.XMLHTTP');
xhttp.open('POST', 'http://211.139.9.181/dsmp/dsmp.wsdl', False);
xhttp.send(SendText.text);
hRet:=GetRetCode(xhttp.ResponseText,'<HRET>','</HRET>');
Result:=hRet;
Finally
SendText.Destroy;
end;
end;
...全文
746 23 打赏 收藏 转发到动态 举报
写回复
用AI写文章
23 条回复
切换为时间正序
请发表友善的回复…
发表回复
RexZheng 2007-04-07
  • 打赏
  • 举报
回复
这哥们是delphi的高人,呵呵
从那边转过来的贴
fenghao_5555 2007-04-07
  • 打赏
  • 举报
回复
学习
wtogether 2007-04-06
  • 打赏
  • 举报
回复
dg = xmlRet.documentElement.selectSingleNode("SOAP-ENV:Body/dsmp:SyncOrderRelationResp/hRet").text
改一下
dg = xmlRet.documentElement.selectSingleNode("SOAP-ENV:Body/SubscribeServiceResp/hRet").text
wtogether 2007-04-06
  • 打赏
  • 举报
回复
看着象MISC,但是又少了几个参数,而且文档不符合规范,在xmlns:xsd=后应该有个双引号的

Private Sub setNodeText(xmlDoc, ByVal strNode, ByVal strValue)
Dim xmlNode
Set xmlNode = xmlDoc.documentElement.selectSingleNode(strNode)
If xmlNode Is Nothing Then
Err.Raise vbObjectError + 1, "setNodeText", "找不到节点:" & strNode
End If
xmlNode.text = strValue
Set xmlNode = Nothing
End Sub

Public Function dg(ByVal tid, ByVal spid, ByVal dq, ByVal zhujiao, ByVal serverid)
Dim strTemp
Dim xmlDoc
Dim xmlHttp

Set xmlDoc = Server.CreateObject("MSXML2.FreeThreadedDOMDocument")
xmlDoc.async = False
xmlDoc.loadXML "<?xml version=""1.0"" encoding=""UTF-8""?>" & _
"<SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:SOAP-ENC=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" SOAP-ENV:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns=""http://www.monternet.com/dsmp/schemas/"">" & _
"<SOAP-ENV:Header>" & _
"<TransactionID xmlns=""http://www.monternet.com/dsmp/schemas/""></TransactionID>" & _
"</SOAP-ENV:Header>" & _
"<SOAP-ENV:Body>" & _
"<SubscribeServiceReq xmlns=""http://www.monternet.com/dsmp/schemas/""><Version>1.5.0</Version><MsgType>SubscribeServiceReq</MsgType><Send_Address><DeviceType>400</DeviceType><DeviceID></DeviceID></Send_Address><Dest_Address><DeviceType>0</DeviceType><DeviceID></DeviceID></Dest_Address><FeeUser_ID><UserIDType>1</UserIDType><MSISDN></MSISDN><PseudoCode /></FeeUser_ID><DestUser_ID><UserIDType>1</UserIDType><MSISDN></MSISDN><PseudoCode /></DestUser_ID><Service_ID><ServiceIDType>1</ServiceIDType><SPID></SPID><SPServiceID></SPServiceID><AccessNo /></Service_ID><FeatureStr /></SubscribeServiceReq>" & _
"</SOAP-ENV:Body>" & _
"</SOAP-ENV:Envelope>"

setNodeText xmlDoc, "SOAP-ENV:Header/TransactionID", tid
setNodeText xmlDoc, "SOAP-ENV:Body/SubscribeServiceReq/Send_Address/DeviceID", spid
setNodeText xmlDoc, "SOAP-ENV:Body/SubscribeServiceReq/Dest_Address/DeviceID", dq
setNodeText xmlDoc, "SOAP-ENV:Body/SubscribeServiceReq/FeeUser_ID/MSISDN", zhujiao
setNodeText xmlDoc, "SOAP-ENV:Body/SubscribeServiceReq/DestUser_ID/MSISDN", zhujiao
setNodeText xmlDoc, "SOAP-ENV:Body/SubscribeServiceReq/Service_ID/SPID", spid
setNodeText xmlDoc, "SOAP-ENV:Body/SubscribeServiceReq/Service_ID/SPServiceID", serverid

Set xmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
Const DNSTimeout = 1000 '解析DNS名字的超时时间,1秒
Const CONTimeout = 3000 '建立Winsock连接的超时时间,1秒
Const SNDTimeout = 10000 '发送数据的超时时间,10秒
Const RCVTimeout = 30000 '接收response的超时时间,30秒
xmlHttp.setTimeouts DNSTimeout, CONTimeout, SNDTimeout, RCVTimeout
xmlHttp.Open "POST", "http://211.139.9.181/dsmp/dsmp.wsdl", False
xmlHttp.SetRequestHeader "Content-Type", "text/xml"
xmlHttp.Send xmlDoc

Dim xmlRet
Set xmlRet = xmlHttp.responseXML
If xmlRet.parseError.errorCode Then
dg = 0
Else
dg = xmlRet.documentElement.selectSingleNode("SOAP-ENV:Body/dsmp:SyncOrderRelationResp/hRet").text
End If
Set xmlRet = Nothing
Set xmlHttp = Nothing
Set xmlDoc = Nothing
End Function

Repsonse.Write dg("00210316373629", "1000", "0028", "13888888888", "10000033")
leohuang 2007-04-06
  • 打赏
  • 举报
回复
返回这东东
1.5.0SubscribeServiceResp122
leohuang 2007-04-06
  • 打赏
  • 举报
回复
<%
function GetRetCode(aStr,aHead,aEnd)
dim PosIndex
dim tmp
tmp =aStr
PosIndex = instr(UCase(aHead),UCase(tmp))
if PosIndex >0 then
tmp = left(tmp,PosIndex) + right(tmp,len(tmp)-PosIndex-len(aHead))
PosIndex =instr(UCase(aEnd),UCase(tmp))
if PosIndex > 0 then tmp = mid(tmp,1,PosIndex-1)
end if
GetRetCode=tmp
end function


dim SendText
dim xHttp
dim XmlBody
dim hRet
SendText=SendText & "<?xml version=""1.0"" encoding=""UTF-8"" ?>"
SendText=SendText & "<SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:SOAP-ENC=""http://schemas.xmlsoap.org/soap/encoding/"" "
SendText=SendText & "xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=http://www.w3.org/2001/XMLSchema"" SOAP-ENV:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns=""http://www.monternet.com/dsmp/schemas/"">"
SendText=SendText & "<SOAP-ENV:Header>"
SendText=SendText & "<TransactionID xmlns=""http://www.monternet.com/dsmp/schemas/"" xsi:type=""xsd:string"">" & tid & "</TransactionID>"
SendText=SendText & "</SOAP-ENV:Header>"
SendText=SendText & "<SOAP-ENV:Body>"
SendText=SendText & "<SubscribeServiceReq xmlns=""http://www.monternet.com/dsmp/schemas/"">"
SendText=SendText & "<Version>1.5.0</Version>"
SendText=SendText & "<MsgType>SubscribeServiceReq</MsgType>"
SendText=SendText & "<Send_Address>"
SendText=SendText & "<DeviceType>400</DeviceType>"
SendText=SendText & "<DeviceID>" & spID & "</DeviceID>"
SendText=SendText & "</Send_Address>"
SendText=SendText & "<Dest_Address>"
SendText=SendText & "<DeviceType>0</DeviceType>"
SendText=SendText & "<DeviceID>" & dq & "</DeviceID>"
SendText=SendText & "</Dest_Address>"
SendText=SendText & "<FeeUser_ID>"
SendText=SendText & "<UserIDType>1</UserIDType>"
SendText=SendText & "<MSISDN>" & zhujiao & "</MSISDN>"
SendText=SendText & "<PseudoCode />"
SendText=SendText & "</FeeUser_ID>"
SendText=SendText & "<DestUser_ID>"
SendText=SendText & "<UserIDType>1</UserIDType>"
SendText=SendText & "<MSISDN>" & zhujiao & "</MSISDN>"
SendText=SendText & "<PseudoCode />"
SendText=SendText & "</DestUser_ID>"
SendText=SendText & "<Service_ID>"
SendText=SendText & "<ServiceIDType>1</ServiceIDType>"
SendText=SendText & "<SPID>" & spID & "</SPID>"
SendText=SendText & "<SPServiceID>" & serverid & "</SPServiceID>"
SendText=SendText & "<AccessNo />"
SendText=SendText & "</Service_ID>"
SendText=SendText & "<FeatureStr />"
SendText=SendText & "</SubscribeServiceReq>"
SendText=SendText & "</SOAP-ENV:Body>"
SendText=SendText & "</SOAP-ENV:Envelope>"

Set xhttp = Server.CreateObject("Microsoft.XMLHTTP")
xhttp.open "POST", "http://211.139.9.181/dsmp/dsmp.wsdl", False
xhttp.send(SendText)
hRet=GetRetCode(xhttp.ResponseText,"<HRET>","</HRET>")
Result=hRet
Response.Write hRet
%>
WangZWang 2007-04-06
  • 打赏
  • 举报
回复
生成规定的格式,然后进行发送
dh20156 2007-04-06
  • 打赏
  • 举报
回复
你这是要做什么?提交还是生成?
learsu 2007-04-06
  • 打赏
  • 举报
回复
啥也不说了,专心学习就是了。
WangZWang 2007-04-06
  • 打赏
  • 举报
回复
function TForm1.GetRetCode(const aStr,aHead,aEnd:String):String;
var
PosIndex:Integer;
tmp:String;
Begin
Result :='';
tmp :=aStr;
PosIndex :=POS(UpperCase(aHead),UpperCase(tmp));
if PosIndex >0 then
Begin
Delete(tmp,1,PosIndex-1+Length(aHead));
PosIndex :=POS(UpperCase(aEnd),UpperCase(tmp));
if PosIndex > 0 then
Result :=Copy(tmp,1,PosIndex-1);
end;
end;
pzhuyy 2007-04-06
  • 打赏
  • 举报
回复
Dim objXML,GetBody
Dim Url
url="http://211.139.9.181/dsmp/dsmp.wsdl"
Dim userInfo
On Error Resume Next
Set objXML = CreateObject("Microsoft.XMLHTTP")
userInfo = '此处为xml文档的内容
With objXML
.Open "Post", Url, False, "", ""
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.Send userInfo
GetBody = .ResponseBody
End With
GetBody=BytesToBstr(GetBody,"GB2312")
Set objXML = Nothing
'GetBody为返回值
'如有可能,需要设置其它setRequestHeader
'楼主自己研究了

'使用Adodb.Stream处理二进制数据
Function BytesToBstr(strBody,CodeBase)
dim objStream
set objStream = Server.CreateObject("Adodb.Stream")
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write strBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = CodeBase
BytesToBstr = objStream.ReadText
objStream.Close
set objStream = nothing
End Function
leohuang 2007-04-06
  • 打赏
  • 举报
回复
try
(GetRetCode函数不知道什么内容)
----------------------
<%
dim SendText
dim xHttp
dim XmlBody
dim hRet
SendText=SendText & "<?xml version=""1.0"" encoding=""UTF-8"" ?>"
SendText=SendText & "<SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:SOAP-ENC=""http://schemas.xmlsoap.org/soap/encoding/"" "
SendText=SendText & "xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=http://www.w3.org/2001/XMLSchema"" SOAP-ENV:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/"" xmlns=""http://www.monternet.com/dsmp/schemas/"">"
SendText=SendText & "<SOAP-ENV:Header>"
SendText=SendText & "<TransactionID xmlns=""http://www.monternet.com/dsmp/schemas/"" xsi:type=""xsd:string"">" & tid & "</TransactionID>"
SendText=SendText & "</SOAP-ENV:Header>"
SendText=SendText & "<SOAP-ENV:Body>"
SendText=SendText & "<SubscribeServiceReq xmlns=""http://www.monternet.com/dsmp/schemas/"">"
SendText=SendText & "<Version>1.5.0</Version>"
SendText=SendText & "<MsgType>SubscribeServiceReq</MsgType>"
SendText=SendText & "<Send_Address>"
SendText=SendText & "<DeviceType>400</DeviceType>"
SendText=SendText & "<DeviceID>" & spID & "</DeviceID>"
SendText=SendText & "</Send_Address>"
SendText=SendText & "<Dest_Address>"
SendText=SendText & "<DeviceType>0</DeviceType>"
SendText=SendText & "<DeviceID>" & dq & "</DeviceID>"
SendText=SendText & "</Dest_Address>"
SendText=SendText & "<FeeUser_ID>"
SendText=SendText & "<UserIDType>1</UserIDType>"
SendText=SendText & "<MSISDN>" & zhujiao & "</MSISDN>"
SendText=SendText & "<PseudoCode />"
SendText=SendText & "</FeeUser_ID>"
SendText=SendText & "<DestUser_ID>"
SendText=SendText & "<UserIDType>1</UserIDType>"
SendText=SendText & "<MSISDN>" & zhujiao & "</MSISDN>"
SendText=SendText & "<PseudoCode />"
SendText=SendText & "</DestUser_ID>"
SendText=SendText & "<Service_ID>"
SendText=SendText & "<ServiceIDType>1</ServiceIDType>"
SendText=SendText & "<SPID>" & spID & "</SPID>"
SendText=SendText & "<SPServiceID>" & serverid & "</SPServiceID>"
SendText=SendText & "<AccessNo />"
SendText=SendText & "</Service_ID>"
SendText=SendText & "<FeatureStr />"
SendText=SendText & "</SubscribeServiceReq>"
SendText=SendText & "</SOAP-ENV:Body>"
SendText=SendText & "</SOAP-ENV:Envelope>"

Set xhttp = Server.CreateObject("Microsoft.XMLHTTP")
xhttp.open "POST", "http://211.139.9.181/dsmp/dsmp.wsdl", False
xhttp.send(SendText)
hRet=GetRetCode(xhttp.ResponseText,"<HRET>","</HRET>")
Result=hRet
%>
pzhuyy 2007-04-06
  • 打赏
  • 举报
回复
我也在纳闷儿.
一个裤衩发300分贴
leohuang 2007-04-06
  • 打赏
  • 举报
回复
靠,那么牛叉
1个裤衩发300分贴
shadow841112 2007-04-06
  • 打赏
  • 举报
回复
LZ能发300??????BUG?????????????
leohuang 2007-04-06
  • 打赏
  • 举报
回复
GetRetCode这么写
--------------------------------------
function GetRetCode(aStr,aHead,aEnd)
dim reg
set reg = new RegExp
reg.Pattern = aHead & "(\d+)" & aEnd
reg.IgnoreCase = True
reg.Global = True
Set Matches = reg.Execute(aStr)
if Matches.Count>0 then GetRetCode=Matches(0).Value else GetRetCode=""
end function
chessman_mak 2007-04-06
  • 打赏
  • 举报
回复
学习学习
wubaowang 2007-04-06
  • 打赏
  • 举报
回复

学习..
ivenlove 2007-04-06
  • 打赏
  • 举报
回复
这么多分,帮你顶,给点分呀,老兄,穷死了...
cxc3214 2007-04-06
  • 打赏
  • 举报
回复
太长了,,顶下,,
加载更多回复(3)

28,390

社区成员

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages,是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧