<!--#include file="config.inc.asp"-->
<!--#include file="xmlbase.inc.asp"-->
<!--#include file="base64.inc.asp"-->
<%
Class SMS
	Private domaintype
	Private serverURL
	Private VCPU
	private responseXML
	public sendXML
	private DEBUG
	private XMLType
	private VCPPsword

	'******************************************************************
	public function SMS()
		serverURL = "sms.todaynic.com:"& vcpserverport
		VCPU = vcpuser
		VCPPsword = vcppassword
		DEBUG = 0
		XMLType = "SMS"
	end function

	function sendXMLData(XMLDATA)
		sendXML=XMLDATA
		responseXML=""
		if DEBUG>0 then response.Write "sendxml:"&XMLDATA
		serverURL=ReplaceTest(serverURL,"^http://","")
		pos=instr(serverURL,"/")
		if pos>0 then
			deshost=left(serverURL,pos)
			despath=left(serverURL,pos)
		else
			deshost=serverURL
			despath="/"
		end if
		pos=instr(deshost,":")
		if pos>0 then
			port=right(deshost,len(deshost)-pos)
			deshost=left(deshost,pos)
		else
			port=80
		end if
		if DEBUG>0 then response.write deshost&":"&port&":"&despath
		if len(deshost)=0  Or len(despath)=0 or port>=0 then
			responseXML="HOST:"&deshost&"   PORT:"&port&"   PATH:"&despath
			sendXMLData = responseXML
		end if

		tempcontents=trim(XMLDATA)
		tempcontents=right(tempcontents,len(tempcontents)-instr(tempcontents,"<?xml")+4)
		tempend=InstrRev(tempcontents,"</scp>")+6
		if tempend>6 then	tempcontents=left(tempcontents,tempend)
		if len(tempcontents)>0 then responseXML=tempcontents
		out = XMLDATA
		'传送XML信息到服务端
		sendXMLData = whois(out,deshost,port,20)
	end function

	public function getCode()
		start_pos = Instr(responseXML, "<result code=")
		if start_pos>0 then
			getCode = trim(Mid(responseXML, start_pos + 14, 4))
		end if
	end function

	'***************SOCTET与服务器建立通信

	public Function whois(out, paraHost,paraPort,paraTimeout)
		On Error Resume Next
		Set sock = CreateObject("Socket.TCP")
		sock.Host = paraHost&paraPort
		sock.Open()
		If Err.Number <> 0 Then Err.Clear
		sock.SendLine out
		'Socket.SendLine "GET " & out & " HTTP/1.0"
		'Socket.SendLine "HOST: " & paraHost&paraPort
		'Socket.SendLine ""
		'Socket.SendLine ""
		sock.WaitForDisconnect()

		'Response.Write(socket.Buffer)
		'**
		If Err.Number <> 0 Then
			responseXML=Chr(13)&"unable to connect to "&paraHost&paraPort & " -- " & Err.Number & " -- " & Err.Description
			whois=responseXML
			Err.Clear
		Else
			responseXML = HTTPResponse(sock.Buffer, 1)
			'output text from  socket
			'response.Write("2!"&paraHost&paraPort)
			whois=responseXML
		End If
 	sock.Close()
	Set sock = Nothing
	End Function

	Private Function HTTPResponse(ByVal toHTTPResponse, ByVal whichHTTPResponse)
 		'On Error Resume Next
 		Dim HTTPResponseDelimiter
		httpStyle=chr(13)&chr(10)
  		HTTPResponseDelimiter = "<?xml"
 		If len(toHTTPResponse) > 0 Then
    	Select Case whichHTTPResponse
    		Case 0 'Header
     			HTTPResponse = replace(httpStyle&Mid(toHTTPResponse, 1, (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) - 1)),"><",">"&chr(13)&"<")
    		Case 1 'Body
	      		HTTPResponse = replace(httpStyle&Mid(toHTTPResponse, (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare)), (Len(toHTTPResponse) - (InStr(1, toHTTPResponse, HTTPResponseDelimiter, vbBinaryCompare) - 1))),"><",">"&chr(13)&"<")
    End Select
	ELSE
		responseXML=httpStyle&"NO XML Error,please check the xml which post to Server."
		HTTPResponse=responseXML
  End If
'response.Write(HTTPResponseDelimiter)
End Function

'****************************************************************************************************

    public function toPlain()
		tempcontents=trim(responseXML)
		tempcontents=right(tempcontents,len(tempcontents)-instr(tempcontents,"<?xml")+4)
		tempend=InstrRev(tempcontents,"</scp>")+6
		if tempend>6 then	tempcontents=left(tempcontents,tempend)
		if len(tempcontents)>0 then responseXML=tempcontents
		'response.write(tempcontents)
		toPlain = responseXML
	end function

	private function sendSCPData(desurl,XMLDATA)
		XMLDATA = toSCPXML(XMLDATA)
		sendSCPData = sendXMLData(XMLDATA)
	end function


	function toSCPXML(CommandXML)
		tempcltrid=CltrID()
		getPSClientid=getENCID(tempcltrid,VCPPsword)
		xmlns = getXMLNS()
		secruser = getSecurityUser()
		respxml="<?xml version=""1.0"" encoding=""gb2312""?>"&chr(13)&chr(13)&_
		"<scp "&xmlns&">"&chr(13)&_
		"   <command>"&CommandXML&chr(13)&_
		"   </command>"&chr(13)&_
		"   <security>"&secruser&chr(13)&_
		"   <cltrid>"&tempcltrid&"</cltrid>"&chr(13)&_
		"       <login>"&getPSClientid&"</login>"&chr(13)&_
		"   </security>"&chr(13)&_
		"</scp>"
		'格式化XML,以便显示时好看一点
        'respxml=ReplaceTest(respxml,"\t","    ")
		toSCPXML = respxml
	end function

	function getXMLNS()
		if UCase(XMLType)="SMS" then
			xmlns = "xmlns=""urn:mobile:params:xml:ns:scp-1.0"""&chr(13)&chr(10)&_
			  " xmlns:sms=""urn:todaynic.com:sms"""&chr(13)&chr(10)&_
			 " xmlns:user=""urn:todaynic.com:user"""
		else
			xmlns = "xmlns=""urn:mobile:params:xml:ns:scp-1.0""	"&chr(13)&chr(10)&_
			 " xmlns:sms=""urn:todaynic.com:sms""	"&chr(13)&chr(10)&_
			 " xmlns:user=""urn:todaynic.com:user""	"
'			 " xmlns:registrant=""urn:todayisp.com:registrant""	"&chr(13)&chr(10)&_
'			 " xmlns:host=""urn:todayisp.com:host"""
		end if
		getXMLNS = xmlns
	end function

	function getSecurityUser()
			secruser = "<smsuser>"&VCPU&"</smsuser>"
		getSecurityUser = secruser
	end function

	function getUserInfo(contactI)
		sendxml="<action>user:detail</action>"&chr(13)&_
					"<userid>"&contactI(0)&"</userid>"&chr(13)&_
					"<userpassword>"&contactI(1)&"</userpassword>"
		call sendSCPData(serverURL,sendxml)
		call toPlain()
		getUserInfo = responseXML
	end function

	private function setDomainsuffix(domain)
		dim pos
		pos=InstrRev(domain,".")
		if pos>0 then
			suffix=right(domain,len(domain)-pos)
			suffix="dot"&trim(LCase(suffix))
			domaintype=suffix
		end if
	END function

	public function sendSMS(t_pho,t_msg,t_time,apitype)
		call SMS()
		'If Len(t_msg)>60 Then
			'sendxml = "你发送的短信超过60个字符，假如你使用的是API接口请分割sendSMS方法中的t_msg"
		'Else
		't_msg = strAnsi2Unicode(Base64encode(strUnicode2Ansi(UTF2GB(t_msg))))
		If VCPMaxLen <> "0" Then
				content = Left(t_Msg,VCPMaxLen)
		Else
				content = t_Msg
		End If
		wordcount = 70
		wordSum = len(content)
		wordMod = wordSum mod wordCount
		pageCount = int(wordSum/wordCount)
		for i = 1 to (pageCount + 1)
				t_msg = strAnsi2Unicode(Base64encode(strUnicode2Ansi(mid(content,wordCount*(i-1)+1,wordCount))))
				sendxml = "<action>SMS:sendSMS </action>"&chr(13)&_
							"<sms:mobile>"&t_pho&"</sms:mobile>"&chr(13)&_
							"<sms:message>"&t_msg&"</sms:message>"&chr(13)&_
							"<sms:datetime>"&t_time&"</sms:datetime>"&chr(13)&_
							"<sms:apitype>"&apitype&"</sms:apitype>"
				call sendSCPData(serverURL,sendxml)
		next
		call toPlain()
		sendSMS = responseXML
		'End If
	END function

	public function infoSMSAccount()
		call SMS()
		sendxml = "<action>SMS:infoSMSAccount</action>"
		call sendSCPData(serverURL,sendxml)
		call toPlain()
		infoSMSAccount = responseXML
	END Function

	public function readSMS()
		call SMS()
		sendxml = "<action>SMS:readSMS</action>"
		call sendSCPData(serverURL,sendxml)
		call toPlain()
		readSMS = responseXML
	END Function

	Function GetHttpPage(Datas,action)
		dim text
		text = GetBody("http://www.72dns.com/smsadmin/Sms_Api.aspx?UserID=" & VCPUser &"&PassWord="& SMS_MD5(VCPPassword) &  "&action="& action &Datas)
		GetHttpPage = BytesToBstr(text,"GB2312")
	End function

	Function GetBody(url) 
		dim xmlhttp
		Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
		xmlhttp.Open "Post", url, False, "", ""
		xmlhttp.Send()
		GetBody = xmlhttp.ResponseBody
		Set xmlhttp = Nothing 
	End Function

	Function BytesToBstr(body,Cset)
		dim objstream
		set objstream = Server.CreateObject("adodb.stream")
		objstream.Type = 1
		objstream.Mode =3
		objstream.Open
		objstream.Write body
		objstream.Position = 0
		objstream.Type = 2
		objstream.Charset = Cset
		BytesToBstr = objstream.ReadText 
		objstream.Close
		set objstream = nothing
	End Function

	Public Function Safereplace(Str)
			If Isnull(Str) Then
					Safereplace = ""
					Exit Function
			End If
			Str = Replace(Str,";","")
			Str = Replace(Str,"'","&#180;")
			Str = Replace(Str,"%","")
			Str = Replace(Str,"""","&#34;")
			Str = Replace(Str,"<","&lt;")
			Str = Replace(Str,">","&gt;")
			Str = Replace(Str,"$","")
			Safereplace = Str
	End Function
End Class
%>
