Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools


In our previous article Interprocess communication using DDE (Dynamic Data Exchange) - Part1 of this this series we learned about basic concept of DDE and we also saw that how to implement DDE Server using DDEML Apis. Now in this article I will show you how to implement DDE Client which can request data from DDE Server and send data to DDE Server.

Steps to implement DDE Client
  1. Initialize the DDE subsystem by calling DdeInitialize.
  2. Create string handles for server/topic using DdeCreateStringHandle
    Call DdeConnect to connect with DDE Server which is registered only for server/topic which we used in step 2.
  3. Once you connect you can do various DDE Operations (i.e. Request Data, Execute Command, Poke Data, Start/Stop Advisory Request etc.) by calling DdeClientTransaction function.
  4. If you dont want to break DDE conversation then call DdeDisconnect and then DdeUninitialize to break down the link with DDE Server and the DDE subsystem


Now lets implement DDE Client

Step-By-Step Example

- Create a standard exe project
- Change project name to DDEClient
- Add one module to the project
- Add eight command button controls, 3 text box controls and one combobox control on the form1
- Add the following code in form1

Click here to copy the following block
Option Explicit

Dim bAdvise As Boolean

Private Sub Combo1_Click()
  
  ' Adjust button states.
  Select Case Combo1.Text
    Case "<None>"
      Command2.Enabled = True
      Command3.Enabled = False
      Command4.Enabled = False
      Command7.Enabled = False
      Command6.Enabled = False
    
    Case "MyAdvise"
      If (bAdvise) Then
        Command7.Enabled = True
      Else
        Command6.Enabled = True
      End If
      Command2.Enabled = False
      Command3.Enabled = False
      Command4.Enabled = False
      
    Case "MyPoke"
      Command2.Enabled = False
      Command3.Enabled = True
      Command4.Enabled = False
      Command7.Enabled = False
      Command6.Enabled = False
    
    Case "MyRequest"
      Command2.Enabled = False
      Command3.Enabled = False
      Command4.Enabled = True
      Command7.Enabled = False
      Command6.Enabled = False
  End Select
End Sub

Private Sub Command1_Click()
Dim oCtl As Control
  
  Debug.Print "------------------- Begin DDE Test -----------------------"
  
  g_lInstID = 0
  
  ' Initialize the DDE subsystem. This only needs to be done once.
  If DdeInitialize(g_lInstID, AddressOf DDECallback, APPCMD_CLIENTONLY Or MF_SENDMSGS Or MF_POSTMSGS, 0) Then
    
    Debug.Print "DDE Initialize Failure."
    TranslateError
  Else
    Debug.Print "DDE Initialize Success."
  
  End If
    
  ' Enable the command buttons.
  For Each oCtl In Controls
    If ((TypeOf oCtl Is TextBox) Or (TypeOf oCtl Is ComboBox)) And (oCtl.Enabled = False) Then
      oCtl.Enabled = True
    End If
  Next
  
  Command1.Enabled = False
  Command5.Enabled = True
  Command8.Enabled = True
  Combo1.ListIndex = 0
  
End Sub

Private Sub Command5_Click()
  
Dim oCtl As Control
  
  ' Make sure we don't have any open connections.
  If (g_hDDEConv <> 0) Then
    DDE_Disconnect
  End If
  
  ' Tear down the initialized instance.
  If g_lInstID Then
    
    If DdeUninitialize(g_lInstID) Then
      Debug.Print "DDE Uninitialize Success."
    Else
      Debug.Print "DDE Uninitialize Failure."
      TranslateError
    End If
    
    g_lInstID = 0
  End If

  Debug.Print "-------------------- End DDE Test ------------------------"

  ' Disable the command buttons and the text boxes.
  For Each oCtl In Controls
  
    If ((TypeOf oCtl Is CommandButton) And (oCtl.Enabled = True)) Or _
      ((TypeOf oCtl Is TextBox) And (oCtl.Enabled = True)) Or _
      ((TypeOf oCtl Is ComboBox) And (oCtl.Enabled = True)) Then
    
      oCtl.Enabled = False
    End If
  Next

  Command1.Enabled = True
  
End Sub

Private Sub Command6_Click()
  If (CheckData("Advise")) Then
    DDE_StartAdvise
    bAdvise = True
  Else
    MsgBox "Please enter the required data for the transaction."
  End If
End Sub

Private Sub Command7_Click()
  If (CheckData("Advise")) Then
    DDE_StopAdvise
    bAdvise = False
  Else
    MsgBox "Please enter the required data for the transaction."
  End If
End Sub

Private Sub Command2_Click()
  
Dim lRet As Long
Dim sValue As String
      
  If (CheckData("Execute")) Then
    ' Load the buffer.
    sValue = Text3.Text
  
    ' Create the string handles.
    DDE_CreateStringHandles Text1.Text, Text2.Text
    
    ' Open the conversation.
    If (g_hDDEConv = 0) Then
      g_hDDEConv = DDE_Connect
    End If
    
    If g_hDDEConv Then
    
      ' Perform the transaction.
      lRet = DdeClientTransaction(sValue, Len(sValue), g_hDDEConv, 0, 0, XTYP_EXECUTE, 2000, 0)
    
      If (lRet) Then
      
        Debug.Print "DDE Execute Success."
    
      Else
      
        Debug.Print "DDE Execute Failure."
        TranslateError
    
      End If
      
    End If
    
    ' Release the memory.
    DDE_FreeStringHandles
  Else
    MsgBox "Please enter the required data for the transaction."
  End If
End Sub

Private Sub Command4_Click()

Dim lRet As Long
Dim lSize As Long
Dim sBuffer As String
Dim sFinal As String
    
  If (CheckData("Request")) Then
    DDE_CreateStringHandles Text1.Text, Text2.Text, Combo1.Text
    
    ' Open the conversation.
    If (g_hDDEConv = 0) Then
      g_hDDEConv = DDE_Connect
    End If
    
    If g_hDDEConv Then
    
      ' Perform the transaction.
      lRet = DdeClientTransaction(0, 0, g_hDDEConv, g_hItem, CF_TEXT, XTYP_REQUEST, 2000, 0)
      
      If (lRet) Then
      
        Debug.Print "DDE Request Success."
        
        ' Grab the data from the DDE object create during the transaction. The DDE object
        ' is part of the DDE subsystem memory. Once we get what we want we need to free
        ' the object. Check the Microsoft Platform SDK for more information on freeing
        ' DDE global memory.
        
        ' The first call returns the size of the of the string. For some reason there's
        ' always an extra 3 bytes attached to the end of the string. That's why I have a magic
        ' number.
        lSize = DdeGetData(lRet, vbNullString, 0, 0)
        
        ' Allocate a buffer for the return data.
        sBuffer = String$(lSize, 0)
              
        ' Grab the data.
        lSize = DdeGetData(lRet, sBuffer, Len(sBuffer), 0)
  
        ' Print the contents of the buffer.
        Text3.Text = sBuffer
        Debug.Print sBuffer
  
        ' Free the DDE subsystem resources.
        DdeFreeDataHandle lRet
        
      Else
        
        Debug.Print "DDE Request Failed"
        TranslateError
      
      End If
      
    End If
    
    DDE_FreeStringHandles
  Else
    MsgBox "Please enter the required data for the transaction."
  End If
End Sub

Private Sub Command3_Click()
  
Dim lRet As Long
Dim sValue As String
      
  If (CheckData("Poke")) Then
    ' Load the buffer.
    sValue = Text3.Text
    
    DDE_CreateStringHandles Text1.Text, Text2.Text, Combo1.Text
    
    ' Open the conversation.
    If (g_hDDEConv = 0) Then
      g_hDDEConv = DDE_Connect
    End If
    
    If g_hDDEConv Then
      ' Perform the transaction.
      lRet = DdeClientTransaction(sValue, Len(sValue), g_hDDEConv, g_hItem, CF_TEXT, XTYP_POKE, 2000, 0)
      
      If (lRet) Then
        Debug.Print "DDE Poke Success"
      Else
        Debug.Print "DDE Poke Failed"
        TranslateError
      End If
    End If
    
    DDE_FreeStringHandles
  Else
    MsgBox "Please enter the required data for the transaction."
  End If
End Sub

Private Sub Command8_Click()
  ' Clear out the text boxes.
  Combo1.ListIndex = 0
  Text3.Text = ""
End Sub

Private Sub DDE_CreateStringHandles(ByRef sTheService As String, ByRef sTheTopic As String, Optional ByRef sTheItem As String = "")
  
  ' Create the string handles for the service and topic. DDEML will not
  ' allow you to use standard strings. NOTE: Make sure to release the
  ' string handles once you are done with them.
  g_hService = DdeCreateStringHandle(g_lInstID, sTheService, CP_WINANSI)
  g_hTopic = DdeCreateStringHandle(g_lInstID, sTheTopic, CP_WINANSI)
  
  ' Only convert the item if we were passed a string otherwise you'll get a memory
  ' error.
  If (sTheItem <> "") Then
    
    g_hItem = DdeCreateStringHandle(g_lInstID, Combo1.Text, CP_WINANSI)
  
  End If

End Sub

Private Sub DDE_FreeStringHandles()

  ' Release our string handles.
  If (g_hService <> 0) Then
    DdeFreeStringHandle g_lInstID, g_hService
    DdeFreeStringHandle g_lInstID, g_hTopic
  End If
  
  If (g_hItem <> 0) Then
    DdeFreeStringHandle g_lInstID, g_hItem
  End If
  
  g_hService = 0
  g_hTopic = 0
  g_hItem = 0

End Sub

Private Function DDE_Connect() As Long

Dim udtConvCont As CONVCONTEXT
Dim hDDEConv As Long
    
  ' Set up the conversation context structure.
  udtConvCont.iCodePage = CP_WINANSI
  udtConvCont.cb = Len(udtConvCont)
  
  hDDEConv = 0
  
  ' Open the connection to the service.
  hDDEConv = DdeConnect(g_lInstID, g_hService, g_hTopic, udtConvCont)
  
  ' Do we have a connection?
  If hDDEConv Then
    Debug.Print "DDE Connection Success."
  Else
    Debug.Print "DDE Connection Failure."
    TranslateError
  End If
  
  DDE_Connect = hDDEConv
  
End Function

Private Sub DDE_Disconnect()
      
  ' Disconnect the DDE conversation.
  If g_hDDEConv Then
    
    If DdeDisconnect(g_hDDEConv) Then
      Debug.Print "DDE Disconnect Success."
    Else
      Debug.Print "DDE Disconnect Failure."
      TranslateError
    End If
    
    g_hDDEConv = 0
  
  End If

End Sub

Private Sub DDE_StartAdvise()
  
Dim lRet As Long
Dim lTransVal As Long

  DDE_CreateStringHandles Text1.Text, Text2.Text, Combo1.Text
  
  ' Open the conversation.
  If (g_hDDEConv = 0) Then
    g_hDDEConv = DDE_Connect
  End If
  
  If g_hDDEConv Then
  
    ' Perform the transaction.
    lRet = DdeClientTransaction(0, 0, g_hDDEConv, g_hItem, CF_TEXT, XTYP_ADVSTART, 2000, lTransVal)
    
    If (lRet) Then
    
      Debug.Print "DDE Advise Start Success."
            
      ' Enable the Advise Stop button and disable the Advise Start button.
      Command7.Enabled = True
      Command6.Enabled = False
      
    Else
      Debug.Print "DDE Advise Start Failure."
    End If

  End If
  
  DDE_FreeStringHandles
  
End Sub

Private Sub DDE_StopAdvise()

Dim lRet As Long
Dim lTransVal As Long
  
  DDE_CreateStringHandles Text1.Text, Text2.Text, Combo1.Text
    
  If g_hDDEConv Then
  
    lRet = DdeClientTransaction(0, 0, g_hDDEConv, g_hItem, CF_TEXT, XTYP_ADVSTOP, 2000, lTransVal)
    
    If (lRet) Then
      Debug.Print "DDE Advise Stop Success."
            
      ' Disable the Advise Stop button.
      Command7.Enabled = False
      Command6.Enabled = True
      
    Else
      Debug.Print "DDE Advise Stop Failure."
    End If
  End If
  
  DDE_FreeStringHandles

End Sub

Private Function CheckData(sCommand As String) As Boolean
  
Dim bRet As Boolean

  Select Case sCommand
    Case "Execute"
      If (Text1.Text <> "") And (Text2.Text <> "") Then
        bRet = True
      End If
      
    Case "Poke", "Request", "Advise"
      If (Text1.Text <> "") And (Text2.Text <> "") And (Combo1.Text <> "<None>") Then
        bRet = True
      End If
      
  End Select

  CheckData = bRet
  
End Function

Private Sub TranslateError()
  
Dim lRet As Long
  
  lRet = DdeGetLastError(g_lInstID)

  Select Case lRet
    Case DMLERR_NO_ERROR
      Debug.Print "DMLERR_NO_ERROR"
      
    Case DMLERR_ADVACKTIMEOUT
      Debug.Print "DMLERR_ADVACKTIMEOUT"
      
    Case DMLERR_BUSY
      Debug.Print "DMLERR_BUSY"
    
    Case DMLERR_DATAACKTIMEOUT
      Debug.Print "DMLERR_DATAACKTIMEOUT"
    
    Case DMLERR_DLL_NOT_INITIALIZED
      Debug.Print "DMLERR_NOT_INITIALIZED"
    
    Case DMLERR_DLL_USAGE
      Debug.Print "DMLERR_USAGE"
    
    Case DMLERR_EXECACKTIMEOUT
      Debug.Print "DMLERR_EXECACKTIMEOUT"
    
    Case DMLERR_INVALIDPARAMETER
      Debug.Print "DMLERR_INVALIDPARAMETER"
    
    Case DMLERR_LOW_MEMORY
      Debug.Print "DMLERR_LOW_MEMORY"
    
    Case DMLERR_MEMORY_ERROR
      Debug.Print "DMLERR_MEMORY_ERROR"
    
    Case DMLERR_NOTPROCESSED
      Debug.Print "DMLERR_NOTPROCESSED"
    
    Case DMLERR_NO_CONV_ESTABLISHED
      Debug.Print "DMLERR_NO_CONV_ESTABLISHED"
    
    Case DMLERR_POKEACKTIMEOUT
      Debug.Print "DMLERR_POKEACKTIMEOUT"
    
    Case DMLERR_POSTMSG_FAILED
      Debug.Print "DMLERR_POSTMSG_FAILED"
    
    Case DMLERR_REENTRANCY
      Debug.Print "DMLERR_REENTRANCY"
    
    Case DMLERR_SERVER_DIED
      Debug.Print "DMLERR_SERVER_DIED"
    
    Case DMLERR_SYS_ERROR
      Debug.Print "DMLERR_SYS_ERROR"
    
    Case DMLERR_UNADVACKTIMEOUT
      Debug.Print "DMLERR_UNADVACKTIMEOUT"
    
    Case DMLERR_UNFOUND_QUEUE_ID
      Debug.Print "DMLERR_UNFOUND_QUEUE_ID"

  End Select
  
End Sub

Private Sub Form_Load()
  Text1.Text = "MyServer"
  Text2.Text = "MyTopic"
  Text3.Text = "Hello Server..."
  Me.Caption = "DDE Client"
  
  Combo1.AddItem "<None>"
  Combo1.AddItem "MyAdvise"
  Combo1.AddItem "MyPoke"
  Combo1.AddItem "MyRequest"
  Combo1.ListIndex = 0
  
  Command1.Caption = "Initialize"
  Command2.Caption = "Execute"
  Command3.Caption = "Poke"
  Command4.Caption = "Request"
  Command5.Caption = "UnInitialize"
  Command6.Caption = "StartAdvice"
  Command7.Caption = "StopAdvice"
  Command8.Caption = "Clear"
  
  Command1.Enabled = True
  Command2.Enabled = False
  Command3.Enabled = False
  Command4.Enabled = False
  Command5.Enabled = False
  Command6.Enabled = False
  Command7.Enabled = False
  Command8.Enabled = False
End Sub

- Add the following code in module1

Click here to copy the following block
Option Explicit

Global g_lInstID As Long
Global g_hService As Long
Global g_hService2 As Long
Global g_hTopic As Long
Global g_hTopic2 As Long
Global g_hItem As Long
Global g_hDDEConv As Long
Global g_hDDEConvList As Long
Global g_hDDEPrevConv As Long
Global g_aryConvID() As Long

' See note in Command4_Click() concerning the magic number.
Public Const MAGIC_NUMBER = 3

'*************************************************************************
' DDEML Return Values
'*************************************************************************
Public Const DMLERR_NO_ERROR = 0
Public Const DMLERR_ADVACKTIMEOUT = &H4000
Public Const DMLERR_BUSY = &H4001
Public Const DMLERR_DATAACKTIMEOUT = &H4002
Public Const DMLERR_DLL_NOT_INITIALIZED = &H4003
Public Const DMLERR_DLL_USAGE = &H4004
Public Const DMLERR_EXECACKTIMEOUT = &H4005
Public Const DMLERR_INVALIDPARAMETER = &H4006
Public Const DMLERR_LOW_MEMORY = &H4007
Public Const DMLERR_MEMORY_ERROR = &H4008
Public Const DMLERR_NOTPROCESSED = &H4009
Public Const DMLERR_NO_CONV_ESTABLISHED = &H400A
Public Const DMLERR_POKEACKTIMEOUT = &H400B
Public Const DMLERR_POSTMSG_FAILED = &H400C
Public Const DMLERR_REENTRANCY = &H400D
Public Const DMLERR_SERVER_DIED = &H400E
Public Const DMLERR_SYS_ERROR = &H400F
Public Const DMLERR_UNADVACKTIMEOUT = &H4010
Public Const DMLERR_UNFOUND_QUEUE_ID = &H4011

'*************************************************************************
' DDEML Flags
'*************************************************************************
Public Const XCLASS_BOOL = &H1000&
Public Const XCLASS_DATA = &H2000&
Public Const XCLASS_FLAGS = &H4000&
Public Const XCLASS_NOTIFICATION = &H8000&
Public Const XTYPF_NOBLOCK = &H2&  ' CBR_BLOCK doesn't seem to work
Public Const XTYP_ADVDATA = (&H10& Or XCLASS_FLAGS)
Public Const XTYP_ADVREQ = (&H20& Or XCLASS_DATA Or XTYPF_NOBLOCK)
Public Const XTYP_ADVSTART = (XCLASS_BOOL Or &H30&)
Public Const XTYP_ADVSTOP = (XCLASS_NOTIFICATION Or &H40&)
Public Const XTYP_CONNECT = (XCLASS_BOOL Or &H60& Or XTYPF_NOBLOCK)
Public Const XTYP_CONNECT_CONFIRM = (XCLASS_NOTIFICATION Or &H70& Or XTYPF_NOBLOCK)
Public Const XTYP_DISCONNECT = (XCLASS_NOTIFICATION Or &HC0& Or XTYPF_NOBLOCK)
Public Const XTYP_ERROR = (XCLASS_NOTIFICATION Or &H0& Or XTYPF_NOBLOCK)
Public Const XTYP_EXECUTE = (XCLASS_FLAGS Or &H50&)
Public Const XTYP_MASK = &HF0&
Public Const XTYP_MONITOR = (XCLASS_NOTIFICATION Or &HF0& Or XTYPF_NOBLOCK)
Public Const XTYP_POKE = (XCLASS_FLAGS Or &H90&)
Public Const XTYP_REGISTER = (XCLASS_NOTIFICATION Or &HA0& Or XTYPF_NOBLOCK)
Public Const XTYP_REQUEST = (XCLASS_DATA Or &HB0&)
Public Const XTYP_SHIFT = 4 ' shift to turn XTYP_ into an index
Public Const XTYP_UNREGISTER = (XCLASS_NOTIFICATION Or &HD0& Or XTYPF_NOBLOCK)
Public Const XTYP_WILDCONNECT = (XCLASS_DATA Or &HE0& Or XTYPF_NOBLOCK)
Public Const XTYP_XACT_COMPLETE = (XCLASS_NOTIFICATION Or &H80&)
Public Const CP_WINANSI = 1004   ' Default codepage for DDE conversations.
Public Const CP_WINUNICODE = 1200
Public Const CF_TEXT = 1
Public Const CBF_SKIP_ALLNOTIFICATIONS = &H3C0000
Public Const APPCLASS_MONITOR = &H1
Public Const APPCMD_CLIENTONLY = &H10&
Public Const MF_CALLBACKS = &H8000000
Public Const MF_CONV = &H40000000
Public Const MF_ERRORS = &H10000000
Public Const MF_HSZ_INFO = &H1000000
Public Const MF_LINKS = &H20000000
Public Const MF_POSTMSGS = &H4000000
Public Const MF_SENDMSGS = &H2000000
Public Const TIMEOUT_ASYNC = &HFFFF
Public Const QID_SYNC = &HFFFF
Public Const DDE_FACK = &H8000
Public Const DDE_FBUSY = &H4000
Public Const DDE_FNOTPROCESSED = &H0
Public Const EC_ENABLEALL = 0

'*************************************************************************
' DDEML Type Declarations
'*************************************************************************
Public Type SECURITY_QUALITY_OF_SERVICE
  Length As Long
  Impersonationlevel As Integer
  ContextTrackingMode As Integer
  EffectiveOnly As Long
End Type

Public Type CONVCONTEXT
  cb As Long
  wFlags As Long
  wCountryID As Long
  iCodePage As Long
  dwLangID As Long
  dwSecurity As Long
  qos As SECURITY_QUALITY_OF_SERVICE
End Type

Public Type CONVINFO
  cb As Long
  hUser As Long
  hConvPartner As Long
  hszSvcPartner As Long
  hszServiceReq As Long
  hszTopic As Long
  hszItem As Long
  wFmt As Long
  wType As Long
  wStatus As Long
  wConvst As Long
  wLastError As Long
  hConvList As Long
  ConvCtxt As CONVCONTEXT
  hwnd As Long
  hwndPartner As Long
End Type

'*************************************************************************
' DDEML Function Declarations
'*************************************************************************
Public Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" _
  (pidInst As Long, _
  ByVal pfnCallback As Long, _
  ByVal afCmd As Long, _
  ByVal ulRes As Long) As Integer
  
' Removed the alias.
Public Declare Function DdeUninitialize Lib "user32" _
  (ByVal idInst As Long) As Long
  
' Removed the alias.
Public Declare Function DdeConnect Lib "user32" _
  (ByVal idInst As Long, _
  ByVal hszService As Long, _
  ByVal hszTopic As Long, _
  pCC As Any) As Long
  
' Removed the alias.
Public Declare Function DdeDisconnect Lib "user32" _
  (ByVal hConv As Long) As Long
  
Public Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" _
  (ByVal idInst As Long, _
  ByVal psz As String, _
  ByVal iCodePage As Long) As Long
  
' Removed the alias.
Public Declare Function DdeFreeStringHandle Lib "user32" _
  (ByVal idInst As Long, _
  ByVal hsz As Long) As Long
      
' Removed the alias and changed the first parameter from "ByRef pData as Byte"
' to "ByVal pData as String".
Public Declare Function DdeClientTransaction Lib "user32" _
  (ByVal pData As String, _
  ByVal cbData As Long, _
  ByVal hConv As Long, _
  ByVal hszItem As Long, _
  ByVal wFmt As Long, _
  ByVal wType As Long, _
  ByVal dwTimeout As Long, _
  pdwResult As Long) As Long
  
' The API loader provides an alias of "DdeGetDataA" for this function.
' You need to remove it because the DLL entry point can't be found for
' the alias.
Public Declare Function DdeGetData Lib "user32" _
  (ByVal hData As Long, _
  ByVal pDst As String, _
  ByVal cbMax As Long, _
  ByVal cbOff As Long) As Long

Public Declare Function DdeQueryConvInfo Lib "user32" _
  (ByVal hConv As Long, _
  ByVal idTransaction As Long, _
  pConvInfo As CONVINFO) As Long

Public Declare Function DdeQueryNextServer Lib "user32" _
  (ByVal hConvList As Long, _
  ByVal hConvPrev As Long) As Long

Public Declare Function DdeConnectList Lib "user32" _
  (ByVal idInst As Long, _
  ByVal hszService As Long, _
  ByVal hszTopic As Long, _
  ByVal hConvList As Long, _
  pCC As CONVCONTEXT) As Long

Public Declare Function DdeDisconnectList Lib "user32" _
  (ByVal hConvList As Long) As Long

Public Declare Function DdeQueryString Lib "user32" _
  Alias "DdeQueryStringA" _
  (ByVal idInst As Long, _
  ByVal hsz As Long, _
  ByVal psz As String, _
  ByVal cchMax As Long, _
  ByVal iCodePage As Long) As Long

' Removed the alias.
Public Declare Function DdeFreeDataHandle Lib "user32" _
  (ByVal hData As Long) As Long

' Removed the alias.
Public Declare Function DdeGetLastError Lib "user32" _
  (ByVal idInst As Long) As Long

Public Declare Function DdeEnableCallback Lib "user32" _
  (ByVal idInst As Long, _
  ByVal hConv As Long, _
  ByVal wCmd As Long) As Long

Public Function DDECallback(ByVal uType As Long, ByVal uFmt As Long, ByVal hConv As Long, ByVal hszString1 As Long, ByVal hszString2 As Long, ByVal hData As Long, ByVal dwData1 As Long, ByVal dwData2 As Long) As Long
  
Dim lSize As Long
Dim sBuffer As String
Dim Ret As Long
  
  Debug.Print "In client callback. uType: " & uType
  
  Select Case uType
    
    ' This is th eevent you'll receive when a server sends you a advisment.
    Case XTYP_ADVDATA
      Debug.Print "XTYP_ADVDATA"
      
      lSize = DdeGetData(hData, vbNullString, 0, 0)
      
      ' If size is 0 then there's no data to grab.
      If (lSize > 0) Then
        
        ' Allocate a buffer for the return data.
        sBuffer = String$(lSize - MAGIC_NUMBER, 0)
              
        ' Grab the data.
        lSize = DdeGetData(hData, sBuffer, Len(sBuffer), 0)
  
        ' Print the contents of the buffer.
        Form1.Text3.Text = sBuffer
      End If
      
    Case XTYP_ADVSTART
      Debug.Print "XTYP_ADVSTART"
      
    Case XTYP_ADVSTOP
      Debug.Print "XTYP_ADVSTOP"
    
    Case XTYP_CONNECT
      Debug.Print "XTYP_CONNECT"
      
    Case XTYP_CONNECT_CONFIRM
      Debug.Print "XTYP_CONNECT_CONFIRM"
      
    Case XTYP_DISCONNECT
      Debug.Print "XTYP_DISCONNECT"
      
    Case XTYP_ERROR
      Debug.Print "XTYP_ERROR"
      
    Case XTYP_EXECUTE
      Debug.Print "XTYP_EXECUTE"
      
    Case XTYP_MASK
      Debug.Print "XTYP_MASK"
      
    Case XTYP_MONITOR
      Debug.Print "XTYP_MONITOR"
      
    Case XTYP_POKE
      Debug.Print "XTYP_POKE"
      
    Case XTYP_REGISTER
      Debug.Print "XTYP_REGISTER"
      g_hService2 = hszString2
      
      lSize = DdeQueryString(g_lInstID, hszString2, vbNullString, 0, CP_WINANSI)
      sBuffer = Space(lSize)
      DdeQueryString g_lInstID, hszString2, sBuffer, lSize + 1, CP_WINANSI

      sBuffer = UCase(sBuffer)
      
    Case XTYP_REQUEST
      Debug.Print "XTYP_REQUEST"
      
    Case XTYP_SHIFT
      Debug.Print "XTYP_SHIFT"
      
    Case XTYP_UNREGISTER
      Debug.Print "XTYP_UNREGISTER"
      
    Case XTYP_WILDCONNECT
      Debug.Print "XTYP_WILDCONNECT"
      
    Case XTYP_XACT_COMPLETE
      Debug.Print "XTYP_XACT_COMPLETE"
        
  End Select
  
  DDECallback = 0

End Function

- Now compile the project and run the DDEServer.exe and then run DDEClient.exe

In this version of DDE Client I have added few commands for demo which our DDE Server understands.

Here is the description of each option (Select this command from combo box)

: This command will enable execute command button. For demo purpose I have added "MIN", "MAX" and "NORMAL" commands which DDL Server can understand. Just type any of these commands in the Data textbox and then press execute and see what server does to respond your command.

MyRequest : Clicking on Request button will request data from server and displays in the textbox on client side

MyPoke : This is just demo of sending data to the server. Try to enter some text in Text3 and then press Poke. Now check the server window, your text should appear in server data textbox.

MyAdvise : This command will start Advisory request from DDE server means server will send data to client when its available/changed.

Goto Previous Article : Interprocess communication using DDE (Dynamic Data Exchange) - Part1


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.