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