wappush.asp

asp实现的wappush编码程序

<%
'code by [e-mail]

dim WaPush:set WaPush=new cls_wappush

WaPush.TITLE = "picture"
WaPush.URL = "127.0.0.1/pic/sample.gif"
response.write WaPush.pushcode


class cls_wappush
	Private UrlStr,TitleStr

	Public Property Let URL(ByVal vNewValue)
		If LCase(Left(vNewValue,7))="http://" Then
			response.write "sorry,the URL string can't include 'http://'!"
			response.End
		End if
		UrlStr = LCase(vNewValue)
	End Property

	Public Property Let TITLE(ByVal vNewValue)
		If Len(Trim(vNewValue))=0 Then
			response.write "sorry,the TTILE string is empty!"
			response.End
		End If
		TitleStr = LCase(vNewValue)
	End Property

	Public Function pushcode
		Dim ourbody,total,i,Mesage_temp
		ourbody=Getbody()
		If Len(ourbody)<254 Then
			pushcode="0605040B8423F0"+ourbody
		Else
			total=(Len(ourbody)+255)/256
			If total>255 Then
				response.write "sorry,the size of content(title or url) is too big!"
				response.end
			End If
			For i=1 To total
				   Mesage_temp=Mesage_temp&"0B05040B8423F0"+"0003"+transactionid+int2hex(total)+int2hex(i)+Mid(ourbody,(i-1)*256+1,256)&"|"
			Next
			pushcode=Left(Mesage_temp,Len(Mesage_temp)-1)
		End If
	End Function

	Private Function Getbody()
		Dim mybody,transid,transactionid,pdu
		Dim urlstr_temp,titlestr_temp
		If Trim(UrlStr)="" Or Trim(TitleStr)="" Then
			response.write "sorry,the title or url is empty!"
			response.end
		End If
		urlstr_temp=str2hex(UrlStr)
		titlestr_temp=str2hex(TitleStr)
		mybody="02056A0045C6080C03"
		mybody=mybody+urlstr_temp
		mybody=mybody+"000103"
		mybody=mybody+titlestr_temp
		mybody=mybody+"000101"
		Randomize
		transid=Int(Rnd() * 255)+1
		transactionid=int2hex(transid)
		pdu=transactionid+"060403AE81EA"+mybody
		Getbody=pdu
	End Function

	Private function str2hex(str)
		    str2hex=""
			Dim x,chr_0,hexstr_0,bitstr_0,m,utf8bit_0
			For x=1 To Len(str)
                chr_0=Mid(str,x,1)
                hexstr_0=chr2hexstr(chr_0)
                bitstr_0=""
                For m=1 To Len(hexstr_0)
                        bitstr_0=bitstr_0+hexstr2bitstr(Mid(hexstr_0,m,1))
                Next
                utf8bit_0=bitstr2utf8bitstr(bitstr_0)
                str2hex=str2hex+utf8bitstr2utf8str(utf8bit_0)
        Next
	End function
	Private Function hex2bit(char)
		Select Case char
		    Case "0"
				hex2bit="0000"
			Case "1"
                hex2bit="0001"
			Case "2"
                hex2bit="0010"
			Case "3"
                hex2bit="0011"
			Case "4"
                hex2bit="0100"
			Case "5"
                hex2bit="0101"
			Case "6"
                hex2bit="0110"
			Case "7"
                hex2bit="0111"
			Case "8"
                hex2bit="1000"
			Case "9"
                hex2bit="1001"
			Case "A"
                hex2bit="1010"
			Case "B"
                hex2bit="1011"
			Case "C"
                hex2bit="1100"
			Case "D"
                hex2bit="1101"
			Case "E"
                hex2bit="1110"
			Case "F"
                hex2bit="1111"
		End Select
	End Function

	Private Function int2hex(inter)
        If inter<16 Then
			int2hex=CStr("0")&CStr(Hex(inter))
        Else        
			int2hex=CStr(Hex(inter))
        End If
	End Function

	private Function bit2hex(char)
		Select Case char
			Case "0000"
                bit2hex="0"
			Case "0001"
                bit2hex="1"
			Case "0010"
                bit2hex="2"
			Case "0011"
                bit2hex="3"
			Case "0100"
                bit2hex="4"
			Case "0101"
                bit2hex="5"
			Case "0110"
                bit2hex="6"
			Case "0111"
                bit2hex="7"
			Case "1000"
                bit2hex="8"
			Case "1001"
                bit2hex="9"
			Case "1010"
                bit2hex="A"
			Case "1011"
                bit2hex="B"
			Case "1100"
                bit2hex="C"
			Case "1101"
                bit2hex="D"
			Case "1110"
			    bit2hex="E"
			Case "1111"
                bit2hex="F"
		End select
	End Function

	private Function chr2hexstr(char)
        chr2hexstr=Hex(Ascw(char))
	End Function

	private Function hexstr2bitstr(str)
		Dim l,n
        hexstr2bitstr=""
        L = Len(str)
        For n=1 to L
			hexstr2bitstr=hexstr2bitstr+hex2bit(Mid(str,n,1))
        Next
	End Function

'utf-8 code
'1字节 0xxxxxxx
'2字节 110xxxxx 10xxxxxx
'3字节 1110xxxx 10xxxxxx 10xxxxxx
'4字节 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
'5字节 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
'6字节 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
	private Function bitstr2utf8bitstr(bitstr)
		Dim reallen
        bitstr="000000000000000000000000000000000000000000"+bitstr 'important!
        reallen=Len(bitstr)-InStr(1,bitstr,"1")+1
        If reallen<8 Then
                bitstr2utf8bitstr="0"+Right(bitstr,7)
        ElseIf reallen<12 Then
                bitstr2utf8bitstr="110"+    Left(Right(bitstr,11),5)  +"10"+Right(bitstr,6)
        ElseIf reallen<17 Then
                bitstr2utf8bitstr="1110"+   Left(Right(bitstr,16),4)  +"10"+left(Right(bitstr,12),6)+"10"+Right(bitstr,6)
        ElseIf reallen<22 Then
                bitstr2utf8bitstr="11110"+  Left(Right(bitstr,21),3)  +"10"+left(Right(bitstr,18),6)+"10"+left(Right(bitstr,12),6)+"10"+Right(bitstr,6)
        ElseIf reallen<27 Then
                bitstr2utf8bitstr="111110"+ Left(Right(bitstr,26),2)  +"10"+left(Right(bitstr,24),6)+"10"+left(Right(bitstr,18),6)+"10"+left(Right(bitstr,12),6)+"10"+Right(bitstr,6)
        ElseIf reallen<32 Then
                bitstr2utf8bitstr="1111110"+Left(Right(bitstr,26),1)  +"10"+left(Right(bitstr,30),6)+"10"+left(Right(bitstr,24),6)+"10"+left(Right(bitstr,18),6)+"10"+left(Right(bitstr,12),6)+"10"+Right(bitstr,6)
        End if
	End Function
	private Function utf8bitstr2utf8str(str)
		Dim bit2str,l,n
        bit2str=""
        L = Len(str)/4
        For n=1 to L
                bit2str=bit2str+bit2hex(Mid(str,(n-1)*4+1,4))
        Next
        utf8bitstr2utf8str=bit2str
	End Function
end class
%>