frmsendsms.frm

一个采用VB编写的短信发送和接收管理软件。

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form FrmSendSms 
   Caption         =   "短信发送"
   ClientHeight    =   5670
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7320
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   5670
   ScaleWidth      =   7320
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   6000
      Top             =   360
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   375
      Left            =   4680
      TabIndex        =   3
      Top             =   5040
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "发送"
      Default         =   -1  'True
      Height          =   375
      Left            =   480
      TabIndex        =   2
      Top             =   5040
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Height          =   3255
      Left            =   600
      MaxLength       =   60
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   1320
      Width           =   5775
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1920
      MaxLength       =   11
      TabIndex        =   0
      Top             =   360
      Width           =   2655
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   600
      Top             =   120
   End
   Begin MSCommLib.MSComm G18 
      Left            =   0
      Top             =   0
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Label Label3 
      Caption         =   "短信已发出，正在等待状态报告，这需要最多5分钟的时间..."
      Height          =   255
      Left            =   600
      TabIndex        =   6
      Top             =   4680
      Visible         =   0   'False
      Width           =   5055
   End
   Begin VB.Label Label2 
      Caption         =   "输入要发送的中文内容："
      Height          =   255
      Left            =   960
      TabIndex        =   5
      Top             =   960
      Width           =   2175
   End
   Begin VB.Label Label1 
      Caption         =   "手机号："
      Height          =   255
      Left            =   1080
      TabIndex        =   4
      Top             =   480
      Width           =   735
   End
End
Attribute VB_Name = "FrmSendSms"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim sendtime As Date
Dim sendstr As String
Dim handset As String
Dim id As Integer
Dim addtime As Date
Private Sub Command1_Click()
If GetSetting("smssend", "sendopen", "yesno") = "no" Then
 MsgBox "没有打开短信发送接收程序，不能发送短信！", vbInformation + vbOKOnly, "提示"
 Exit Sub
End If
Dim tb_SQ As New ADODB.Recordset
Dim i As Integer
If Trim(Text2.Text) = "" Then
 MsgBox "发送内容不能为空！", vbInformation + vbOKOnly, "提示！"
 Exit Sub
End If
If Trim(Text1.Text) = "" Or Left(Trim(Text1.Text), 2) <> "13" Or IsNumeric(Trim(Text1.Text)) = False Or Len(Trim(Text1.Text)) <> 11 Then
 MsgBox "手机号不是合法的！", vbInformation + vbOKOnly, "提示！"
 Exit Sub
End If
'For i = 0 To Int(Len(Text2.Text) / 60)
   sendtime = Now
   sendstr = Trim(Text2.Text)
   handset = Trim(Text1.Text)
   addtime = Now
   With tb_SQ
     .Open "select*from sendqueue", Cn, adOpenKeyset, adLockPessimistic
     .AddNew
     .Fields!发送内容 = Trim(Text2.Text)
     .Fields!手机号 = Trim(Text1.Text)
     .Fields!发送标志 = "待发"
     .Fields!加入时间 = addtime
     .Update
     .Close
   End With
'Next i
Label3.Visible = True
 Command1.Enabled = False
 Timer2.Enabled = True
End Sub

Private Sub Command2_Click()
Unload Me

End Sub

Private Sub Form_Load()
 Me.Width = 7600
 Me.Height = 6000
End Sub

Private Sub Form_Paint()
On Error Resume Next
Me.Move 0, 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
 Dim tb_SQ As New ADODB.Recordset
 With tb_SQ
  .Open "select*from sendqueue where 发送标志='已发'", Cn, adOpenKeyset, adLockPessimistic
  Do Until .EOF
    .Fields!发送标志 = "放弃"
    .Update
    .MoveNext
  Loop
  .Close
 End With
End Sub

Private Sub Text1_DblClick()
Frmuser.Show
Frmuser.SetFocus
End Sub
Private Sub Text2_DblClick()
FrmSmsdz.Show
FrmSmsdz.SetFocus
End Sub

Private Sub Timer2_Timer()
 Dim tb_SQ As New ADODB.Recordset
If Now - sendtime < (5 / 60 / 24) Then
      With tb_SQ
      .Open "select*from sendqueue where 发送内容='" & sendstr & "' and 手机号='" & handset & "' and 加入时间=#" & addtime & "# ", Cn, adOpenKeyset, adLockPessimistic
      If Not .EOF Then
         Select Case .Fields!发送标志
             Case "成功"
                Text1.Text = ""
                Text2.Text = ""
                MsgBox "发送成功！", vbInformation + vbOKOnly, "提示"
               .Fields!发送标志 = "验证成功"
               .Update
                Label3.Visible = False
                Command1.Enabled = True
                Timer2.Enabled = False
               Exit Sub
             Case "失败"
                MsgBox "发送失败！", vbInformation + vbOKOnly, "提示"
                Label3.Visible = False
                Command1.Enabled = True
                Timer2.Enabled = False
                .Fields!发送标志 = "验证失败"
               .Update
              Exit Sub
             Case "失败2"
               MsgBox "收到失败的错误报告！", vbInformation + vbOKOnly, "提示"
               Command1.Enabled = True
               Label3.Visible = False
               Timer2.Enabled = False
               .Fields!发送标志 = "验证失败2"
              .Update
               Exit Sub
              Case "超时"
              Case Else
              Exit Sub
          End Select
         End If
         Label3.Visible = True
         'Me.Refresh
      .Close
    End With
 Else
 End If
   MsgBox "五分钟内没有等到状态报告！"
   tb_SQ.Open "select*from sendqueue where 发送内容='" & sendstr & "' and 手机号='" & handset & "' and 加入时间=#" & addtime & "#", Cn, adOpenKeyset, adLockPessimistic
    tb_SQ.Fields!发送标志 = "验证超时"
    tb_SQ.Update
   tb_SQ.Close
   Label3.Visible = False
   Command1.Enabled = True
   Timer2.Enabled = False
End Sub