123.txt

春笛短信发送源码,引用该控件后

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Dim Cn      As New ADODB.Connection
Dim V_Conn  As String
Dim i As Integer

Dim Dx_Count As Integer
Private Sub Dx_Open()

Dim ServerIP As String
Dim UserID As String
Dim Password As String
Dim DataBase As String
Dim ComPort1  As Integer
Dim ComPort2  As Integer
Dim ComPort3  As Integer
Dim CenterNo As String

ServerIP = GetIni(App.Path + "\" + "sys.ini", "ODBC", "ServerIP")
UserID = GetIni(App.Path + "\" + "sys.ini", "ODBC", "UserID")
Password = GetIni(App.Path + "\" + "sys.ini", "ODBC", "Password")
DataBase = GetIni(App.Path + "\" + "sys.ini", "ODBC", "DataBase")
ComPort1 = GetIni(App.Path + "\" + "sys.ini", "COM", "Port1")
ComPort2 = GetIni(App.Path + "\" + "sys.ini", "COM", "Port2")
ComPort3 = GetIni(App.Path + "\" + "sys.ini", "COM", "Port3")
CenterNo = GetIni(App.Path + "\" + "sys.ini", "SMS", "ServiceCenter")

V_Conn = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & UserID & ";Initial Catalog=" & DataBase & ";Data Source=" & ServerIP & ""
On Error Resume Next
Cn.Open V_Conn
Cn.CursorLocation = adUseClient
On Error GoTo 0

If Cn.State = 0 Then
    MsgBox "数据库连接失败，请查看配置文档！", vbCritical + vbOKOnly + vbDefaultButton1, "提示:"
    End
Else
    
    Dx_Count = 0
    
    JindiSMSControl1.CommPort = ComPort1
    JindiSMSControl1.CenterNo = Trim(CenterNo)
    If JindiSMSControl1.OpenCom <> 0 Then
        txtmsg(0).Text = "短信发送设备端口“" & Trim(Str(ComPort1)) & "”打开失败，请查看配置文档！"
        'End
    Else
        Dx_Count = 1
    End If
        
    JindiSMSControl2.CommPort = ComPort2
    JindiSMSControl2.CenterNo = Trim(CenterNo)
    If JindiSMSControl2.OpenCom <> 0 Then
        txtmsg(1).Text = "短信发送设备端口“" & Trim(Str(ComPort2)) & "”打开失败，请查看配置文档！"
        'End
    Else
        Dx_Count = 2
    End If
                
    JindiSMSControl3.CommPort = ComPort3
    JindiSMSControl3.CenterNo = Trim(CenterNo)
    If JindiSMSControl3.OpenCom <> 0 Then
        txtmsg(2).Text = "短信发送设备端口“" & Trim(Str(ComPort3)) & "”打开失败，请查看配置文档！"
    '    End
    Else
        Dx_Count = 3
    End If
    
    Timer1.Enabled = True

End If
Label3(0).Caption = ""
Label3(1).Caption = ""
Label3(2).Caption = ""

End Sub
Private Sub Dx_Open2007()

Dim ComPort1  As Integer
Dim CenterNo As String

ComPort1 = GetIni(App.Path + "\" + "sys.ini", "COM", "Port1")
CenterNo = GetIni(App.Path + "\" + "sys.ini", "SMS", "ServiceCenter")

ComPort1 = "COM1"
CenterNo = GetIni(App.Path + "\" + "sys.ini", "SMS", "ServiceCenter")


V_Conn = "Provider=SQLOLEDB.1;Password=" & Password & ";Persist Security Info=True;User ID=" & UserID & ";Initial Catalog=" & DataBase & ";Data Source=" & ServerIP & ""
On Error Resume Next
Cn.Open V_Conn
Cn.CursorLocation = adUseClient
On Error GoTo 0

If Cn.State = 0 Then
    MsgBox "数据库连接失败，请查看配置文档！", vbCritical + vbOKOnly + vbDefaultButton1, "提示:"
    End
Else
    
    Dx_Count = 0
    
    JindiSMSControl1.CommPort = ComPort1
    JindiSMSControl1.CenterNo = Trim(CenterNo)
    If JindiSMSControl1.OpenCom <> 0 Then
        txtmsg(0).Text = "短信发送设备端口“" & Trim(Str(ComPort1)) & "”打开失败，请查看配置文档！"
        'End
    Else
        Dx_Count = 1
    End If
        
    JindiSMSControl2.CommPort = ComPort2
    JindiSMSControl2.CenterNo = Trim(CenterNo)
    If JindiSMSControl2.OpenCom <> 0 Then
        txtmsg(1).Text = "短信发送设备端口“" & Trim(Str(ComPort2)) & "”打开失败，请查看配置文档！"
        'End
    Else
        Dx_Count = 2
    End If
                
    JindiSMSControl3.CommPort = ComPort3
    JindiSMSControl3.CenterNo = Trim(CenterNo)
    If JindiSMSControl3.OpenCom <> 0 Then
        txtmsg(2).Text = "短信发送设备端口“" & Trim(Str(ComPort3)) & "”打开失败，请查看配置文档！"
    '    End
    Else
        Dx_Count = 3
    End If
    
    Timer1.Enabled = True

End If
Label3(0).Caption = ""
Label3(1).Caption = ""
Label3(2).Caption = ""

End Sub

Public Function GetIni(FileName As String, section As String, key As String) As String
Dim L As Long
Dim Str As String * 255
Dim tStr As String
    L = GetPrivateProfileString(section, key, "", Str, 255, FileName)
    tStr = Replace(Str, Chr(32), "")
    tStr = Replace(Str, Chr(0), "")
    tStr = Trim(tStr)
    GetIni = tStr
End Function


Private Sub Jindi_Send1(V_Id As Integer)
    If JindiSMSControl1.SendMsg(txtMobileNo(0).Text, txtmsg(0).Text) = 0 Then
        Cn.Execute "Delete From SEND_QUEUE Where Id=" & V_Id
        Label3(0).Caption = "发送成功."
    Else
        Cn.Execute "Update SEND_QUEUE Set Retry=Isnull(Retry,0)+1 Where Id=" & V_Id
        Dim Rs_Id As New ADODB.Recordset
        Rs_Id.Open "select Retry From SEND_QUEUE Where Id=" & V_Id
        Label3(0).Caption = "发送失败.重试第" + Trim(Str(Rs_Id!Retry)) + "次."
    End If
End Sub

Private Sub Jindi_Send2(V_Id As Integer)
    If JindiSMSControl2.SendMsg(txtMobileNo(1).Text, txtmsg(1).Text) = 0 Then
        Cn.Execute "Delete From SEND_QUEUE Where Id=" & V_Id
        Label3(1).Caption = "发送成功."
    Else
        Cn.Execute "Update SEND_QUEUE Set Retry=Isnull(Retry,0)+1 Where Id=" & V_Id
        Dim Rs_Id As New ADODB.Recordset
        Rs_Id.Open "select Retry From SEND_QUEUE Where Id=" & V_Id
        Label3(1).Caption = "发送失败.重试第" + Trim(Str(Rs_Id!Retry)) + "次."
    End If
End Sub

Private Sub Jindi_Send3(V_Id As Integer)
    If JindiSMSControl3.SendMsg(txtMobileNo(2).Text, txtmsg(2).Text) = 0 Then
        Cn.Execute "Delete From SEND_QUEUE Where Id=" & V_Id
        Label3(2).Caption = "发送成功."
    Else
        Cn.Execute "Update SEND_QUEUE Set Retry=Isnull(Retry,0)+1 Where Id=" & V_Id
        Dim Rs_Id As New ADODB.Recordset
        Rs_Id.Open "select Retry From SEND_QUEUE Where Id=" & V_Id
        Label3(2).Caption = "发送失败.重试第" + Trim(Str(Rs_Id!Retry)) + "次."
    End If
End Sub

Private Sub Comm1_Click()
Call Dx_Open
MsgBox "设备已正常打开！", vbInformation + vbOKOnly + vbDefaultButton1, "提示:"

Comm1.Enabled = False
Comm2.Enabled = True

End Sub

Private Sub Comm2_Click()

If JindiSMSControl1.CloseCom = 0 Then
    txtmsg(0).Text = "设备已正常关闭！"
Else
    txtmsg(0).Text = "设备关闭失败！"
End If
If JindiSMSControl1.CloseCom = 1 Then
    txtmsg(1).Text = "设备已正常关闭！"
Else
    txtmsg(1).Text = "设备关闭失败！"
End If

If JindiSMSControl1.CloseCom = 2 Then
    txtmsg(2).Text = "设备已正常关闭！"
Else
    txtmsg(2).Text = "设备关闭失败！"
End If


Cn.Close
Comm1.Enabled = True
Comm2.Enabled = False

End Sub

Private Sub Command1_Click()

End Sub

Private Sub Command2_Click()
If txtmsg(0).Text = "!@#$%" Then
    txtmsg(0).Text = ""
    Form2.Show 1
End If
End Sub

Private Sub Form_Load()
Timer1.Enabled = False
txtMobileNo(0).Text = ""
txtmsg(0).Text = ""
txtMobileNo(1).Text = ""
txtmsg(1).Text = ""
txtMobileNo(2).Text = ""
txtmsg(2).Text = ""

Call Dx_Open

Comm1.Enabled = False
Comm2.Enabled = True


End Sub
Private Sub JindiSMSControl1_ReceiveMsg()
Dim OA As String
Dim Msg As String
Dim Time As String

    If JindiSMSControl1.ReadMsg(OA, Msg, Time) = 0 Then
        If i > 10 Then txtRec(0).Text = ""
        txtRec(0).Text = txtRec(0).Text & "时间：" & Time & vbCrLf & "来自：" & OA & vbCrLf & "内容：" & Msg & vbCrLf
        Cn.Execute "Insert Into Dx_Receive(Receieve_Time,Source_address,Message) Values('" & Time & "','" & OA & "','" & Msg & "')"
        i = i + 1
    End If
End Sub

Private Sub JindiSMSControl2_ReceiveMsg()
Dim OA As String
Dim Msg As String
Dim Time As String

    If JindiSMSControl2.ReadMsg(OA, Msg, Time) = 0 Then
        If i > 10 Then txtRec(1).Text = ""
        txtRec(1).Text = txtRec(1).Text & "时间：" & Time & vbCrLf & "来自：" & OA & vbCrLf & "内容：" & Msg & vbCrLf
        Cn.Execute "Insert Into Dx_Receive(Receieve_Time,Source_address,Message) Values('" & Time & "','" & OA & "','" & Msg & "')"
        i = i + 1
    End If
End Sub


Private Sub JindiSMSControl3_ReceiveMsg()
Dim OA As String
Dim Msg As String
Dim Time As String

    If JindiSMSControl3.ReadMsg(OA, Msg, Time) = 0 Then
        If i > 10 Then txtRec(2).Text = ""
        txtRec(2).Text = txtRec(2).Text & "时间：" & Time & vbCrLf & "来自：" & OA & vbCrLf & "内容：" & Msg & vbCrLf
        Cn.Execute "Insert Into Dx_Receive(Receieve_Time,Source_address,Message) Values('" & Time & "','" & OA & "','" & Msg & "')"
        i = i + 1
    End If
End Sub


Private Sub Timer1_Timer()
Timer1.Enabled = False

If Dx_Count = 0 Then Exit Sub

Dim Rs As New ADODB.Recordset
Rs.Open "Select Id,Submit_Time,Send_Time,Destination_Address,Message,Sended,Retry From SEND_QUEUE Where Sended=0 And Retry<5 Order By Submit_Time Desc", Cn, adOpenKeyset, adLockOptimistic

For i = 0 To Dx_Count - 1

    If Not Rs.EOF And Not Rs.BOF Then
        txtMobileNo(i).Text = Rs!Destination_Address
        txtmsg(i).Text = Rs!Message
        If i = 0 Then Call Jindi_Send1(Rs!Id)
        If i = 1 Then Call Jindi_Send2(Rs!Id)
        If i = 2 Then Call Jindi_Send3(Rs!Id)
        Rs.MoveNext
    End If
    

Next i

Timer1.Enabled = True
End Sub