DDE to Visual Basic

This sample illustrates the use of DDE and Visual Basic to control a variety of Emulator functions. It includes: connection, logon and off, and generic command functions.

Contents of DDE_4.BAS

Option Explicit

' LinkMode (forms and controls)
Global Const NONE = 0
Global Const LINK_MANUAL = 2

' Run time errors
Global Const NO_APP_RESPONDED = 282

Global Const MB_YESNO = 4
Global Const MB_ICONQUESTION = 32
Global Const IDYES = 6

Contents of DDE_4.FRM

Option Explicit
Option Compare Text
'
Dim appChangeFlag As Integer
Dim Connected As Integer
Dim CheckFlag As Boolean
'

Private Sub cboAppName_Click()
    If Connected Then cmdConnect.Value = True
End Sub

Private Sub cboAppName_LostFocus()
    If appChangeFlag Then
        appChangeFlag = False
        If Connected Then cmdConnect.Value = True
    End If
End Sub

Private Sub cboExecuteString_Change()
    cmdExecute.Enabled = (Len(cboExecuteString.Text) > 0)
End Sub

Private Sub cboExecuteString_Click()
    cmdExecute.Enabled = (Len(cboExecuteString.Text) > 0)
End Sub

Private Sub cboItem_Change()
On Error Resume Next
    txtData.LinkItem = cboItem.Text
End Sub

Private Sub cboItem_Click()
    txtData.LinkItem = cboItem.Text
End Sub

Private Sub Check1_Click()
On Error Resume Next
    If Check1.Value = 0 Then
        CheckFlag = False
    Else
        CheckFlag = True
    End If
End Sub

Private Sub cmdConnect_Click()
    If Not Connected Then
        txtData.Text = ""
        Select Case MakeConnection()
            Case 0
                ConnectState True
            Case NO_APP_RESPONDED
                MsgBox "Sorry, can't connect."
        End Select
    Else
        Disconnect txtData
        ConnectState False
    End If
End Sub

Private Sub CmdExecute_Click()
    Execute_Sub (cboExecuteString.Text)
End Sub

Private Sub cmdExit_Click()
    Unload frmMain
    End
End Sub

Private Sub cmdLogin_Click()
Dim tMousePointer As Integer
    tMousePointer = Screen.MousePointer
    Screen.MousePointer = 11
    Execute_Sub ("SEND ""HELLO " & Text1.Text & """")
    If (Trim(Text2.Text) <> "") Then
        Execute_Sub ("WAIT 00:00:02 FOR ""^Q""")
        Execute_Sub ("SEND """ & Text2.Text & """")
    End If
    If (Trim(Text3.Text) <> "") Then
        Execute_Sub ("WAIT 00:00:02 FOR ""^Q""")
        Execute_Sub ("SEND """ & Text3.Text & """")
    End If
    Screen.MousePointer = tMousePointer
End Sub

Private Sub cmdLogout_Click()
    Execute_Sub ("SEND BYE")
End Sub

Private Sub cmdPoke_Click()
On Error Resume Next
    txtData.LinkPoke
    If Err Then MsgBox Error
End Sub

Private Sub cmdRequest_Click()
On Error Resume Next
    txtData.LinkRequest
End Sub

Private Sub ConnectState(State As Integer)
Dim i As Integer
    If State Then
        cmdConnect.Caption = "Disconnect"
    Else
        cmdConnect.Caption = "Connect"
    End If
        
    Connected = State
    cmdRequest.Enabled = State
    cmdPoke.Enabled = State
End Sub

Private Function CreateLink(Ctl As Control, appname As String, item 
As String) As Integer
On Error Resume Next
    Ctl.LinkMode = NONE
    Ctl.LinkTopic = appname & "|S92"
    Ctl.LinkItem = item
    Ctl.LinkMode = LINK_MANUAL
    CreateLink = Err
    If Err = 0 Then
        Ctl.LinkRequest
    End If
End Function

Private Sub Disconnect(Ctl As Control)
Dim tempTimeOutVal
On Error Resume Next
    tempTimeOutVal = Ctl.LinkTimeout
    Ctl.LinkTimeout = 1
    Ctl.LinkMode = NONE
    Ctl.LinkTimeout = tempTimeOutVal
End Sub

Private Sub Execute_Sub(cmdstr As String)
On Error Resume Next
Dim tLinkItem As String
Dim tText As String
Dim tcmdOK As Integer
Dim tcmdCancel As Integer
Dim tMousePointer As Integer
    If (Len(Trim(cmdstr)) < 1) Then Exit Sub
    
    tLinkItem = frmMain.txtData.LinkItem
    tText = frmMain.txtData.Text
    tcmdOK = cmdExecute.Enabled
    tMousePointer = Screen.MousePointer

    frmMain.txtData.LinkItem = "BUSYFLAG"
    frmMain.txtData.Text = "Done"
    frmMain.txtData.LinkPoke
    frmMain.txtData.Text = " "
    Screen.MousePointer = 11
    cmdExecute.Enabled = False
    
    frmMain.txtData.LinkExecute cmdstr
    
    If CheckFlag Then
        While (frmMain.txtData.Text <> "Done")
            frmMain.txtData.LinkRequest
        Wend
    End If
    frmMain.txtData.LinkItem = tLinkItem
    frmMain.txtData.Text = tText
    cmdExecute.Enabled = tcmdOK
    Screen.MousePointer = tMousePointer
End Sub

Private Sub Form_Load()
    cboAppName.AddItem "MS92"
    cboExecuteString.AddItem "SEND LISTF A@"
    cboExecuteString.AddItem "SEND SHOWME"
    cboExecuteString.AddItem "SEND HELLO MGR.MINISOFT"
    CheckFlag = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Disconnect txtData
End Sub

Private Function MakeConnection() As Integer
Dim ConnectTxt As Integer
    ConnectTxt = CreateLink(txtData, (cboAppName.Text), 
 (cboItem.Text))
    
    If ConnectTxt = NO_APP_RESPONDED Then
        MakeConnection = NO_APP_RESPONDED
    ElseIf ConnectTxt = 0 Then
        MakeConnection = 0
    Else
        MakeConnection = ConnectTxt
    End If
End Function

Private Sub txtData_LinkClose()
    ConnectState False
End Sub

Private Sub txtData_LinkError(LinkErr As Integer)
Dim Msg
    Select Case LinkErr
        Case 1
            Msg = "Data in wrong format."
        Case 6
            Msg = "Error # 6."
        Case 7
            Msg = "Error # 7."
        Case 8
            Msg = "Error # 8."
        Case 11
            Msg = "Out of memory for DDE."
    End Select
    MsgBox Msg, 48, "MyTextBox"
End Sub