form7.frm

一个用于免费发短信的程序

VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form Form1 
   Caption         =   "短消息发送(130)"
   ClientHeight    =   3390
   ClientLeft      =   3870
   ClientTop       =   3015
   ClientWidth     =   5055
   Icon            =   "Form7.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3390
   ScaleWidth      =   5055
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "Form7.frx":0ECA
      Left            =   4080
      List            =   "Form7.frx":0ED4
      TabIndex        =   7
      Top             =   225
      Width           =   735
   End
   Begin VB.TextBox Text3 
      Height          =   270
      Left            =   3480
      TabIndex        =   6
      Top             =   225
      Width           =   495
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00C0FFFF&
      Caption         =   "发 送"
      Height          =   495
      Left            =   1680
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2760
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      Height          =   2055
      Left            =   1080
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   600
      Width           =   3735
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1080
      TabIndex        =   1
      Text            =   "130"
      Top             =   225
      Width           =   1695
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   240
      Top             =   1440
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin VB.Label Label5 
      Caption         =   "Email:"
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   3000
      TabIndex        =   9
      Top             =   2880
      Width           =   495
   End
   Begin VB.Label Label4 
      Caption         =   "[e-mail]"
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   3600
      MouseIcon       =   "Form7.frx":0EE4
      MousePointer    =   99  'Custom
      TabIndex        =   8
      Top             =   2880
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "签名："
      Height          =   255
      Left            =   2880
      TabIndex        =   5
      Top             =   260
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "内    容："
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "手机号码："
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   260
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long


Private Sub Command1_Click()
    my0 = Combo1.Text
    If my0 = "先生" Then my00 = "0"
    If my0 = "小姐" Then my00 = "1"
    my1 = Text1.Text
    n1 = lstrlen(my1 + Chr(0))
    my2 = Text2.Text
    n2 = lstrlen(my2 + Chr(0))
    my3 = Text3.Text
    
    
    If my1 = "" Or my2 = "" Or my3 = "" Or n1 < 10 Then
        MsgBox "没填写完整或填写有误！", vbExclamation, "出错"
    ElseIf Left(my1, 3) <> "130" Or n2 > 100 Then
        MsgBox "只能发130短信息，且发送内容不超过50个中文", vbExclamation, "出错"
    Else
        Command1.Enabled = False
        Form1.Caption = "连接中...."
        Inet1.Protocol = icHTTP
        Inet1.Execute "http://sms.szunicom.com/cgi-bin/tims/webgsm?gsm_no=" & my1 & "&mobile_type=C&firstname=" & my3 & "&title=" & my00 & "&message=" & my2, "get"
    End If
End Sub

Private Sub Form_Load()
    Combo1.ListIndex = 0
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)

     Select Case State
     Case icHostResolvingHost
     Form1.Caption = "连接中...."
     Case icConnecting
     Form1.Caption = "连接中...."
     Case icError
     MsgBox "连接出错:无法连结", vbExclamation, "出错"
     Form1.Caption = "短消息发送(130)"
     Text1.Text = ""
     Text2.Text = ""
     Text3.Text = ""
     Command1.Enabled = True
     
     Case icResponseCompleted
     Form1.Caption = "短消息发送(130)"
     MsgBox "短消息发送成功!", vbExclamation, "恭喜!"
     Command1.Enabled = True
     Text1.Text = ""
     Text2.Text = ""
     Text3.Text = ""
     End Select
     
    
    End Sub


Private Sub Label4_Click()
    Dim HyperJump
    Dim w
    w = "mailto:" & Label4.Caption
    HyperJump = ShellExecute(0&, vbNullString, w, vbNullString, vbNullString, vbNormalFocus)
End Sub