frmmain.frm

短信平台管理系统是一个短信收发的平台,用户可以找一些代理的短信平台(IP),在系统里修改一些设置就可以进行短信的收发,有短信服务器的IP,服务器端口.系统还有一些常用用户的设置,包括客户资料,客户分类

    End
End Sub






Private Sub mnuChgPassword_Click()
    usermaintain.modifyuser User.userid
End Sub




Private Sub mnuCreTech_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_smsm
    ins_vc_in.listall
    
    
End Sub





Private Sub mnucusclass_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_cusclass
    ins_vc_in.listall
End Sub

Private Sub mnugroup_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_group
    ins_vc_in.listall
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal
End Sub











Private Sub MNULEDMODE_Click()
    modemaintain.modelist
End Sub









Private Sub mnunewcustomer_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_recvedsms
    ins_vc_in.listall
End Sub








Private Sub mnuPara_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_parameter
    ins_vc_in.modifyrec 1
End Sub

Private Sub mnuProject_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_customer
    ins_vc_in.listall
End Sub

Private Sub mnusend_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_sendsms
    ins_vc_in.listall
End Sub

Private Sub mnuSysExit_Click()
    
    Unload Me
End Sub







Private Sub mnuSysRight_Click()
    rights
End Sub


Private Sub mnuSysUSer_Click()
    users
End Sub


Private Sub mnuTIMEC_Click()
    If Not User.CanDo(2) Then Exit Sub
    Dim ins_vc_in As vc_in
    Set ins_vc_in = Ins_vc_gsendsms
    ins_vc_in.listall
End Sub

Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

'Private Sub mnuWindowTileVertical_Click()
'    Me.Arrange vbTileVertical
'End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub













Private Sub mnuWindowTileVertical_Click(Index As Integer)
    Me.Arrange vbTileVertical
End Sub



Public Sub startTimer()
    Me.Timer1.Interval = 2000
    Me.Timer2.Interval = 60000
End Sub



Private Sub Timer1_Timer()

    initsend
End Sub

Public Sub initsend()
    On Error Resume Next
    
    If (mp Is Nothing) Then
        Set mp = modBank.Ins_c_parameter.getrec
    End If
    If Winsock1.State <> 0 And Winsock1.State <> 8 Then
        'Winsock1.Close
        
    Else
        With Winsock1
            .Close
            .RemoteHost = mp.ip
            .RemotePort = mp.Port
            .Connect
        End With
    End If
    Ins_c_sendsms.searchsms smses
    
    sendsms
End Sub


Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo ErrHandle

    Dim recvData As String
    Dim recvByte() As Byte
    Winsock1.GetData recvByte

   
    
    recvData = recvByte
    
    Dim DT 'Data Type
    Dim OAL 'Original Address Length
    Dim OA As String 'Original Address
    Dim TSL 'Time Stamp Length
    Dim TS As String  'Time Stamp
    Dim UD As String  'User Data
    
    DT = Left(recvData, 1)
    If DT = "0" Then
        OAL = mid(recvData, 2, 2)
        OA = mid(recvData, 4, OAL)
        TSL = mid(recvData, 4 + OAL, 2)
        TS = mid(recvData, 6 + OAL, TSL)
        UD = mid(recvData, 6 + OAL + TSL)
        
        TS = "20" & TS
        TS = mid(TS, 1, 4) & "/" & mid(TS, 5, 2) & "/" & mid(TS, 7, 2) & " " & mid(TS, 9, 2) & ":" & mid(TS, 11, 2) & ":" & mid(TS, 13, 2)
        OA = mid(OA, 3, Len(OA) - 2)
        modBank.Ins_c_recvedsms.addrec OA, UD, CDate(TS)
        'TxtRecvInfo.text = TxtRecvInfo.text & "[时间" & TS & "][号码" & OA & "]" & UD & vbCrLf
    ElseIf DT = "1" Then
        
        sendend True
        'TxtRecvInfo.text = TxtRecvInfo.text & "短信发送成功！" & vbCrLf
    ElseIf DT = "2" Then
        'readysend = True
        sendend False
        'TxtRecvInfo.text = TxtRecvInfo.text & "短信发送失败！" & vbCrLf
    Else
        
    End If
    
    
    
    Exit Sub

ErrHandle:
    Debug.Print Err.Description
End Sub

Sub sendend(isok As Boolean)
    '
    readysend = True
    Me.Timer2.Enabled = False
    'dele an sms
    If (smses.Count > 0) Then
        If isok Then
            Ins_c_sendsms.sended (smses.Item(1).smsid)
        End If
        smses.Remove 1
    End If
    sendsms
End Sub
Sub sendsms()
    On Error Resume Next
    Dim sendData As String
    Dim sendByte() As Byte
'

    If (readysend) Then
        If (smses.Count > 0) Then
            readysend = False
            Me.Timer2.Enabled = True
            'send
            '    '发送的数据：对方号码长度(2位)+对方号码+短信内容
            sendData = Len(smses.Item(1).mobile) & smses.Item(1).mobile & smses.Item(1).sms
            '变成Unicode编码
            sendByte = sendData
            'Send
            Winsock1.sendData sendByte
            
        End If
        
    End If
End Sub
Private Sub Timer2_Timer()
    readysend = True
    sendend False
End Sub