formsms.frm

短信通用接口

VERSION 5.00
Begin VB.Form FormSMS 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "短信群发 支持上行 通道与非通道 QQ:8135666"
   ClientHeight    =   4725
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8160
   Icon            =   "FormSMS.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4725
   ScaleWidth      =   8160
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text1 
      Height          =   1095
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   11
      Text            =   "FormSMS.frx":0E42
      Top             =   3600
      Width           =   7935
   End
   Begin VB.TextBox textMobile 
      Height          =   375
      Left            =   960
      TabIndex        =   10
      Top             =   600
      Width           =   7095
   End
   Begin VB.TextBox textUserName 
      Height          =   375
      Left            =   960
      TabIndex        =   4
      Text            =   "fujian"
      Top             =   120
      Width           =   1935
   End
   Begin VB.TextBox textUserPass 
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Text            =   "123456"
      Top             =   120
      Width           =   1935
   End
   Begin VB.TextBox textText 
      Height          =   1935
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   1560
      Width           =   7935
   End
   Begin VB.CommandButton cmdSendSMS 
      Caption         =   "发送"
      Height          =   375
      Left            =   6120
      TabIndex        =   1
      Top             =   1150
      Width           =   1935
   End
   Begin VB.CommandButton cmdQueryAccount 
      Caption         =   "查询余额"
      Height          =   375
      Left            =   6120
      TabIndex        =   0
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label Label1 
      Caption         =   "短信账号"
      Height          =   255
      Left            =   120
      TabIndex        =   9
      Top             =   240
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "验证密码"
      Height          =   255
      Left            =   3120
      TabIndex        =   8
      Top             =   240
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "手机号码"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   720
      Width           =   1335
   End
   Begin VB.Label Label4 
      Caption         =   "短信内容"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   1320
      Width           =   1335
   End
   Begin VB.Label lbPrompt 
      Alignment       =   2  'Center
      BackColor       =   &H80000018&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "字数: 0 / 70"
      Height          =   255
      Left            =   4000
      TabIndex        =   5
      Top             =   1250
      Width           =   2055
   End
End
Attribute VB_Name = "FormSMS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Declare Function wtsmsOpen Lib "smsapi.dll" (ByVal lpServer As String, ByVal lpUser As String, ByVal lpPass As String) As Long
Private Declare Function wtsmsClose Lib "smsapi.dll" (ByVal hSession As Long) As Long
Private Declare Function wtsmsSend Lib "smsapi.dll" (ByVal hSession As Long, lpMobile As String, ByVal lpText As String, ByVal dwContext As Long) As Long
Private Declare Function wtsmsQueryAccount Lib "smsapi.dll" (ByVal hSession As Long) As Long
Private Declare Function wtsmsGetErrorText Lib "smsapi.dll" (ByVal hSession As Long) As String
Dim MobNum As String



Private Sub cmdQueryAccount_Click()
On Error GoTo SMSERR:
    Dim strUser As String, strPass As String, hSession As Long, strServer As String, strError As String, rc As Long

    strUser = textUserName.Text
    If (Len(strUser) = 0) Then
        MsgBox ("请输入短信账号")
        Exit Sub
    End If

    strPass = textUserPass.Text
    If (Len(strPass) = 0) Then
        MsgBox ("请输入密码")
        Exit Sub
    End If

    strServer = "http://www.waytide.com/cgi/sms81/"

    hSession = wtsmsOpen(strServer, strUser, strPass)
    If (hSession = 0) Then
        MsgBox ("无法打开短信接口")
        Exit Sub
    End If

    Screen.MousePointer = vbHourglass
    rc = wtsmsQueryAccount(hSession)
    Screen.MousePointer = 0

    If (rc < 1) Then
        strError = wtsmsGetErrorText(hSession)
        MsgBox (strError)
        wtsmsClose (hSession)
        Exit Sub
    End If

    wtsmsClose (hSession)

    MsgBox ("剩余短信量:" & rc)
    Exit Sub
SMSERR: MsgBox "出错"
End Sub

Private Sub cmdSendSMS_Click()
    If InStr(textMobile, ";") > 0 Then
        Dim iNum() As String, i As Integer
        iNum = Split(textMobile, ";")
        For i = LBound(iNum) To UBound(iNum) - 1
            MobNum = iNum(i)
            Call SendSMS
        Next i
    Else
        MobNum = textMobile
        Call SendSMS
    End If
End Sub


Private Sub SendSMS()
    Dim strUser As String, strPass As String, hSession As Long, strServer As String, strError As String, rc As Long

    strUser = textUserName.Text
    If (Len(strUser) = 0) Then
        MsgBox ("请输入短信账号")
        Exit Sub
    End If

    strPass = textUserPass.Text
    If (Len(strPass) = 0) Then
        MsgBox ("请输入密码")
        Exit Sub
    End If

    strServer = "http://www.waytide.com/cgi/sms81/"

    'hSession = wtsmsOpen(strServer, strUser, strPass)
    'If (hSession = 0) Then
    '    MsgBox ("无法打开短信接口")
    '    Exit Sub
    'End If


    If Len(MobNum) <> 11 Then
        Text1.Text = "号码长度不符," & MobNum & "的短信不予发送!" & vbNewLine & Text1.Text
        Exit Sub
    End If
    
    
    If Left(MobNum, 2) <> "13" And Left(MobNum, 2) <> "15" Then
        Text1.Text = "手机号码规格不对," & MobNum & "的短信不予发送!" & vbNewLine & Text1.Text
        Exit Sub
    End If

    'Screen.MousePointer = vbHourglass
    'rc = wtsmsSend(hSession, MobNum, textText.Text, 0)
    'Screen.MousePointer = 0

    If (rc < 1) Then
        'strError = wtsmsGetErrorText(hSession)
        Text1.Text = "发送失败,错误信息:" & strError & vbNewLine & Text1.Text
        'wtsmsClose (hSession)
        Exit Sub
    End If

    wtsmsClose (hSession)
    Text1.Text = "号码是:" & MobNum & "的短信发送成功!" & vbNewLine & Text1.Text
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If FormSMS.Visible = True Then
        Cancel = 1
        FormSMS.Visible = False
        textMobile.Text = ""
        Text1.Text = ""
    End If
End Sub


Private Sub textText_Change()
    lbPrompt.Caption = "字数: " & Len(textText.Text) & " / 70"
End Sub