ASP/VBScript通过飞信实现发送短信和短消息功能(Fetion SMS)

!本文可能 超过1年没有更新,今后内容也许不会被维护或者支持,部分内容可能具有时效性,涉及技术细节或者软件使用方面,本人不保证相应的兼容和可操作性。

前一段时间正好对电脑发送短信比较感兴趣,因为自己那款老掉牙的手机慢慢的输入文字再群发确实很不方便,于是想移动有没有开放短信接口什么的,上网搜索了有关短信发送的相关知识,找到了Demon的这篇关于《VBS短信飞信发送类(VBSFetion)》,原来是利用了移动的WAP飞信,然后模拟POST,实现短信或者飞信的发送,优点是发送免费,唯一遗憾的是貌似只能发给自己或者飞信好友。不过发送给自己倒是个不错的功能,可以实现一些监控报警类的功能。其实139邮箱那个短信发送到是可以发给任何人,只不过是按正常短信收费标准进行收费,而且主显号码是在你原先的号码上附加了一串长号,这点有点不爽。鉴于Demon在这一方面已经先行一步,我就利用其算法,改造了自己的一个VBScript类实现。

不过值得注意的是,所有POST或者GET发送的消息需要进行编码处理,在ASP中这点还是比较容易的,直接Server.URLEncode就可以了,但是在本机脚本WScript环境下却要费一番周折。网上查找了一下资料,这次仍然找到了Demon的解决方案《用VBS实现PHP的urlencode函数》。好了,基本上解码就分为ANSI版和UTF-8版,我将其改写如下:

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
Class UriParser
  Private Function isUpper(c)
    isUpper = CBool( Asc(c) >= Asc("A") _
      And Asc(c) <= Asc("Z") )
  End Function
 
  Private Function isLower(c)
    isLower = CBool( Asc(c) >= Asc("a") _
      And Asc(c) <= Asc("z") )
  End Function
 
  Private Function isAlpha(c)
    isAlpha = CBool(isUpper(c) Or isLower(c))
  End Function
 
  Private Function isSpace(c)
    isSpace = CBool(Asc(c) = Asc(" "))
  End Function
 
  ' // Thanks Demon
  ' // See http://demon.tw/programming/vbs-php-urlencode.html
  Public Function encode(str, charset)
    Dim i,c
    For i = 1 To Len(str)
      c = Mid(str, i, 1)
      If isAlpha(c) Or c = "-" Or c = "_" Or c = "." Then
        encode = encode & c
      ElseIf isSpace(c) Then
        encode = encode & "+"
      Else
        If UCase(charset) = "UTF-8" Then
           Dim s : s = c
           c = "&H" & Hex(AscW(c))
           If c >= &H0001 And c <= &H007F Then
            encode = encode & s
           ElseIf c > &H07FF Then
            encode = encode & "%" & _
              Hex(&HE0 Or (c\(2^12) And &H0F))
            encode = encode & "%" & _
              Hex(&H80 Or (c\(2^6) And &H3F))
            encode = encode & "%" & _
              Hex(&H80 Or (c\(2^0) And &H3F))
          Else
            encode = encode & "%" & _
              Hex(&HC0 Or (c\(2^6) And &H1F))
            encode = encode & "%" & _
              Hex(&H80 Or (c\(2^0) And &H3F))
          End If
        Else
           c = Asc(c)
           encode = encode & "%" & Left(Hex(c),2)
           encode = encode & "%" & Right(Hex(c),2)
        End If
      End If
    Next
  End Function
End Class

核心函数参考了Demon的实现,除了需要编码的str参数外,附加了以什么编码方式编码的charset参数。也就是说我们在实现模拟浏览器POST消息给WAP飞信时需要确定其传输的编码,当然我们可以用手机模拟器试着登录并抓取header得到编码后硬编码进我们的脚本里,在这里我试着在初始化时GET一次WAP飞信的首页,然后再提取出其编码方式,这个编码方式然后提供给接下来的消息传输编码用。好了,说了这么多,先把我的代码实现展示出来吧:

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
' // Author: WangYe
' // Site: //wangye.org
' // Thanks Demon
' // See http://demon.tw/my-work/vbsfetion.html
Class FetionMessager
  Private BASE_URI
  Private INDEX_DIR
  Private LOGIN_SUBMIT_DIR
  Private LOGOUT_SUBMIT_DIR
  Private SMS_SUBMIT_DIR
  Private FETION_SUBMIT_DIR
  Private FETION_MYSELF_SUBMIT_DIR
  Private SEARCH_SUBMIT_DIR
  Private GPRS_WAP_IPADDR
 
  Private request_devid
  Private http
  Private content_charset
  Private regex
 
  Private status_code
  Private status_message
  Private error_occured
 
  Private Sub Class_Initialize()
    BASE_URI = "http://f.10086.cn"
    INDEX_DIR = "/im/index/indexcenter.action"
    LOGIN_SUBMIT_DIR = "/im/login/inputpasssubmit1.action"
    LOGOUT_SUBMIT_DIR = "/im/index/logoutsubmit.action"
    FETION_SUBMIT_DIR = "/im/chat/sendMsg.action"
    FETION_MYSELF_SUBMIT_DIR = "/im/user/sendMsgToMyselfs.action"
    SMS_SUBMIT_DIR = "/im/chat/sendShortMsg.action"
    SEARCH_SUBMIT_DIR = "/im/index/searchOtherInfoList.action"
    GPRS_WAP_IPADDR = "10.0.0.172"
 
    status_code = 0
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set regex = New RegExp
  End Sub
 
  Private Sub Class_Terminate()
    Set regex = Nothing
    Set http = Nothing
  End Sub
 
  Private Function encodeURI(str)
    Dim uri
    Set uri = New UriParser
    encodeURI = uri.encode(str, getContentCharset())
    Set uri = Nothing
  End Function
 
  Private Function buildLoginParameters(mobile, password, status)
    buildLoginParameters = "m=" & encodeURI(mobile) & _
      "&pass=" & encodeURI(password) & "&loginstatus=" & status
  End Function
 
  Private Function buildMessageParameters(msg)
    buildMessageParameters = "msg=" & encodeURI(msg)
  End Function
 
  Private Function buildUserIdParameters(uid)
    buildUserIdParameters = "touserid=" & encodeURI(uid)
  End Function
 
  Private Function buildSearchTextParameters(text)
    buildSearchTextParameters = "searchText=" & encodeURI(text)
  End Function
 
  Private Function buildUrl(url, param)
    buildUrl = url & "?" & param
  End Function
 
  Private Function request(ByVal url, data, method)
    method = UCase(method)
    url = BASE_URI & url
    http.open method, url, False
    http.setRequestHeader "Accept", _
      "text/xml,application/xml,application/xhtml+xml," & _
      "text/html;q=0.9,text/plain;q=0.8,text/vnd.wap.wml,image/png," &_
      "application/java-archive,application/java,application/x-java-archive," &_
      "text/vnd.sun.j2me.app-descriptor,application/vnd.oma.drm.message," &_
      "application/vnd.oma.drm.content,application/vnd.oma.dd+xml," &_
      "application/vnd.oma.drm.rights+xml,application/vnd.oma.drm.rights+wbxml," &_
      "application/x-nokia-widget,text/x-opml,*/*;q=0.5"
 
    http.setRequestHeader "User-Agent", _
      "Mozilla/5.0 (SymbianOS/9.4; U; Series60/5.0 " &_
      "Nokia5800d-1/52.50.2008.37; Profile/MIDP-2.1 Configuration/CLDC-1.1 ) " &_
      "AppleWebKit/413 (KHTML, like Gecko) Safari/413"
 
    http.setRequestHeader "X-Forwarded-For", GPRS_WAP_IPADDR
    http.setRequestHeader "Forwarded-For", GPRS_WAP_IPADDR
    http.setRequestHeader "Client_IP", GPRS_WAP_IPADDR
    http.setRequestHeader "Client-IP", GPRS_WAP_IPADDR
    http.setRequestHeader "VIA", GPRS_WAP_IPADDR
    http.setRequestHeader "REMOTE_ADDR", GPRS_WAP_IPADDR
    http.setRequestHeader "REMOTE-ADDR", GPRS_WAP_IPADDR
    http.setRequestHeader "X-Nokia-MusicShop-Bearer", "GPRS/3G"
    http.setRequestHeader "X-Nokia-MusicShop-Version", "11.0842.9"
    http.setRequestHeader "X-Wap-Profile", _
      "http://nds1.nds.nokia.com/uaprof/Nokia5800d-1r100-3G.xml"
    http.setRequestHeader "X-Online-Host", _
      Replace(Replace(BASE_URI, "http://", ""), "https://", "")
 
    If Not IsEmpty(request_devid) Then
      http.setRequestHeader "x-up-calling-line-id", request_devid
      http.setRequestHeader "X-Up-subno", request_devid
    End If
 
    If method = "POST" Then
      http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      http.setRequestHeader "Referer", BASE_URI & INDEX_DIR
      http.send data
    Else
      http.send
    End If
    request = http.responseText
  End Function
 
  Private Function post(url, data)
    post = request(url, data, "POST")
  End Function
 
  Private Function getContentCharset()
    If IsEmpty(content_charset) Then
      Dim contentType
      Call request(INDEX_DIR, Null, "GET")
      contentType = http.getResponseHeader("Content-Type")
      regex.IgnoreCase = True
      regex.Global = False
      regex.Pattern = "^[\w\/\.]+; charset=(.+)$"
      If regex.Test(contentType) Then
         Dim matches
         Set matches = regex.Execute(contentType)
         content_charset = matches.Item(0).Submatches(0)
         Set matches = Nothing
      End If
    End If
    If IsEmpty(content_charset) Then content_charset = "UTF-8"
    getContentCharset = content_charset
  End Function
 
  Private Function parseLoginMessage(str)
    On Error Resume Next
    error_occured = False
 
    Dim login_status, login_message
    regex.IgnoreCase = True
    regex.Global = True
    regex.Pattern = "ontimer\=[""']" & _
      Replace(Replace(Replace(BASE_URI & INDEX_DIR, "/", "\/"), ".", "\."), ":", "\:")
    ' Succeeded
    If regex.Test(str) Then
      login_status = True
    Else
      regex.Pattern = "ontimer\=[""']" & _
        Replace(Replace(INDEX_DIR, "/", "\/"), ".", "\.")
      login_status = regex.Test(str)
      ' ontimer="/im/login/login.action
      ' login_status = False
    End If
    regex.Pattern = "timer value\=[""']\d+[""'] *\/>\s*<p>\s*(.+?[^<\s])\s*[^<]<br"
    If regex.Test(str) Then
      Dim matches
      Set matches = regex.Execute(str)
      login_message = matches.Item(0).Submatches(0)
      Set matches = Nothing
    End If
    If Err.Number<>0 Then
      login_status = Err.Number
      login_message = Err.Description
      error_occured = True
      Err.Clear
    End If
    parseLoginMessage = Array(login_status, login_message)
  End Function
 
  Private Function parseLogoutMessage(str)
    On Error Resume Next
    error_occured = False
 
    Dim logout_status, logout_message
 
    regex.IgnoreCase = True
    regex.Global = True
    regex.Pattern = "<card id\=""start"" title\="".+[^""]"">\s*<p>\s*<img"
    logout_status = regex.Test(str)
    If Not logout_status Then
      regex.Pattern = _
        "<card id\=""start"" title\="".+[^""]"">\s*<p>\s*(.+?[^<\/\\\s])\s*<br"
      logout_status = regex.Test(str)
      If logout_status Then
        Dim matches
        Set matches = regex.Execute(str)
        logout_message = matches.Item(0).Submatches(0)
        Set matches = Nothing
      End If
    Else
      logout_status = False
    End If
    If Err.Number<>0 Then
      logout_status = Err.Number
      logout_message = Err.Description
      error_occured = True
      Err.Clear
    End If
    parseLogoutMessage = Array(logout_status, logout_message)
  End Function
 
  Private Function parseSendMessage(str)
    On Error Resume Next
    error_occured = False
 
    Dim send_status, send_message
    regex.IgnoreCase = True
    regex.Global = True
    regex.Pattern = "<card id\=""start"" title\=""(.+?[^""' ])"""
    send_status = regex.Test(str)
    If send_status Then
      Dim matches
      Set matches = regex.Execute(str)
      send_message = matches.Item(0).Submatches(0)
      ' send_message = "发送成功" Or send_message = "消息会话提示"
      ' fix Chinese characters in some platform
      If StrEqual(send_message, Array(21457, -28671, 25104, 21151)) Or _
         StrEqual(send_message, Array(28040, 24687, 20250, -29731, 25552, 31034)) Or _
         StrEqual(send_message, Array(28040, 24687, 20250, -29731)) Then
        send_status = True
      Else
        send_status = False
      End If
      Set matches = Nothing
      regex.Pattern = _
        "timer value\=[""']\d+[""'] *\/>\s*<p>\s*(.+?[^<\s\/])\s*[^<]<br"
      If regex.Test(str) Then
        Set matches = regex.Execute(str)
        send_message = matches.Item(0).Submatches(0)
        Set matches = Nothing
      End If
    End If
 
    If Err.Number<>0 Then
      send_status = Err.Number
      send_message = Err.Description
      error_occured = True
      Err.Clear
    End If
    parseSendMessage = Array(send_status, send_message)
  End Function
 
  Private Function convertPhoneNumberToUserId(mobile)
    convertPhoneNumberToUserId = -1
    Dim content
    content = post(SEARCH_SUBMIT_DIR, _
      buildSearchTextParameters(mobile))
    If http.status = 200 Then
      regex.IgnoreCase = True
      regex.Global = True
      regex.Pattern = "/toinputMsg\.action\?touserid=(\d+)"
      If regex.Test(content) Then
        Dim matches
        Set matches = regex.Execute(content)
        convertPhoneNumberToUserId = matches.Item(0).Submatches(0)
        Set matches = Nothing
      End If
    End If
  End Function
 
  Private Function StrEqual(str, arr)
    StrEqual = False
    If Len(str)<>(Ubound(arr)+1) Then
      Exit Function
    End If
    Dim i, n
    For i = 1 To Len(str)
      n = AscW(Mid(str, i, 1))
      If n<>arr(i-1) Then Exit Function
    Next
    StrEqual = True
  End Function
 
  ' 检查手机号码是否规范
  ' mobile : 要检查的手机号码
  Public Function isMobilePhoneNumberValid(mobile)
    regex.IgnoreCase = True
    regex.Global = False
    regex.Pattern = "^1[3|4|5|8]\d{9}$"
    isMobilePhoneNumberValid = regex.Test(mobile)
  End Function
 
  ' 状态代码,0表示成功
  Public Property Get StatusCode()
    StatusCode = status_code
  End Property
 
  ' 状态消息
  Public Property Get StatusMessage()
    StatusMessage = status_message
  End Property
 
  ' 是否发生错误
  Public Function hasErrorOccured()
    hasErrorOccured = error_occured
  End Function
 
  ' 登录飞信
  ' mobile : 手机号码账户
  ' password : 登录密码
  ' loginstatus : 登录状态(1 在线,2 忙碌,3 离开,4 隐身)
  Public Function login(mobile, password, loginstatus)
    request_devid = mobile
    login = False
    Dim content
    content = post(LOGIN_SUBMIT_DIR, _
      buildLoginParameters(mobile, password, loginstatus))
    If http.status<>200 Then
      Exit Function
    End If
 
    Dim status
    status = parseLoginMessage(content)
    login = status(0)
 
    If Not login Then
      status_code = 1
    Else
      status_code = 0
    End If
    status_message = status(1)
  End Function
 
  ' 登出
  Public Function logout()
    logout = False
 
    Dim content
    content = post(LOGOUT_SUBMIT_DIR, "")
    If http.status<>200 Then
      Exit Function
    End If
 
    Dim status
    status = parseLogoutMessage(content)
    logout = status(0)
 
    If Not logout Then
      status_code = 2
    Else
      status_code = 0
    End If
    status_message = status(1)
  End Function
 
  ' 发送短信
  ' msg : 短信文本
  ' mobile : 接收方手机号码
  Public Function sendSMS(msg, mobile)
    sendSMS = False
    Dim uid, url
    uid = convertPhoneNumberToUserId(mobile)
    If uid=-1 Then : status_code = 3 : Exit Function
 
    url = buildUrl(SMS_SUBMIT_DIR, buildUserIdParameters(uid))
    Dim content
    content = post(url, buildMessageParameters(msg))
    Dim status
    status = parseSendMessage(content)
    sendSMS = status(0)
 
    If Not sendSMS Then
      status_code = 4
    Else
      status_code = 0
    End If
    status_message = status(1)
  End Function
 
  ' 发送消息
  ' msg : 消息文本
  ' mobile : 接收方手机号码
  Public Function sendMessage(msg, mobile)
    sendMessage = False
    Dim uid, url
    uid = convertPhoneNumberToUserId(mobile)
    If uid=-1 Then : status_code = 3 : Exit Function
 
    url = buildUrl(FETION_SUBMIT_DIR, buildUserIdParameters(uid))
    Dim content
    content = post(url, buildMessageParameters(msg))
    Dim status
    status = parseSendMessage(content)
    sendMessage = status(0)
 
    If Not sendMessage Then
      status_code = 4
    Else
      status_code = 0
    End If
    status_message = status(1)
  End Function
 
  ' 给自己发消息
  ' msg : 消息文本
  Public Function sendMessageToOwn(msg)
    Dim content
    content = post(FETION_MYSELF_SUBMIT_DIR, buildMessageParameters(msg))
 
    Dim status
    status = parseSendMessage(content)
    sendMessageToOwn = status(0)
 
    If Not sendMessageToOwn Then
      status_code = 4
    Else
      status_code = 0
    End If
    status_message = status(1)
  End Function
End Class

在上述代码中,我对于WAP飞信返回的消息进行正则匹配和处理,基本上能够提取到WAP飞信返回的消息StatusMessage以及是否成功的状态码StatusCode。其中上述代码的核心部分则是伪造手机访问的请求方法request。并且对于来源IP也进行了伪造,来源IP定义于GPRS_WAP_IPADDR变量中,上网查询得知移动WAP网关代理IP是10.0.0.172。不过貌似单纯这样伪造,依旧被WAP飞信判断为来源于CMNET,不过不影响使用吧。关于这段代码可以这样使用:

Function DisplayStatus(obj)
  WScript.Echo "Code : " & obj.StatusCode & vbCrLf & _
	"MSG:" & objStatusMessage
End Function
 
Dim objFetionMsgr
Set objFetionMsgr = New FetionMessager
 
If objFetionMsgr.login("13800000000", "123456", 4) Then
  DisplayStatus objFetionMsgr
 
  objFetionMsgr.sendMessageToOwn "Message to me"
  DisplayStatus objFetionMsgr
 
  objFetionMsgr.sendMessage "Message to other", "13000000000"
  DisplayStatus objFetionMsgr
 
  objFetionMsgr.sendSMS "SMS to other", "13000000000"
  DisplayStatus objFetionMsgr
 
  objFetionMsgr.logout
  DisplayStatus objFetionMsgr
 
Else
  DisplayStatus objFetionMsgr
End If
Set objFetionMsgr = Nothing

下一篇文章将给大家介绍命令行完全使用的版本,敬请期待:-)

若无特别说明,本网站文章均为原创,原则上这些文章不允许转载,但是如果阁下是出于研究学习目的可以转载到阁下的个人博客或者主页,转载遵循创作共同性“署名-非商业性使用-相同方式共享”原则,请转载时注明作者出处谢绝商业性、非署名、采集站、垃圾站或者纯粹为了流量的转载。谢谢合作!

    • 呵呵,可能考虑多了,比较长的还是模拟手机发送header的部分,现在唯一担心的就是怕WAP飞信改版,要不那些处理消息的正则就全部废了。

    • 不需要安装飞信啊,这个是模拟登录WAP飞信的,和飞信客户端无关,能上网基本就可以了,但是接收方必须是你的飞信好友。

请稍后...

发表评论

电子邮件地址不会被公开。 必填项已用*标注

*