进程内组件ActiveX.DLL与其它应用程序通过DDE通信

进程内组件是无法直接使用DDE通信的，设置Text1.LinkMode时就会错误

后来我想了一个办法：使用进程内组件引用一个进程外组件，然后通过进程外组件与其它应用程序通信，以下是源码

 

窗体：

VERSION 5.00
Begin VB.Form DDEC
   Caption         =   "DDEC"
   ClientHeight    =   1365
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4245
   LinkMode        =   1  'Source
   LinkTopic       =   "DDEC"
   ScaleHeight     =   1365
   ScaleWidth      =   4245
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2
      Height          =   375
      Left            =   480
      MultiLine       =   -1  'True
      TabIndex        =   1
      Text            =   "DDEC.frx":0000
      Top             =   840
      Width           =   2655
   End
   Begin VB.TextBox Text1
      Height          =   375
      Left            =   480
      MultiLine       =   -1  'True
      TabIndex        =   0
      Text            =   "DDEC.frx":0006
      Top             =   360
      Width           =   2655
   End
End
Attribute VB_Name = "DDEC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public xApp As Object
Public sSerName As String, sLinkItem As String
Public sDebug As Boolean
Private Sub Form_LinkExecute(CmdStr As String, Cancel As Integer)
On Error GoTo Err_
    If xApp Is Nothing Then Exit Sub
    xApp.DDECmd_ CmdStr
    Cancel = 0
Err_: If DDEC.sDebug And Err <> 0 Then MsgBox Err.Number & Err.Description & vbCrLf & CmdStr, vbCritical, "ZBSDDE"
End Sub
Private Sub Text2_LinkNotify()
On Error GoTo Err_
    Text2.LinkRequest
    If xApp Is Nothing Then Exit Sub
    If Not (Text2 Like "STATUS ") Then xApp.DDECmd_ Text2.Text
Err_: If DDEC.sDebug And Err <> 0 Then MsgBox Err.Number & Err.Description, vbCritical, "ZBSDDE"
End Sub

 

以下是类模块

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ZBSDDECLS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Sub Class_Initialize()
    Load DDEC
End Sub
Sub Init(O As Object, Optional SerName As String = "zbsedit|editform", Optional LinkItem As String = "Text1")
   On Error GoTo Err_
   Set DDEC.xApp = O
   DDEC.sSerName = SerName
   DDEC.sLinkItem = LinkItem
Err_: If Err <> 0 Then MsgBox Err.Description, vbCritical, "ZBSDDEInit"
End Sub
Sub DebugToggle(Flag As Boolean)
    DDEC.sDebug = Flag
End Sub
Private Function InitSend() As Boolean '建立连接
    On Error GoTo Err_
    If DDEC.sSerName <> "" Then
        DDEC.Text2.LinkMode = 0
        DDEC.Text2.LinkTopic = DDEC.sSerName
        DDEC.Text2.LinkItem = DDEC.sLinkItem
        DDEC.Text2.LinkMode = 3
        DoEvents
        InitSend = True
    End If
Err_: If DDEC.sDebug And Err <> 0 Then MsgBox Err.Description, vbCritical, "ZBSDDE"
End Function
Function Send(CmdStr As String) As Integer   '发送命令
On Error GoTo Err_
    If DDEC.sSerName = "" Then
        MsgBox "DDE初始化错误，先用Init AppObject,sername初始化", vbCritical
        Exit Function
    End If
    If DDEC.Text2.LinkMode = 0 Then InitSend
    If DDEC.Text2.LinkMode <> 0 Then
       DDEC.Text2.LinkExecute CmdStr
       DoEvents
       If DDEC.Text2 Like "STATUS *" Then Send = Val(Mid(DDEC.Text2, 9))
    End If
Err_: If DDEC.sDebug And Err <> 0 Then MsgBox Err.Number & Err.Description, vbCritical, "ZBSDDESend"
End Function
Function NotifyClient(strCmd As String)
    DDEC.Text1 = strCmd
End Function
Private Sub Class_Terminate()
    Unload DDEC
End Sub

 

将以上代码编译成ActiveX.EXE文件，既能做为DDE服务器，又能做DDE客户端使用

 

使用方法:

   在DLL组件中引用以上进程外组件，然后使用init初始化，使用Send发送命令到服务器，用DDECMD接收服务器通知的命令

如果作为服务器使用，DDECMD能接收客户端的请求，使用NotifyClient能通知客户端数据更新。