标题: VBS短信飞信发送类(VBSFetion)
作者: Demon
链接: https://demon.tw/my-work/vbsfetion.html
版权: 本博客的所有文章,都遵守“署名-非商业性使用-相同方式共享 2.5 中国大陆”协议条款。
本来想把昨天《用VBS发送短信(飞信)》里的 VBS 程序改写成 PHP 的,不过为了不重复造轮子,事先 Google 了一下,发现已经有人实现了,详见PHP飞信发送类(PHPFetion)v1.2发布。好吧,既然已经有人把它封装成 PHP 类了,我就封装一个 VBS 类吧。
Class VBSFetion Private [$mobile], [$password], http 'Author: Demon 'Website: https://demon.tw 'Date: 2011/6/11 '初始化事件 Private Sub Class_Initialize Set http = CreateObject("Msxml2.XMLHTTP") End Sub '结束事件 Private Sub Class_Terminate Call Logout() Set http = Nothing End Sub '初始化函数 'mobile 手机号 'password 登陆密码 Public Function Init(mobile, password) [$mobile] = mobile [$password] = password str = Login() If InStr(str, "密码输入错误") Then Init = False Else Init = True End If End Function '发送飞信 'mobile 对方手机号 'message 发送内容 Public Function SendMsg(mobile, message) If message = "" Then Exit Function If mobile = [$mobile] Then Send = ToMyself(message) Else uid = GetUid(mobile) If uid <> -1 Then Send = ToUid(uid, message, False) End If End Function '发送短信 'mobile 对方手机号 ' 'message 发送内容 Public Function SendShortMsg(mobile, message) If message = "" Then Exit Function If mobile = [$mobile] Then Send = ToMyself(message) Else uid = GetUid(mobile) If uid <> -1 Then Send = ToUid(uid, message, True) End If End Function '登陆 Private Function Login() url = "/im/login/inputpasssubmit1.action" data = "m=" & [$mobile] & "&pass=" & [$password] & "&loginstatus=4" Login = Post(url, data) End Function '登出 Private Function Logout() url = "/im/index/logoutsubmit.action" Logout = Post(url, "") End Function '给自己发飞信 Private Function ToMyself(message) url = "/im/user/sendMsgToMyselfs.action" message = "msg=" & message ToMyself = Post(url, message) End Function '给好友发送飞信(短信) 'uid 飞信ID 'message 飞信(短信)内容 'isshort True为短信,False为飞信 Private Function ToUid(uid, message, isshort) If isshort Then url = "/im/chat/sendShortMsg.action?touserid=" & uid data = "msg=" & message Else url = "/im/chat/sendMsg.action?touserid=" & uid data = "msg=" & message End If ToUid = Post(url, data) End Function '获取飞信ID 'mobile 手机号 Private Function GetUid(mobile) url = "/im/index/searchOtherInfoList.action" data = "searchText=" & mobile str = Post(url, data) Set re = New RegExp re.Pattern = "/toinputMsg\.action\?touserid=(\d+)" If re.Test(str) Then Set ms = re.Execute(str) GetUid = ms.Item(0).Submatches(0) Else GetUid = -1 End If End Function '发送HTTP POST请求 Private Function Post(url, data) url = "http://f.10086.cn" & url http.open "POST", url, False http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" http.send data Post = http.responseText End Function End Class
示例程序:
赞赏'初始对象 Set fetion = New VBSFetion '登陆飞信 If fetion.Init("11122223333", "123456") Then '发送飞信 fetion.SendMsg "44455556666", "Hello world" '发送短信 fetion.SendShortMsg "77788889999", "Hello world" End If
微信赞赏支付宝赞赏
随机文章:
貌似不可以。WAP飞信页面总是提示“密码输入错误”,Init时就通不过。
Sorry,my fault. I forgot my fetion password, so I had to download fetion client software and install it to access the “forget your password” web page. Fortunately I got a “SMS password” to have the permission to login my fetion account. But I was not told that the “SMS password” is not equal to my fetion account password,and the VBScript that you coded above ran incorrectly.Now I add the fetion class to my VBscript of weather forecast to the specified cellphone at the specified time. The next step what I wanna do is to periodically send daily English idioms to my cellphone. All these is due to your talent and diligence. Thank you. I have to admit you are really a genius, even you will not become an attorney. Keep working hard, GO!!!
转为VBA代码时,仅可以向自己的手机号发送短信成功,但是研究了好久没有看懂如何发短信或飞信到接收方的调用方法,麻烦Demon先生能否直接将代码公布,感谢期候您的回复,请帮忙解决,再次感谢!!
眼花了?前天来看到评论一段加好友的代码消失了…
Public Function AddFris(nick, name, mobile) '添加好友
url = "/im/user/insertfriendsubmit.action"
data = "&nickname=" & nick & "&localName=" & name & "&number=" & mobile & "&buddylist=2&type=0"
temp = Post(url, data)
Set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern = "([^\x00-\xff]{8,})"
If re.Test(temp) Then
Set ms = re.Execute(temp)
AddFris = ms.Item(0).Submatches(0)
End If
End Function
你做的工作很好,交个朋友怎么样,我Q:597479852,或者告诉我一下你的联系方式,我加你也好,期待!
能不能增加获取飞信好友列表的功能啊?
改成asp的程序后就出错,我查了一下好像出在cookie上面,http.getAllResponseHeaders取值中无cookie,那个php没任何问题,实在不清楚怎么处理,一发消息就非wap登录方式,consam出手解决一下吧。
改成ASP在本地测试可以,上传到新网空间就不行了.
能加入收短信功能吗?