esm_phs_frm.frm

连接短信网关,嵌入式系统Boot Loader 技术内幕

            TextSave        =   "conn_id"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   6245
            MinWidth        =   6245
            Text            =   "winsock state"
            TextSave        =   "winsock state"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   5892
            MinWidth        =   5892
            Text            =   "event&time"
            TextSave        =   "event&time"
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   1658
            MinWidth        =   1658
            Text            =   "err"
            TextSave        =   "err"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "EMS_PHS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
If PHS_Timer.Enabled = True Then
    PHS_Timer.Enabled = False
Else
    PHS_Timer.Enabled = True
End If

End Sub

Private Sub Command2_Click()
If ESM_Timer.Enabled = True Then
    ESM_Timer.Enabled = False
Else
    ESM_Timer.Enabled = True
End If

End Sub

Private Sub Form_Initialize()
Dim p As ShakeHandAnswer

AdodcPHS.Refresh
yxtConnection.Open "dsn=yxt;uid=adminyxt;pwd=yxtadmin"
    rsESM.Open "forsendingSM", yxtConnection, , , adCmdTable
    rsPHS.Open "forsendingPHS", yxtConnection, , , adCmdTable
            rsMessage.CursorType = adOpenKeyset
            rsMessage.LockType = adLockOptimistic
    rsMessage.Open "message", yxtConnection, , , adCmdTable

If SystemInit(9600, 1, p) <> 0 Then
    MsgBox ("PHS 串口初始化失败")
Else
    PHS_Timer.Enabled = False
End If

    ConnectESM
    LogSuccess = 11
  Cmd1.Enabled = True
  Cmd3.Enabled = False
  Cmd4.Enabled = False
  Cmd5.Enabled = False
  TaskID = 168

End Sub
Private Sub Commandexit_Click()
SysRelease
Unload Me
End Sub
Private Sub CommandSend_Click()
Dim sms_content As String
Dim sms_num As String
sms_content = content.Text
sms_num = num.Text
If Trim(sms_content) = "" Or Trim(sms_num) = "" Then
MsgBox ("PHS 请输入短信内容和号码")
Exit Sub
End If

If CInt(SendOneSMSChar(0, sms_num, sms_content)) = 0 Then
    MsgBox ("PHS 短信发送成功！")
End If
End Sub

Private Sub CommandReadFirst_Click()
Dim p2 As RecvSmsData
Dim aa As Byte
aa = ReadMsgData(0, 1, 0, p2)

Dim strC As String
strC = Trim(StrConv(p2.chSendCode, vbUnicode))

Dim strD As String
strD = Trim(StrConv(p2.byData, vbUnicode))

num.Text = strC
content.Text = strD
End Sub

Private Sub CommandReadNext_Click()
Dim p2 As RecvSmsData
If ReadMsgData(0, False, False, p2) = 0 Then
    Dim strC As String
    strC = Trim(StrConv(p2.chSendCode, vbUnicode))

    Dim strD As String
    strD = Trim(StrConv(p2.byData, vbUnicode))

    num.Text = strC
    content.Text = strD
    
End If

End Sub

Private Sub CommandReadPara_Click()

If Trim(bySetType.Text) = "" Then
    MsgBox ("PHS 请输入'参数代号'")
    Exit Sub
End If

If CInt(bySetType.Text) < 5 Or CInt(bySetType.Text) > 16 Then
    MsgBox ("PHS 请输入一个5～16的整数")
    Exit Sub
End If

SetType = CByte(bySetType.Text)

Dim strParaChar As String
Dim lPara As Long

strParaChar = Space$(256)

If ReadMsgBoxPara(SetType, strParaChar, lPara) = 0 Then
    Select Case SetType
        Case 5, 6, 7, 8, 14
            chParaChar.Text = strParaChar
        Case 9, 10, 11, 12, 13, 16
            chParaChar.Text = lPara
    End Select
    MsgBox ("PHS 已成功读取参数")
End If

End Sub

Private Sub CommandSetPara_Click()

If Trim(bySetType.Text) = "" Or Trim(chParaChar.Text) = "" Then
    MsgBox ("PHS 请输入'参数代号'和'参数值'")
    Exit Sub
End If

If CInt(bySetType.Text) < 5 Or CInt(bySetType.Text) > 16 Then
    MsgBox ("PHS 请输入一个5～16的整数")
    Exit Sub
End If

Dim SetType As Byte
Dim ParaChar As String
SetType = CByte(bySetType.Text)

ParaChar = chParaChar.Text

Select Case SetType
    Case 5, 6, 7, 8, 14
        If SetMsgBoxPara(SetType, ParaChar) = 0 Then MsgBox ("PHS 参数设置成功")
    Case 9, 10, 11, 12, 13, 16
        If SetMsgBoxPara(SetType, "", CByte(ParaChar)) = 0 Then MsgBox ("PHS 参数设置成功")
End Select

End Sub
Private Sub PHS_Timer_Timer()
                AdodcPHS.Refresh
                DataGrid_PHS.Refresh
    If rsPHS.BOF And rsPHS.EOF Then
'        MsgBox "PHS短消息空！"
        rsPHS.Close
        rsPHS.Open
            Exit Sub '
    Else
        a0 = rsPHS.Fields(0)
        a1 = rsPHS.Fields(1)
        a2 = rsPHS.Fields(2)
        a3 = rsPHS.Fields(3)
        a4 = rsPHS.Fields(4)
        a5 = rsPHS.Fields(5)
'        If Trim(a2) = "" Or Trim(a5) = "" Then
'            MsgBox ("PHS 请输入短信内容和号码")
'            Exit Sub
'        End If
'        If CInt(SendOneSMSChar(0, Trim(a2), Trim(a5))) = 0 Then   '----短信发送成功
            yxtConnection.Execute "DELETE FROM ForSendingPHS WHERE SMID = '" & a0 & "'"
            rsPHS.MoveFirst
'MsgBox "已删除"
'           MsgBox ("PHS 短信发送成功！")
            rsMessage.MoveLast
            rsMessage.AddNew
            rsMessage!sendid = a1
            rsMessage!receiveid = a2
            rsMessage!Date = a3
            rsMessage!Title = a4
            rsMessage!content = a5
            rsMessage.Update
'        Else
'
'        End If
        
    End If
End Sub
'------------------------------------------------------------
'------------------------------------------------------------
'------------------------------------------------------------
'----------- PHS_end ---------------------------------------------------

Private Sub Cmd1_Click()
'  ret As Integer
  Cmd1.Enabled = False
  If InitializeEsm("211.90.115.46", "211.90.115.45", "无", "", "", _
      "", "", 0, 1) <> 0 Then
    MsgBox "企信通初始化接口出错！”"
    Cmd1.Enabled = True
    Exit Sub
  End If
  ret = LogintoEsm("253297", "政军网络", "123456")
  If ret <> 0 Then
    MsgBox "企信通登录出错！（错误码：" & ret & "）"
    Cmd1.Enabled = True
    Exit Sub
  End
  Else
    MsgBox "企信通登录成功！"
    LogSuccess = 0
    Cmd3.Enabled = True
    Cmd4.Enabled = True
    Cmd5.Enabled = True
  End If
End Sub

Private Sub Cmd3_Click()
'  ret As Integer
  Cmd3.Enabled = False
    MsgBox "企信通logout"
  ret = LogoffEsm()
  If ret <> 0 Then
    MsgBox "企信通退出出错！（错误码：" & ret & "）"
    Cmd3.Enabled = True
    Exit Sub
  Else
    MsgBox "企信通退出成功！"
'    End
'    Application.Terminate;
  End If

End Sub

Private Sub Cmd4_Click()
Dim aa As Byte
Dim yxtRS As ADODB.Recordset
aa = 0
  Cmd4.Enabled = False
Y2 = "这是测试短信。0727  10"
   ret = SubmittoEsm(TaskID, 1001, aa, "", "13245229280", Y2)
   If ret <> 0 Then
        MsgBox "企信通发送失败！（错误码：" & ret & "）"
        Cmd4.Enabled = True
        Exit Sub
   Else
        MsgBox "企信通发送成功！" & ret
'            yxtSQL = "delete from ForSendingSM "
'            Set yxtRS = yxtConnection.Execute(yxtSQL)
        Cmd4.Enabled = True
        TaskID = TaskID + 1
    End If
End Sub

Private Sub Cmd5_Click()
'procedure TEsmApiTest.cmd5Click(Sender: TObject);
'Var
'    cmd5.Enabled:=True;
'  end;
'end;''

End Sub

Private Sub form_unload(cancdl As Integer)
'  ret = LogoffEsm()
End Sub

Private Sub ESM_Timer_Timer()
            AdodcESM.Refresh
            DataGrid_ESM.Refresh
        If rsESM.BOF = True And rsESM.EOF = True Then
'            MsgBox "ESM短消息空！"
            rsESM.Close
            rsESM.Open
            AdodcESM.Refresh
            Exit Sub '
        Else
        a0 = rsESM.Fields(0)
        a1 = rsESM.Fields(1)
        a2 = rsESM.Fields(2)
        a3 = rsESM.Fields(3)
        a4 = rsESM.Fields(4)
        a5 = rsESM.Fields(5)
 '           xx = sendSM(Trim(a2), Trim(a5))
 '       If xx = 0 Then     '----短信发送成功
            yxtConnection.Execute "DELETE FROM ForSendingSM WHERE SMID = '" & a0 & "'"
        rsESM.MoveFirst
'MsgBox "已删除"
            
'            rs1.CursorType = adOpenKeyset
'            rs1.LockType = adLockOptimistic
'            rs1.Open "message", yxtConnection, , , adCmdTable
            rsMessage.MoveLast
            rsMessage.AddNew
            rsMessage!sendid = a1
            rsMessage!receiveid = a2
            rsMessage!Date = a3
            rsMessage!Title = a4
            rsMessage!content = a5
            rsMessage.Update
 '       End If

        End If

End Sub

Private Function sendSM(ByVal calledID As String, ByVal content As String)
Dim aa As Byte
aa = 0
  Cmd4.Enabled = False
'Y2 = "这是测试短信。0727  10"
   ret = SubmittoEsm(TaskID, 1001, aa, "", calledID, content)
   If ret <> 0 Then
'        MsgBox "企信通发送失败！（错误码：" & ret & "）"
        Exit Function
   Else
'        MsgBox "企信通发送成功！" & ret
        TaskID = TaskID + 1
        sendSM = 0
    End If
End Function
  

Private Sub ConnectESM()
'  ret As Integer
  Cmd1.Enabled = False
  If InitializeEsm("211.90.115.46", "211.90.115.45", "无", "", "", "", "", 0, 1) <> 0 Then
    MsgBox "企信通 初始化接口出错！”"
    Cmd1.Enabled = True
    Exit Sub
  End If
  ret = LogintoEsm("253297", "政军网络", "123456")
  If ret <> 0 Then
    MsgBox "企信通登录出错！（错误码：" & ret & "）"
    Cmd1.Enabled = True
    Exit Sub
  End
  Else
    MsgBox "企信通登录成功！"
    ESM_Timer.Enabled = False
    LogSuccess = 0
    Cmd3.Enabled = True
    Cmd4.Enabled = True
    Cmd5.Enabled = True
  End If
End Sub