如何用VB程序登录一sms(如sms.163.com)网站,然后可以根据其登录帐号发送短信

[Wst0r]

如何用VB程序登录一sms(如sms.163.com)网站,然后可以根据其登录帐号发送短信!

[qqqdong]

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "新浪短信息"
ClientHeight = 5160
ClientLeft = 45
ClientTop = 330
ClientWidth = 4860
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5160
ScaleWidth = 4860
StartUpPosition = 3 '窗口缺省
Begin MSWinsockLib.Winsock Winsock1
Left = 2280
Top = 2280
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox Text5
Height = 1695
Left = 120
MultiLine = -1 'True
TabIndex = 10
Top = 2400
Width = 4575
End
Begin VB.TextBox Text4
Height = 270
Left = 2160
TabIndex = 7
Top = 1680
Width = 2535
End
Begin VB.TextBox Text3
Height = 270
IMEMode = 3 'DISABLE
Left = 2160
PasswordChar = "*"
TabIndex = 5
Top = 1200
Width = 2535
End
Begin VB.TextBox Text2
Height = 270
Left = 2160
TabIndex = 3
Top = 720
Width = 2535
End
Begin VB.CommandButton Command1
Caption = "发送"
Height = 375
Left = 3240
TabIndex = 2
Top = 4320
Width = 1095
End
Begin VB.TextBox Text1
Height = 270
Left = 2160
TabIndex = 1
Top = 240
Width = 2535
End
Begin VB.Label Label6
BorderStyle = 1 'Fixed Single
Caption = " 状态："
Height = 255
Left = 0
TabIndex = 11
Top = 4920
Width = 4815
End
Begin VB.Label Label5
Caption = "发送内容[最多60字]"
Height = 255
Left = 120
TabIndex = 9
Top = 2040
Width = 2055
End
Begin VB.Label Label4
Caption = "您的签名："
Height = 255
Left = 120
TabIndex = 8
Top = 1680
Width = 1695
End
Begin VB.Label Label3
Caption = "您在新浪上的密码："
Height = 255
Left = 120
TabIndex = 6
Top = 1200
Width = 1935
End
Begin VB.Label Label2
Caption = "您的手机号码："
Height = 255
Left = 120
TabIndex = 4
Top = 720
Width = 1815
End
Begin VB.Label Label1
Caption = "对方手机号[最多2个]之间用半角逗号分隔"
Height = 375
Left = 120
TabIndex = 0
Top = 240
Width = 1935
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim remMSG As String

Private Sub Command1_Click()
On Error Resume Next
If Command1.Caption = "取消" Then
Command1.Caption = "发送"
Label6.Caption = " 用户取消"
Winsock1.Close
Exit Sub
End If
Dim msg As String, Length As Integer, msgSend As String
msgSend = "login=1&mobile=" & Text1.Text & "&msg=" & Text5.Text & "&sname=" & Text4.Text & "&user=" & Text2.Text & "&passwd=" & Text3.Text
Length = LenB(StrConv(msgSend, vbFromUnicode))
'MsgBox msgSend, , Length: Exit Sub
msg = msg + "POST /cgi-bin/sms/sendto.cgi HTTP/1.1" + vbCrLf
msg = msg + "Accept: *.*" + vbCrLf
msg = msg + "Accept-Language: zh-cn" + vbCrLf
msg = msg + "Accept-Encoding: gzip , deflate" + vbCrLf
msg = msg + "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)" + vbCrLf
msg = msg + "Host::0" + vbCrLf
msg = msg + "Content-Type: application/x-www-form-urlencoded" + vbCrLf
msg = msg + "Content-Length: " + CStr(Length) + vbCrLf
msg = msg + "Connection: Keep -Alive" + vbCrLf + vbCrLf
msg = msg + msgSend
Winsock1.RemoteHost = "sms.sina.com.cn"
Winsock1.RemotePort = 80
Winsock1.Connect

Label6 = " 正在连接主机..."
Command1.Caption = "取消"
Do While Command1.Caption = "取消" And Winsock1.State <> 7
DoEvents
Loop
'If Command1.Caption = "取消" Then Command1.Caption = "发送" ': Exit Sub
If Winsock1.State = 7 Then
Label6 = " 正在发送短信息..."
Winsock1.SendData msg
DoEvents
End If

End Sub



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Winsock1.GetData strData

remMSG = remMSG + strData
If InStr(1, remMSG, "发送成功") Then
Winsock1.Close
MsgBox "发送成功", vbExclamation
Label6 = " 已经发送成功"
Command1.Caption = "发送"
remMSG = ""
ElseIf InStr(1, remMSG, "注册") Then
Winsock1.Close
MsgBox "您还没有在新浪注册", vbCritical
Label6 = " 没有注册"
Command1.Caption = "发送"
remMSG = ""
ElseIf InStr(1, remMSG, "密码错误") Then
Winsock1.Close
MsgBox "您输入的密码错了", vbCritical
Label6 = " 密码无效"
Command1.Caption = "发送"
remMSG = ""
ElseIf InStr(1, remMSG, "请输入用户或密码") Then
Winsock1.Close
MsgBox "请输入用户或密码", vbCritical
Label6 = " 请输入用户或密码"
Command1.Caption = "发送"
remMSG = ""
ElseIf InStr(1, remMSG, "请输入朋友的手机号") Then
Winsock1.Close
MsgBox "您要发送的手机号错了", vbCritical
Label6 = " 发送手机号错误"
Command1.Caption = "发送"
remMSG = ""
ElseIf InStr(1, remMSG, "请输入要发送的信息") Then
Winsock1.Close
MsgBox "请输入要发送的信息", vbCritical
Label6 = " 发送错误"
Command1.Caption = "发送"
ElseIf InStr(1, remMSG, "对方不是移动全球通用户") Then
Winsock1.Close
MsgBox "对方不是移动全球通用户", vbCritical
Label6 = " 对方不是移动全球通用户"
Command1.Caption = "发送"
' ElseIf InStr(1, remMSG, "错误") Then对方不是移动全球通用户

'Winsock1.Close
' MsgBox "发送错误", vbCritical
' Label6 = " 发送错误"
' Command1.Caption = "发送"
Else
' MsgBox remMSG
' Command1.Caption = "发送"
End If

End Sub

[gang75vb]

xx