1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
<% Sub sendsms(mobile,msg) '多个手机号之间用“,”分隔 dim userid,password,status dim xmlObj,httpsendurl userid = "test" '企业ID,请联系我们索取免费测试帐号 password = "test" 'ID密码,要使用MD5加密为32位密文 password = LCASE(MD5(password)) httpsendurl= "http://www.smsbao.com/sms?u=" &userid& "&p=" &password& "&m=" &mobile& "&c=" &UrlEncode_GBToUtf8_V2(msg) status = Rewrite_XMLget(httpsendurl) response.write msg&" " response.write status End sub '远程获取函数 Function Rewrite_XMLget(SourceUrl) if SourceUrl= "" then Rewrite_XMLget= "路径为空" exit function end if dim Get_Obj1 '远程获取 Set Get_Obj1=Server.CreateObject( "Microsoft.XMLHTTP" ) On Error Resume Next Get_Obj1.Open "GET" ,SourceUrl,False Get_Obj1.send() if Err then set Get_Obj1=nothing Err.Clear Rewrite_XMLget= False set Get_Obj1=nothing exit function End if '转换编码函数 dim Get_Obj2 Set Get_Obj2 = Server.CreateObject( "adodb.stream" ) Get_Obj2.Type = 1 Get_Obj2.Mode =3 Get_Obj2.Open Get_Obj2.Write Get_Obj1.responseBody Get_Obj2.Position = 0 Get_Obj2.Type = 2 '储存数据 Get_Obj2.Charset = "gb2312" ' //转换函数 Rewrite_XMLget = Get_Obj2.ReadText ' 关闭组件 Get_Obj2.Close set Get_Obj2 = nothing set Get_Obj1=nothing End Function Private Function UrlEncode_GBToUtf8_V2(szInput) Dim wch, uch, szRet Dim x Dim nAsc, nAsc2, nAsc3 If szInput = "" Then UrlEncode_GBToUtf8_V2= szInput Exit Function End If For x = 1 To Len(szInput) wch = Mid(szInput, x, 1) nAsc = AscW(wch) If nAsc < 0 Then nAsc = nAsc + 65536 If wch = "+" then szRet = szRet & "%2B" ElseIf wch = "%" then szRet = szRet & "%25" ElseIf (nAsc And &HFF80) = 0 Then szRet = szRet & wch Else If (nAsc And &HF000) = 0 Then uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80) szRet = szRet & uch Else uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _ Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _ Hex(nAsc And &H3F Or &H80) szRet = szRet & uch End If End If Next UrlEncode_GBToUtf8_V2= szRet End Function %> |