DDE在vb.net中的应用

版权声明:本文为博主原创文章,遵循 CC 4.0 by-sa 版权协议,转载请附上原文出处链接和本声明。
本文链接:https://blog.csdn.net/lgs790709/article/details/79005966
李国帅

(对以前的文件做些补充,顺便编辑一下。)
随便罗嗦几句,自己已经好几年没有写什么东西了,而自己已经从事这一行好久了,希望能提供一些东西给大家,好与坏无所谓。

很早的时候做过DDE方面的程序,那是在2005年刚来深圳的时候,公司的一个产品需要在excel中动态显示数据,临时做了这么个东西,
那个产品是vb.net做的,因此就现在vc下面测试后移到vb中应用,还真的成功了。但是时间不经意间已经过去6年时间了,
自己早已经不再涉及vb的东西,看到有个朋友提到这方面的东西向我咨询,于是有了把自己的那个程序拿出来,希望能够对需要的人一点帮助。

逻辑流程


image

相关文件

image

其中ddeTerminal.vb包含核心类ExcelDDE,作用如下:
1从excel中生成的字符串,我要把这个字符串交给ps程序 
2、ps返回的字符串,我要解析这个字符串, 
3、取出与item值相互对应的值,放回excel的对应cell 

相关代码详情


DDE 的步骤就不用列出了,网上很多,也能从代码中了解到。用到的函数如下

ddeWin32.vb


Public Class DDEML 

    '************************************************************************* 
    '    created:    2005/08/03 
    '    created:    3:8:2005   15:31 
    '    filename:     D:/vbdde/Win32.vb 
    '    file path:    D:/vbdde 
    '    file base:    Win32 
    '    file ext:    vb 
    '    author:        Peter 
    '    
    '    purpose:    
    '   This code Class contains all of the DDEML declarations that I use throughout 
    '   the application. I've tried to comment any declaration/type changes I've made. 
    '************************************************************************* 

    '************************************************************************* 
    ' DDEML Return Values 
    '************************************************************************* 
    Public Const DMLERR_NO_ERROR As Short = 0 
    Public Const DMLERR_ADVACKTIMEOUT As Short = &H4000S 
    Public Const DMLERR_BUSY As Short = &H4001S 
    Public Const DMLERR_DATAACKTIMEOUT As Short = &H4002S 
    Public Const DMLERR_DLL_NOT_INITIALIZED As Short = &H4003S 
    Public Const DMLERR_DLL_USAGE As Short = &H4004S 
    Public Const DMLERR_EXECACKTIMEOUT As Short = &H4005S 
    Public Const DMLERR_INVALIDPARAMETER As Short = &H4006S 
    Public Const DMLERR_LOW_MEMORY As Short = &H4007S 
    Public Const DMLERR_MEMORY_ERROR As Short = &H4008S 
    Public Const DMLERR_NOTPROCESSED As Short = &H4009S 
    Public Const DMLERR_NO_CONV_ESTABLISHED As Short = &H400AS 
    Public Const DMLERR_POKEACKTIMEOUT As Short = &H400BS 
    Public Const DMLERR_POSTMSG_FAILED As Short = &H400CS 
    Public Const DMLERR_REENTRANCY As Short = &H400DS 
    Public Const DMLERR_SERVER_DIED As Short = &H400ES 
    Public Const DMLERR_SYS_ERROR As Short = &H400FS 
    Public Const DMLERR_UNADVACKTIMEOUT As Short = &H4010S 
    Public Const DMLERR_UNFOUND_QUEUE_ID As Short = &H4011S 

    '************************************************************************* 
    ' DDEML Flags 
    '************************************************************************* 
    Public Const XCLASS_BOOL As Short = &H1000S 
    Public Const XCLASS_DATA As Short = &H2000S 
    Public Const XCLASS_FLAGS As Short = &H4000S 
    Public Const XTYPF_NOBLOCK As Short = &H2S ' CBR_BLOCK doesn't seem to work 

    Public Const XTYP_CONNECT As Integer = &H60S Or XCLASS_BOOL Or XTYPF_NOBLOCK 
    Public Const XTYP_DISCONNECT As Integer = (&HC0 Or XCLASS_NOTIFICATION Or XTYPF_NOBLOCK) 
    Public Const XTYP_CONNECT_CONFIRM As Integer = (&H70 Or XCLASS_NOTIFICATION Or XTYPF_NOBLOCK) 
    Public Const XTYP_WILDCONNECT As Integer = (&HE0 Or XCLASS_DATA Or XTYPF_NOBLOCK) 
    Public Const XTYP_EXECUTE As Integer = (&H50S Or XCLASS_FLAGS) 
    Public Const XTYP_REQUEST As Integer = (&HB0S Or XCLASS_DATA) 
    Public Const XTYP_POKE As Integer = (&H90S Or XCLASS_FLAGS) 
    Public Const XTYP_ERROR As Integer = (&H0 Or XCLASS_NOTIFICATION Or XTYPF_NOBLOCK) 
    Public Const XTYP_REGISTER As Integer = (&HA0 Or XCLASS_NOTIFICATION Or XTYPF_NOBLOCK) 
    Public Const XTYP_UNREGISTER As Integer = (&HD0 Or XCLASS_NOTIFICATION Or XTYPF_NOBLOCK) 

    Public Const XTYP_ADVDATA As Integer = (&H10 Or XCLASS_FLAGS) 
    Public Const XTYP_ADVSTART As Integer = (&H30 Or XCLASS_BOOL) 
    Public Const XTYP_ADVREQ As Integer = (&H20 Or XCLASS_DATA Or XTYPF_NOBLOCK) 
    Public Const XTYP_ADVSTOP As Integer = (&H40 Or XCLASS_NOTIFICATION) 

    Public Const XTYP_MASK As Integer = &HF0 
    Public Const XTYP_MONITOR As Integer = (XCLASS_NOTIFICATION Or &HF0 Or XTYPF_NOBLOCK) 
    Public Const XTYP_SHIFT As Short = 4 '  shift to turn XTYP_ into an index 
    Public Const XTYP_XACT_COMPLETE As Integer = (XCLASS_NOTIFICATION Or &H80) 

    Public Const CP_WINANSI As Short = 1004 ' Default codepage for DDE conversations. 
    Public Const CP_WINUNICODE As Short = 1200 
    Public Const DNS_REGISTER As Short = &H1S 
    Public Const DNS_UNREGISTER As Short = &H2S 
    Public Const DDE_FACK As Short = &H8000S 
    Public Const DDE_FBUSY As Short = &H4000S 
    Public Const DDE_FNOTPROCESSED As Short = &H0S 

    Public Const XCLASS_NOTIFICATION = &H8000 
    Public Const APPCLASS_STANDARD = &H0& 
    Public Const APPCMD_CLIENTONLY = &H10& 
    Public Const APPCLASS_MONITOR As Short = &H1S 
    Public Const SW_SHOWNORMAL = 1 

    '************************************************************************* 
    ' DDEML Function Declarations 
    '************************************************************************* 
    'auto as charset''''''''pfnCallback is callback function 
    Public Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (ByRef pidInst As Integer, ByVal pfnCallback As DDECallBackDelegate, ByVal afCmd As Integer, ByVal ulRes As Integer) As Short 

    Public Declare Function DdeUninitialize Lib "user32" Alias "DdeUninitialize" (ByVal idInst As Integer) As Integer 

    Public Declare Function DdeNameService Lib "user32" Alias "DdeNameService" (ByVal idInst As Integer, ByVal hsz1 As Integer, ByVal hsz2 As Integer, ByVal afCmd As Integer) As Integer 

    Public Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" _ 
   (ByVal idInst As Integer, ByVal psz As String, ByVal iCodePage As Integer) As Integer 

    Public Declare Function DdeFreeStringHandle Lib "user32" Alias "DdeFreeStringHandle" _ 
    (ByVal idInst As Integer, ByVal hsz As Integer) As Integer 

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

    Public Declare Function DdeCmpStringHandles Lib "user32" Alias "DdeCmpStringHandles" _ 
    (ByVal hsz1 As Integer, ByVal hsz2 As Integer) As Integer 

    ' Removed the alias and changed the pSrc parameter from "ByVal pSrc as Byte" 
    ' to "ByVal pSrc as String". 
    Public Declare Function DdeCreateDataHandle Lib "user32" _ 
    (ByVal idInst As Integer, ByVal pSrc As String, ByVal cb As Integer, ByVal cbOff As Integer, ByVal hszItem As Integer, ByVal wFmt As Integer, ByVal afCmd As Integer) As Integer 

    Public Declare Function DdeFreeDataHandle Lib "user32" Alias "DdeFreeDataHandle" (ByVal hData As Integer) As Integer 

    Public Declare Function DdeGetLastError Lib "user32" Alias "DdeGetLastError" (ByVal idInst As Integer) As Integer 

    Public Declare Function DdePostAdvise Lib "user32" Alias "DdePostAdvise" _ 
    (ByVal idInst As Integer, ByVal hszTopic As Integer, ByVal hszItem As Integer) As Integer 

    ''' <summary> 
    'dde callback function 
    ''' </summary> 
    Public Delegate Function DDECallBackDelegate( _ 
    ByVal wType As Integer, _ 
    ByVal wFmt As Integer, _ 
    ByVal hConv As Integer, _ 
    ByVal hszTopic As Integer, _ 
    ByVal hszItem As Integer, _ 
    ByVal hData As Integer, _ 
    ByVal lData1 As Integer, _ 
    ByVal lData2 As Integer _ 
            ) As Integer 

End Class

--------------

打包到一个类中

ddeTerminal.vb


Public NotInheritable Class ExcelDDE 
    '************************************************************************* 
    '    created:    2005/08/03 
    '    created:    3:8:2005   16:15 
    '    filename:     D:/vbdde/Win32.vb 
    '    file path:    D:/vbdde 
    '    file base:    Win32 
    '    file ext:    vb 
    '    author:        peter 
    '    
    '    purpose:    This application is programing for provide some dde server. 
    '************************************************************************* 

    '************************************************************************* 
    ' DDEML Server Constants 
    '************************************************************************* 
    ' instance of application 
    ' This is just a string that we'll return whenever a client performs a DDE 
    ' request. 
    'declear server 
    Private Const DDE_SERVER As String = "PS" 

    'declear callback 
    Private _DDECallBack As DDEML.DDECallBackDelegate = Nothing 

    'declear server global variable 
    Private g_lInstID As Integer ' DDE instance identifier. 
    Private g_hszDDEServer As Integer ' String handle for the server name. 

    'Private g_lDDERet As Integer ' Generic return variable. 

    ' other variable. 
    Private g_bRunning As Boolean ' Server running flag. 

    Private g_hDDETopic(-1) As Integer ' String handle for the topic name. {htopic1,htopic1,...} 
    'Private g_strDDETopic(-1) As String 

    Private g_hDDETopicItem(-1) As String ' String handle for the topic name. {{htopic-hitem},...} 
    ' set current topic in "QUOTE, DES, ESTIMATES, FUNDA, HISTORY, FINET" 

    Private g_hDDEConn(-1) As Integer ' 
    '************************************************************************* 
    '    purpose:计时器及传递字符串操作相关 
    '需要3个字符串,1从excel中生成的字符串,我要把这个字符串交给ps程序 
    '2、ps返回的字符串,我要解析这个字符串, 
    '3、取出与item值相互对应的值,放回excel的对应cell 
    ' 
    '************************************************************************* 

    Private m_strTanslate As String = "" '原始传递字符串 
    Private m_strTansWithValue As String = "" '返回含值的字符串 

    Private Sub ClearVariable() 
        'inialize variable 
        g_lInstID = 0 
        g_hszDDEServer = 0 
        g_bRunning = False 

        ReDim g_hDDETopic(-1) 
        ReDim g_hDDETopicItem(-1) 
        ReDim g_hDDEConn(-1) 

        m_strTanslate = "" 
        m_strTansWithValue = "" 
    End Sub 

    Public Sub BeginDDEServer() 

        System.Diagnostics.Debug.WriteLine("-------------- Begin DDE Server Test --------------") 

        ClearVariable() 

        ' Initialize the DDE subsystem. This only needs to be done once. 
        If g_lInstID <> 0 Then EndDDEServer() 

        DDEInitial() 

        'TranslateError() 

        ' set topics in "QUOTE, DES, ESTIMATES, FUNDA, HISTORY, FINET" 
        DDECreateStringHandles("PS") 
        CreateDDETopic("QUOTE")  ',('EUR-FX','last') 
        CreateDDETopic("DES") 
        CreateDDETopic("ESTIMATES") 
        CreateDDETopic("FUNDA") 
        CreateDDETopic("HISTORY") 
        CreateDDETopic("FINET") 

        'TranslateError() 
        DDEServerRegister(g_lInstID, g_hszDDEServer) 

        'TranslateError() 

    End Sub 

    Public Sub CreateDDETopic(ByRef strTopic As String) 
        DDECreateStringHandles("", strTopic) 
    End Sub 

    Public Sub EndDDEServer() 
        'TranslateError() 

        DDEFreeStringHandles() 
        'TranslateError() 

        DDEServerUnregister() 
        'TranslateError() 

        ' Break down the link with the DDE subsystem. 
        DDEUninitialize() 
        'TranslateError() 

        ClearVariable() 
        System.Diagnostics.Debug.WriteLine("------------------- end DDE Server Test -----------------------") 

    End Sub 

    Private Function DDEInitial() As Boolean 
        _DDECallBack = New DDEML.DDECallBackDelegate(AddressOf DDECallBack) 

        Dim ddeinst As Integer 
        'server 
        ddeinst = DDEML.DdeInitialize(g_lInstID, _DDECallBack, DDEML.APPCLASS_STANDARD, 0) 
        If ddeinst = DDEML.XTYP_ERROR Then 
            'If not ddeinst = DDEML.DMLERR_NO_ERROR then 
            System.Diagnostics.Debug.WriteLine("DDE Initialize Failure.") 
            'TranslateError() 
        Else 
            System.Diagnostics.Debug.WriteLine("DDE Initialize Success.") 
        End If 

    End Function 

    Private Sub DDEServerRegister(ByVal lInstID As Integer, ByVal hszDDEServer As Integer) 
        ' Lets check to see if another DDE server has already registered with identical 
        ' server/topic names. If so we'll exit. If we were to continue the DDE subsystem 
        ' could become unstable when a client tried to converse with the server/topic. 

        ' We need to register the server with the DDE subsystem. 
        If (DDEML.DdeNameService(lInstID, hszDDEServer, 0, DDEML.DNS_REGISTER)) Then 
            ' Set the server running flag. 
            g_bRunning = True 
        End If 

    End Sub 

    Private Sub DDEServerUnregister() 

        ' Unregister the DDE server. 
        If g_bRunning Then 
            DDEML.DdeNameService(g_lInstID, g_hszDDEServer, 0, DDEML.DNS_UNREGISTER) 
        End If 

    End Sub 

    '回调函数。 
    Private Function DDECallBack( _ 
            ByVal wType As Integer, _ 
            ByVal wFmt As Integer, _ 
            ByVal hConv As Integer, _ 
            ByVal hszTopic As Integer, _ 
            ByVal hszItem As Integer, _ 
            ByVal hData As Integer, _ 
            ByVal dwData1 As Integer, _ 
            ByVal dwData2 As Integer _ 
            ) As Integer 

        Dim iRet As Integer 
        'System.Diagnostics.Debug.WriteLine("In client callback. uType: " & wType) 

        '''''''''''''''''''''''''''''''''''''''''''conversation 
        Select Case wType 
            Case DDEML.XTYP_CONNECT 
                'System.Diagnostics.Debug.WriteLine("XTYP_CONNECT") 
                ' Just return a positive acknowledgement. If we don't the conversation will 
                ' never be completed between us and the client. 
                ' Client is trying to connect. Respond TRUE if we have what they want...(HDDEDATA)TRUE 
                'At this, we can set condition that define when we pass connection. 
                'They are topics and server we defined above. 
                '检查主题和服务 
                If CheckTopic(hszTopic) = False Or g_hszDDEServer <> hszItem Then 
                    iRet = DDEML.DDE_FNOTPROCESSED 
                End If 

                iRet = DDEML.DDE_FACK 

            Case DDEML.XTYP_CONNECT_CONFIRM 
                If Not CheckConn(hConv) And hConv <> 0 Then 
                    ReDim Preserve g_hDDEConn(g_hDDEConn.Length) 
                    g_hDDEConn(g_hDDEConn.Length - 1) = hConv 
                End If 

                'System.Diagnostics.Debug.WriteLine("XTYP_CONNECT_CONFIRM") 

            Case DDEML.XTYP_DISCONNECT 
                If g_hDDEConn.Length > 0 Then 
                    Array.Clear(g_hDDEConn, Array.IndexOf(g_hDDEConn, hConv), 1) 
                End If 
                System.Diagnostics.Debug.WriteLine("XTYP_DISCONNECT") 

                'advise loop begin 
            Case DDEML.XTYP_ADVSTART 

                ' Client starting advisory loop. 
                ' Say "ok" if we have what they are asking for... 
                'System.Diagnostics.Debug.WriteLine("XTYP_ADVSTART") 

                ' 建议启动事务,当有一个Item被改变时,它就会启动一个建议循环 
                '我把它用作添加传递字符串子项的条件 
                '这时候,hszItemName被从excel中返回,经过在vc中测试,千真万确。 

                Dim topic As String 
                Dim item As String 
                topic = getStringFromHandle(hszTopic) 
                item = getStringFromHandle(hszItem) 

                If (Not item.Equals("StdDocumentName")) Then 
                    If Not CheckTopicItem(hszTopic, hszItem) And CheckConn(hConv) Then 
                        ReDim Preserve g_hDDETopicItem(g_hDDETopicItem.Length) 
                        g_hDDETopicItem(g_hDDETopicItem.Length - 1) = hszTopic.ToString + "-" + hszItem.ToString 
                    End If 
                    AddItemToTansString(DDE_SERVER, topic, item) 
                    iRet = DDEML.DDE_FACK 
                End If 

                'advise loop end 
            Case DDEML.XTYP_ADVSTOP 
                ' Client stopping advisory loop. 
                ' Say "ok" if we have what they are asking for... 
                'System.Diagnostics.Debug.WriteLine("XTYP_ADVSTOP") 

                Dim topic As String 
                Dim item As String 
                topic = getStringFromHandle(hszTopic) 
                item = getStringFromHandle(hszItem) 

                If Not item.Equals("StdDocumentName") Then 
                    ''    If g_hDDETopicItem.Length > 0 Then 
                    ''        Array.Clear(g_hDDETopicItem, Array.IndexOf(g_hDDETopicItem, hszTopic.ToString + "-" + hszItem.ToString), 1) 
                    ''    End If 
                    '清空 g_hDDETopicItem 
                    DelItemToTansString(DDE_SERVER, topic, item) 
                    iRet = DDEML.DDE_FACK 
                End If 

                'Case DDEML.XTYP_ERROR 
                '        System.Diagnostics.Debug.WriteLine("XTYP_ERROR") 

                'Case DDEML.XTYP_EXECUTE 
                '        ' Process the execute transaction. 
                '        System.Diagnostics.Debug.WriteLine("XTYP_EXECUTE") 

                'Case DDEML.XTYP_MASK 
                '        System.Diagnostics.Debug.WriteLine("XTYP_MASK") 

                'Case DDEML.XTYP_MONITOR 
                '        System.Diagnostics.Debug.WriteLine("XTYP_MONITOR") 

                'Case DDEML.XTYP_POKE 
                '        ' Process the poke request. 
                '        System.Diagnostics.Debug.WriteLine("XTYP_POKE") 

                'Case DDEML.XTYP_REGISTER 
                '        System.Diagnostics.Debug.WriteLine("XTYP_REGISTER") 

                'Case DDEML.XTYP_REQUEST 
                '        ' Process the request transaction. 
                '        System.Diagnostics.Debug.WriteLine("XTYP_REQUEST") 

                'Case DDEML.XTYP_SHIFT 
                '        System.Diagnostics.Debug.WriteLine("XTYP_SHIFT") 

                'Case DDEML.XTYP_UNREGISTER 
                '        System.Diagnostics.Debug.WriteLine("XTYP_UNREGISTER") 

                'Case DDEML.XTYP_WILDCONNECT 
                '        '''wildconnect is inefficient,and I will use it laterly. 
                '        System.Diagnostics.Debug.WriteLine("XTYP_WILDCONNECT") 

                'Case DDEML.XTYP_XACT_COMPLETE 
                '        System.Diagnostics.Debug.WriteLine("XTYP_XACT_COMPLETE") 
            Case DDEML.XTYP_ADVREQ 
                    'System.Diagnostics.Debug.WriteLine("XTYP_ADVREQ") 
                    Dim strCellValue As String = "" 
                    Dim iItemIndex As Integer 
                    While iItemIndex < g_hDDETopicItem.Length 
                        If g_hDDETopicItem(iItemIndex).StartsWith(hszTopic.ToString() + "-" + hszItem.ToString() + "&") Then 
                            strCellValue = g_hDDETopicItem(iItemIndex).Substring(g_hDDETopicItem(iItemIndex).IndexOf("&") + 1).TrimEnd() 
                            g_hDDETopicItem(iItemIndex) = g_hDDETopicItem(iItemIndex).Substring(0, g_hDDETopicItem(iItemIndex).IndexOf("&")) 
                            Exit While 
                        End If 
                        iItemIndex += 1 
                    End While 

                    If strCellValue.Length > 0 Then 

                        Dim strTrans As String = strCellValue 
                        Dim iStrLen = System.Text.Encoding.GetEncoding("GB2312").GetByteCount(strTrans) 
                        Dim xltableString As String = "" 

                        'tdtTable record... 
                        xltableString += Convert.ToChar(&H10) + Convert.ToChar(&H0) + Convert.ToChar(&H4) + Convert.ToChar(&H0) + _ 
                                         Convert.ToChar(&H1) + Convert.ToChar(&H0) + Convert.ToChar(&H1) + Convert.ToChar(&H0) + _ 
                                         Convert.ToChar(&H2) + Convert.ToChar(&H0) + Convert.ToChar(iStrLen) + Convert.ToChar(&H0) _ 
                                        + Convert.ToChar(iStrLen) 

                        'tdtString record... 
                        xltableString += strTrans 

                        Dim encoding As System.Text.Encoding = System.Text.Encoding.UTF8 
                        Dim encodedBytes() As Byte = encoding.GetBytes(xltableString) 
                        xltableString = encoding.GetString(encodedBytes) 

                        iRet = DDEML.DdeCreateDataHandle(g_lInstID, xltableString, 13 + iStrLen, 0, hszItem, wFmt, 0) 'wfmt=49772 
                        'TranslateError() 
                    End If 
        End Select 

        ' Set the final callback return. 
        DDECallBack = iRet 

    End Function 

    Private Sub TranslateError() 

        Dim iRet As Integer 

        iRet = DDEML.DdeGetLastError(g_lInstID) 

        Select Case iRet 
            Case DDEML.DMLERR_NO_ERROR 
                System.Diagnostics.Debug.WriteLine("DMLERR_NO_ERROR") 

            Case DDEML.DMLERR_ADVACKTIMEOUT 
                System.Diagnostics.Debug.WriteLine("DMLERR_ADVACKTIMEOUT") 

            Case DDEML.DMLERR_BUSY 
                System.Diagnostics.Debug.WriteLine("DMLERR_BUSY") 

            Case DDEML.DMLERR_DATAACKTIMEOUT 
                System.Diagnostics.Debug.WriteLine("DMLERR_DATAACKTIMEOUT") 

            Case DDEML.DMLERR_DLL_NOT_INITIALIZED 
                System.Diagnostics.Debug.WriteLine("DMLERR_NOT_INITIALIZED") 

            Case DDEML.DMLERR_DLL_USAGE 
                System.Diagnostics.Debug.WriteLine("DMLERR_USAGE") 

            Case DDEML.DMLERR_EXECACKTIMEOUT 
                System.Diagnostics.Debug.WriteLine("DMLERR_EXECACKTIMEOUT") 

            Case DDEML.DMLERR_INVALIDPARAMETER 
                System.Diagnostics.Debug.WriteLine("DMLERR_INVALIDPARAMETER") 

            Case DDEML.DMLERR_LOW_MEMORY 
                System.Diagnostics.Debug.WriteLine("DMLERR_LOW_MEMORY") 

            Case DDEML.DMLERR_MEMORY_ERROR 
                System.Diagnostics.Debug.WriteLine("DMLERR_MEMORY_ERROR") 

            Case DDEML.DMLERR_NOTPROCESSED 
                System.Diagnostics.Debug.WriteLine("DMLERR_NOTPROCESSED") 

            Case DDEML.DMLERR_NO_CONV_ESTABLISHED 
                System.Diagnostics.Debug.WriteLine("DMLERR_NO_CONV_ESTABLISHED") 

            Case DDEML.DMLERR_POKEACKTIMEOUT 
                System.Diagnostics.Debug.WriteLine("DMLERR_POKEACKTIMEOUT") 

            Case DDEML.DMLERR_POSTMSG_FAILED 
                System.Diagnostics.Debug.WriteLine("DMLERR_POSTMSG_FAILED") 

            Case DDEML.DMLERR_REENTRANCY 
                System.Diagnostics.Debug.WriteLine("DMLERR_REENTRANCY") 

            Case DDEML.DMLERR_SERVER_DIED 
                System.Diagnostics.Debug.WriteLine("DMLERR_SERVER_DIED") 

            Case DDEML.DMLERR_SYS_ERROR 
                System.Diagnostics.Debug.WriteLine("DMLERR_SYS_ERROR") 

            Case DDEML.DMLERR_UNADVACKTIMEOUT 
                System.Diagnostics.Debug.WriteLine("DMLERR_UNADVACKTIMEOUT") 

            Case DDEML.DMLERR_UNFOUND_QUEUE_ID 
                System.Diagnostics.Debug.WriteLine("DMLERR_UNFOUND_QUEUE_ID") 

        End Select 

    End Sub 

    Private Sub DDEUninitialize() 

        ' Tear down the initialized instance. 
        If g_lInstID <> 0 Then 
            If DDEML.DdeUninitialize(g_lInstID) Then 
                System.Diagnostics.Debug.WriteLine("DDE Uninitialize Success.") 
            Else 
                System.Diagnostics.Debug.WriteLine("DDE Uninitialize Failure.") 
                'TranslateError() 
            End If 

            g_lInstID = 0 
        End If 

        'System.Diagnostics.Debug.WriteLine("-------------------- End DDE Test ------------------------") 

    End Sub 

    Private Function getStringFromHandle(ByVal hData As Integer) As String 
        '/********************* 
        Dim iCount As Integer 
        Dim sBuffer As String 

        ' What's the size of the string? 
        iCount = DDEML.DdeQueryString(g_lInstID, hData, vbNullString, 0, DDEML.CP_WINANSI) 
        ' Allocate space for the string. 
        sBuffer = Space(iCount) 
        ' Grab the string. 
        DDEML.DdeQueryString(g_lInstID, hData, sBuffer, iCount + 10, DDEML.CP_WINANSI) 
        getStringFromHandle = sBuffer 
        '/********************* 

    End Function 

    Private Sub DdePostAdv(ByVal idInst As Integer, ByVal hszTopicName As Integer, ByVal hszItem As Integer) 

        If idInst <> 0 And hszTopicName > 0 And hszItem > 0 Then 
            DDEML.DdePostAdvise(g_lInstID, hszTopicName, hszItem) 
            'TranslateError() 
        End If 

    End Sub 

    Private Sub DDECreateStringHandles(Optional ByRef sTheService As String = "", Optional ByRef sTheTopic 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. 
        ' Now that the DDEML subsystem is initialized we create string handles for our 
        ' server/topic name. 

        If (g_lInstID <> 0) Then 
            If (sTheService <> "") Then 
                g_hszDDEServer = DDEML.DdeCreateStringHandle(g_lInstID, sTheService, DDEML.CP_WINANSI) 
                If g_hszDDEServer = 0 Then 
                    MsgBox("Creating serverName is failed!", MsgBoxStyle.OKOnly) 
                End If 
            End If 

            If (sTheTopic <> "") Then 
                Dim hTopicTemp As Integer = DDEML.DdeCreateStringHandle(g_lInstID, sTheTopic, DDEML.CP_WINANSI) 
                If Not CheckTopic(hTopicTemp) And hTopicTemp <> 0 Then 
                    ReDim Preserve g_hDDETopic(g_hDDETopic.Length) 
                    g_hDDETopic(g_hDDETopic.Length - 1) = hTopicTemp 
                Else 
                    MsgBox("Creating topic is failed!", MsgBoxStyle.OKOnly) 'DdeCreateStringHandle(topicName) failed 
                End If 
            End If 
        End If 

    End Sub 

    Private Sub DDEFreeStringHandles() 

        ' We need to release our string handles. 
        ' Release our string handles. 

        If (g_hszDDEServer <> 0) Then 
            DDEML.DdeFreeStringHandle(g_lInstID, g_hszDDEServer) 
            g_hszDDEServer = 0 
        End If 

        Dim i As Integer = 0 
        While i < g_hDDETopic.Length 
            If g_hDDETopic(i) <> 0 Then 
                DDEML.DdeFreeStringHandle(g_lInstID, g_hDDETopic(i)) 
                g_hDDETopic(i) = 0 
            End If 
            i += 1 
        End While 

    End Sub 

    Private Function CheckTopic(ByVal hTopic As Integer) As Boolean 
        ' set current topic in "QUOTE, DES, ESTIMATES, FUNDA, HISTORY, FINET" 
        Dim bRet As Boolean = False 
        Dim oTopic As Object 
        oTopic = hTopic 

        If Array.BinarySearch(g_hDDETopic, oTopic) >= 0 Then 
            bRet = True 
        End If 

        CheckTopic = bRet 
    End Function 

    Private Function CheckConn(ByVal hConn As Integer) As Boolean 
        ' set current topic in "QUOTE, DES, ESTIMATES, FUNDA, HISTORY, FINET" 
        Dim bRet As Boolean = False 
        Dim oConn As Object 
        oConn = hConn 
        If Array.BinarySearch(g_hDDEConn, oConn) >= 0 Then 
            bRet = True 
        End If 

        CheckConn = bRet 
    End Function 

    Private Function CheckTopicItem(ByVal hTopic As Integer, ByVal hItem As Integer) As Integer 
        ' set current topic in "QUOTE, DES, ESTIMATES, FUNDA, HISTORY, FINET" 
        Dim bRet As Boolean = False 
        Dim strTopicItem As Object 

        strTopicItem = hTopic.ToString() + "-" + hItem.ToString() 
        If Array.BinarySearch(g_hDDETopicItem, strTopicItem) >= 0 Then 
            bRet = True 
        End If 

        CheckTopicItem = bRet 
    End Function 

    ''''''invalid function ,bucause strTopic is string array first 
    Private Function GetTopicItemIndexFromString(ByRef strTopic As String, ByRef strItem As String) As Integer 

        Dim i As Integer = 0 
        Dim bRet As Integer 

        Dim hTopic As Integer = DDEML.DdeCreateStringHandle(g_lInstID, strTopic, DDEML.CP_WINANSI) 
        If hTopic = 0 Then Exit Function 

        'TranslateError() '参数无效 
        DDEML.DdeFreeStringHandle(g_lInstID, hTopic) 

        Dim hItem As Integer = DDEML.DdeCreateStringHandle(g_lInstID, strItem, DDEML.CP_WINANSI) 
        'TranslateError() 
        DDEML.DdeFreeStringHandle(g_lInstID, hItem) 

        If g_hDDETopicItem.Length > 0 And hTopic > 0 And hItem > 0 Then 
            Dim strTopicItem As Object 
            strTopicItem = hTopic.ToString() + "-" + hItem.ToString() 
            bRet = Array.BinarySearch(g_hDDETopicItem, strTopicItem) 
        End If 

        GetTopicItemIndexFromString = bRet 

    End Function 

    Private Sub AddItemToTansString(ByRef strServer As String, ByRef strTopic As String, ByRef strItem As String) 

        '如果 m_strTanslate中含有strServer+strTopic+strItem,就直接返回. 
        '如果m_strTanslate中不含有strServer+strTopic+strItem,则在m_strTanslate的后面追加 strServer+strTopic+strItem + vbCrLf 
        Dim strItemTemp As String = strServer + "|" + strTopic + "!" + strItem 
        If m_strTanslate.IndexOf(strItemTemp) = -1 Then 
            m_strTanslate = m_strTanslate + strItemTemp + vbCrLf 
        End If 

    End Sub 

    Private Sub DelItemToTansString(ByRef strServer As String, ByRef strTopic As String, ByRef strItem As String) 
        '如果 m_strTanslate中含有strServer+strTopic+strItem,则在m_strTanslate的里面减去strServer+strTopic+strItem + vbCrLf 
        '如果m_strTanslate中不含有strServer+strTopic+strItem,就直接返回 
        Dim strItemTemp As String = strServer + "|" + strTopic + "!" + strItem + vbCrLf 
        If m_strTanslate.IndexOf(strItemTemp) > -1 Then 
            m_strTanslate = m_strTanslate.Replace(strItemTemp, "") 
        End If 

    End Sub 

    Public Sub UpdateExcel() 
        '使用新的返回值更新excel单元数据。 
        If m_strTansWithValue.Length < 2 Or m_strTanslate.Length < 2 Then 
            Exit Sub 
        End If 

        Try 
            System.Threading.Monitor.TryEnter(Me, 1000) 

            Dim strTopic As String 
            Dim strItem As String 
            Dim strTopicItem(1) As String 
            Dim hTopic As Integer 
            Dim hItem As Integer 

            Dim iTopicItemIndex As Integer 
            Dim istart As Integer 
            Dim iend As Integer 
            Dim iIndex As Integer 

            Dim strTempArray() As String 
            strTempArray = m_strTansWithValue.Split(Environment.NewLine) 'vbCrLf 
            Array.Sort(g_hDDETopicItem) 

            For iIndex = 0 To strTempArray.GetUpperBound(0) 
                istart = strTempArray(iIndex).LastIndexOf("|") 
                iend = strTempArray(iIndex).LastIndexOf("!") 
                If iend = -1 Then Exit For 
                strTopic = strTempArray(iIndex).Substring(istart + 1, iend - istart - 1) 

                istart = iend 
                iend = strTempArray(iIndex).LastIndexOf(":") 
                If iend = -1 Then Exit For 
                strItem = strTempArray(iIndex).Substring(istart + 1, iend - istart - 1) 

                iTopicItemIndex = GetTopicItemIndexFromString(strTopic, strItem) 
                ' iTopicItemIndex = iIndex 'test for 
                strTopicItem = g_hDDETopicItem(iTopicItemIndex).Split("-") 
                hTopic = Int32.Parse(strTopicItem(0)) 
                strTopicItem(1) = strTopicItem(1).Split("&")(0) ''新添加 
                hItem = Int32.Parse(strTopicItem(1)) 

                g_hDDETopicItem(iTopicItemIndex) = hTopic.ToString + "-" + hItem.ToString ''新添加 
                g_hDDETopicItem(iTopicItemIndex) += "&" + strTempArray(iIndex).Substring(iend + 1) '提取值 

                If g_lInstID <> 0 And hTopic > 0 And hItem > 0 Then 
                    DDEML.DdePostAdvise(g_lInstID, hTopic, hItem) 
                    'TranslateError() 
                End If 

            Next 

        Catch e As Exception 

        Finally 
            m_strTansWithValue = "" 
            System.Threading.Monitor.Pulse(Me) 
            System.Threading.Monitor.Exit(Me) 
        End Try 

    End Sub 

    Public ReadOnly Property TanslateString() As String 

        Get 
            Return m_strTanslate 
        End Get 

        'Set(ByVal Value As String) 
        '    m_strTanslate = Value 
        'End Set 

    End Property 

    Public Property TanslateStringWithValue() As String 

        Get 
            Return m_strTansWithValue 
        End Get 

        Set(ByVal Value As String) 
            If m_strTansWithValue = "" Then '控制m_strTansWithValue必须被更新完毕 
                m_strTansWithValue = Value 
            End If 
        End Set 

    End Property 

    Public ReadOnly Property DDE_ServerName() As String 

        Get 
            Return DDE_SERVER 
        End Get 

    End Property 

End Class

----------------

启动一个类获取数据

ddeServer.vb


'************************************************************************* 
    '    created:    2005/08/03 
    '    created:    3:8:2005   15:31 
    '    filename:     D:/vbdde/DDEServer.vb 
    '    file path:    D:/vbdde 
    '    file base:    Win32 
    '    file ext:    vb 
    '    author:        Peter 
    '    
     '************************************************************************* 

Imports System.Threading 
Imports System.Math 

Public Class ddeServer 
    Inherits System.Windows.Forms.Form 

#Region " Windows Form Designer generated code " 

    Public Sub New() 
        MyBase.New() 

        'This call is required by the Windows Form Designer. 
        InitializeComponent() 

        'Add any initialization after the InitializeComponent() call 

    End Sub 

    'Form overrides dispose to clean up the component list. 
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) 
        If disposing Then 
            If Not (components Is Nothing) Then 
                components.Dispose() 
            End If 
        End If 
        MyBase.Dispose(disposing) 
    End Sub 

    'Required by the Windows Form Designer 
    Private components As System.ComponentModel.IContainer 

    'NOTE: The following procedure is required by the Windows Form Designer 
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor. 
    Friend WithEvents btnRun As System.Windows.Forms.Button 
    Friend WithEvents tbxOutput As System.Windows.Forms.TextBox 
    Friend WithEvents tbxInput As System.Windows.Forms.TextBox 
    Friend WithEvents ddeClient As PowerStation.ddeClient 
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() 
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(ddeServer)) 
        Me.btnRun = New System.Windows.Forms.Button 
        Me.tbxOutput = New System.Windows.Forms.TextBox 
        Me.tbxInput = New System.Windows.Forms.TextBox 
        Me.ddeClient = New PowerStation.ddeClient 
        Me.SuspendLayout() 
        ' 
        'btnRun 
        ' 
        Me.btnRun.Location = New System.Drawing.Point(317, 209) 
        Me.btnRun.Name = "btnRun" 
        Me.btnRun.Size = New System.Drawing.Size(192, 22) 
        Me.btnRun.TabIndex = 5 
        Me.btnRun.Text = "Run" 
        ' 
        'tbxOutput 
        ' 
        Me.tbxOutput.Location = New System.Drawing.Point(19, 246) 
        Me.tbxOutput.Multiline = True 
        Me.tbxOutput.Name = "tbxOutput" 
        Me.tbxOutput.Size = New System.Drawing.Size(768, 180) 
        Me.tbxOutput.TabIndex = 4 
        Me.tbxOutput.Text = "" 
        ' 
        'tbxInput 
        ' 
        Me.tbxInput.Location = New System.Drawing.Point(19, 22) 
        Me.tbxInput.Multiline = True 
        Me.tbxInput.Name = "tbxInput" 
        Me.tbxInput.Size = New System.Drawing.Size(768, 165) 
        Me.tbxInput.TabIndex = 3 
        Me.tbxInput.Text = "" 
        ' 
        'ddeClient 
        ' 
        Me.ddeClient.BackColor = System.Drawing.SystemColors.Desktop 
        Me.ddeClient.Location = New System.Drawing.Point(0, 0) 
        Me.ddeClient.Name = "ddeClient" 
        Me.ddeClient.Size = New System.Drawing.Size(48, 24) 
        Me.ddeClient.TabIndex = 0 
        Me.ddeClient.Visible = False 
        ' 
        'ddeServer 
        ' 
        Me.AutoScale = False 
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14) 
        Me.ClientSize = New System.Drawing.Size(806, 446) 
        Me.Controls.Add(Me.btnRun) 
        Me.Controls.Add(Me.tbxOutput) 
        Me.Controls.Add(Me.tbxInput) 
        Me.Controls.Add(Me.ddeClient) 
        Me.Name = "ddeServer" 
        Me.Text = "ddeServer" 
        Me.ResumeLayout(False) 

    End Sub 

#End Region 

    ' Utilities and Tools 
    Dim util As New Utilities() 
    Dim pull As New Pull() 
    Dim foap As New vbFOAP() 

    ' Threads 
    Dim tcpconnectThread As New Thread(New ThreadStart(AddressOf tcpconnect)) 
    Dim getdataThread As New Thread(New ThreadStart(AddressOf getdata)) 
    Dim displayThread As New Thread(New ThreadStart(AddressOf display)) 

    ' Display Properties Variables 
    Dim myLanguage As Integer 
    Dim myUIState As Integer 
    Dim myFontSize As Integer 
    Dim myFontSizeState As Integer 
    Dim myWindowsStyle As Integer 

    ' Own Variables 
    Dim N As Integer 
    Dim myString As String 
    Dim Parameter As String 
    Dim MdiParent_N As Integer = 0 
    Dim InputRow() As String 

    ' HealthCheckTimeCount 
    Dim HealthCheckTimeCount, HealthCheckTimeCount2 As Integer 

    ' Labels Arrays 
    Dim lbaTitle() = {"", "", ""} 

    Private Sub onStart(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load 
        On Error Resume Next 

        ' Register the N th Teletext 
        Teletext_N = Teletext_N + 1 
        N = Teletext_N 

        ' Increase array size by 1 
        ReDim Preserve TeletextActiveCode(N) 
        ReDim Preserve StreamString(N) 

        TeletextActiveCode(N) = "1:0000-HK" 

        ' Intitialization Jobs 
        setLanguage() 
        setUI() 

        ' Start threads 
        tcpconnectThread.Start() 
        getdataThread.Start() 
        displayThread.Start() 
    End Sub 

    Private Sub onClose(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Closed 
        ' Stop threads 
        EngineState(N) = 911 
        getdataThread.Abort() 
        displayThread.Abort() 

    End Sub 

#Region "TCP Connections and TCP Health Check" 

    Private Sub tcpconnect() 
        pull.connect(StreamingIP, StreamingPort2) 
    End Sub 

    Private Sub tcpestablish(ByVal ActiveCode As String) 
        Dim tcpconnectThread As New Thread(New ThreadStart(AddressOf tcpconnect)) 
        myString = "" 

        'Register the N th child 
        Teletext_N = Teletext_N + 1 
        N = Teletext_N 

        ' Increase array size by 1 
        ReDim Preserve TeletextActiveCode(N) 
        ReDim Preserve StreamString(N) 
        TeletextActiveCode(N) = ActiveCode 

        ' Start Thread 
        tcpconnectThread.Start() 
    End Sub 

    Private Sub tcpHealthCheck() 
        On Error Resume Next 
        ' Init Checking 
        If tcpVerifyFailed() Then 
            If HealthCheckTimeCount = 10 Then 
                HealthCheckTimeCount = 0 
                tcpReconnect() 
            End If 
            HealthCheckTimeCount += 1 
        Else 
            HealthCheckTimeCount = 0 
        End If 

        ' Cron Checking 
        If HealthCheckTimeCount2 = TCPHealthInterval1 Then 
            StreamString(N) = "" 
            If InStr(TeletextActiveCode(N), " ") Then 
                TeletextActiveCode(N) = Replace(TeletextActiveCode(N), " ", "") 
            Else 
                TeletextActiveCode(N) = TeletextActiveCode(N) & " " 
            End If 
        End If 
        If HealthCheckTimeCount2 = TCPHealthInterval2 Then 
            HealthCheckTimeCount2 = 0 
            If StreamString(N) = "" Then 
                tcpReconnect() 
            End If 
        End If 
        HealthCheckTimeCount2 += 1 

        ' Frontend Signal 
        If StreamString(N) = "" Then 
            tcpFailedAlert(1) 
        Else 
            tcpFailedAlert(0) 
        End If 
    End Sub 

    Private Sub tcpReconnect() 
        Console.WriteLine("Reconnecting...") 

        ' Kill previous connection 
        EngineState(N) = 911 

        ' Delete coordinate file 
        util.DeleteFile("data/windows" & MdiParent_N & "/current/" & Me.Name & "." & N) 

        ' Re-establish TCP connection 
        tcpestablish(TeletextActiveCode(N)) 
    End Sub 

    Private Function tcpVerifyFailed() 
        If 0 > 1 Then ' Set your criteria here! 
            Return True 
        Else 
            Return False 
        End If 
    End Function 

    Private Sub tcpFailedAlert(ByVal State As Integer) 
        If State = 1 Then 
            ' Some frontend notice for failed case 
            Me.Text = Replace(Me.Text, ".", "") 
            Me.Text = Me.Text & "." 
        Else 
            ' Some frontend notice for normal case 
            Me.Text = Replace(Me.Text, ".", "") 
        End If 
    End Sub 

#End Region 

    ' Functions for threads for getdata, display & coordinates 
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    Private Sub getdata() 
        Do While toShutDown = 0 
            If myString <> StreamString(N) Then 
                myString = StreamString(N) 
                setData() 
            End If 
            Thread.Sleep(100) 
        Loop 
    End Sub 

    Private Sub display() 
        Do While toShutDown = 0 
            If myLanguage <> Language Then 
                setLanguage() 
                myLanguage = Language 
            End If 
            If myUIState <> UIState Then 
                setUI() 
                myUIState = UIState 
            End If 

            ' Input handlings 
            If ddeInput <> "" Then 
                parseInput() 
                Me.tbxInput.Text = ddeInput 
                ddeInput = "" 
            End If 

            ' Temp Actions 
            If ddeOutput <> "" Then 
                Me.tbxOutput.Text = ddeOutput & vbCrLf 
                ddeOutput = "" 
            End If 

            tcpHealthCheck() 
            Thread.Sleep(500) 
        Loop 
    End Sub 

    ' Below are UI realted functions 
    '''''''''''''''''''''''''''''''' 
    Private Sub setLanguage() 
        ' Generated by GUI Generator - Start 

        ' Generated by GUI Generator - End 
    End Sub 

    Private Sub setUI() 
        If myFontSizeState <> FontSizeState Then 
            myFontSize = FontSize 
            myFontSizeState = FontSizeState 
        Else : myFontSize = 0 
        End If 

        Try 
            ' Generated by GUI Generator - Start 

            ' Generated by GUI Generator - End 
        Catch ex As Exception 
        End Try 
    End Sub 

    ' parseInput 
    Private Sub parseInput() 
        On Error Resume Next 
        ' Trim unnecessary characters 
        'ddeInput = Replace(ddeInput, "'", "")          ' ** dde穦笆奔 ' 腹 

        ' Set ddeInput into InputRow as array 
        InputRow = Split(ddeInput, vbCrLf) 

        ' Init TeletextActiveCode 
        '        TeletextActiveCode(N) = Language & ":" 
        TeletextActiveCode(N) = 1 & ":" 

        ' Parsing 
        Dim i As Integer 
        For i = 0 To InputRow.Length - 1 
            ' QUOTE CASE 
            If InStr(InputRow(i), "PS|QUOTE!") Then    ' ** Change From --> If InStr(InputRow(i), "PS|QUOTE!(") Then 
                Dim Var = Split(InputRow(i).Substring(InputRow(i).IndexOf("!") + 1), ",")   ' ** Change From --> Dim Var() = Split(util.GetBetween(InputRow(i), "PS|QUOTE!(", ")"), ",") 
                If InStr(TeletextActiveCode(N), Var(0)) = False Then TeletextActiveCode(N) &= Var(0) & "," ' ** Add -->  If InStr(TeletextActiveCode(N), Var(0)) = False Then 
            End If 
        Next 
    End Sub 

    ' setData (Streaming) 
    Private Sub setData() 
        On Error Resume Next 
        Dim ddeOutput_tmp As String 

        ' Parsing 
        Dim i As Integer 
        For i = 0 To InputRow.Length - 1 
            If InputRow(i) <> "" Then 
                ' QUOTE CASE 
                If InStr(InputRow(i), "PS|QUOTE!") Then     ' ** Change from --> If InStr(InputRow(i), "PS|QUOTE!(") Then 
                    Dim Var = Split(InputRow(i).Substring(InputRow(i).IndexOf("!") + 1), ",")   ' ** Change from --> Dim Var() = Split(util.GetBetween(InputRow(i), "PS|QUOTE!(", ")"), ",") 
                    Dim Value = getQuoteValue(Var(0), Var(1)) 
                    If Value <> "" Then 
                        ddeOutput_tmp &= InputRow(i) & ":" & Value & vbCrLf 
                    End If 
                End If 
            End If 
        Next 
        ddeOutput &= ddeOutput_tmp 
    End Sub 

    ' getQuoteValue 
    Private Function getQuoteValue(ByVal Code As String, ByVal Type As String) 
        On Error Resume Next 

        ' Digiting 
        Code = foap.Digiting(Code) 
        Code = Replace(Code, "-HK", "") 

        ' ** BY CHUNG 
        If InStr(Code, "-CN") Then 
            Code = Replace(Code, "SZ", "") 
            Code = Replace(Code, "SH", "") 
        End If 

        ' Set myString to Row() 
        If InStr(myString, "~") = False Then Exit Function 
        Dim Row() = Split(myString, "~") 

        ' Main processing 
        Dim i As Integer 
        For i = 0 To Row.Length - 1 
            Dim Field() = Split(Row(i), ";") 
            If Code = Field(0) Then 
                If Type = "name" Then 
                    Return Field(1) 
                ElseIf Type = "open" Then 
                    Return Field(3) 
                ElseIf Type = "high" Then 
                    Return Field(4) 
                ElseIf Type = "low" Then 
                    Return Field(5) 
                ElseIf Type = "last" Then 
                    Return Field(6) 
                ElseIf Type = "chg" Then 
                    Return Field(7) 
                ElseIf Type = "bid" Then 
                    Return Field(8) 
                ElseIf Type = "ask" Then 
                    Return Field(9) 
                ElseIf Type = "vol" Then 
                    Return Field(10) 
                ElseIf Type = "turn" Then 
                    Return Field(11) 
                ElseIf Type = "pe" Then 
                    Return Field(12) 
                ElseIf Type = "yield" Then 
                    Return Field(13) 
                ElseIf Type = "pchg" Then 
                    If (Val(Field(5)) - Val(Field(7))) > 0 Then 
                        Return Round(Val(Field(7)) / (Val(Field(5)) - Val(Field(7))) * 100, 3) 
                    End If 
                End If 
                Return "N/A" 
            End If 
        Next 
    End Function 

    ' Initial parameter 
    Public Sub initParameter(ByVal Para As String) 
        Parameter = Para 
    End Sub 

    ' Temp Actions 
    Private Sub btnRun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRun.Click 
        ddeInput = Me.tbxInput.Text 
    End Sub 

End Class

-------------

资源ddeServer.resx


<pre>

<?xml version="1.0" encoding="utf-8"?> 
<root> 
  <!-- 
    Microsoft ResX Schema 
    Version 1.3 
    The primary goals of this format is to allow a simple XML format 
    that is mostly human readable. The generation and parsing of the 
    various data types are done through the TypeConverter classes 
    associated with the data types. 
    Example: 
    ... ado.net/XML headers & schema ... 
    <resheader name="resmimetype">text/microsoft-resx</resheader> 
    <resheader name="version">1.3</resheader> 
    <resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader> 
    <resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader> 
    <data name="Name1">this is my long string</data> 
    <data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data> 
    <data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64"> 
        [base64 mime encoded serialized .NET Framework object] 
    </data> 
    <data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> 
        [base64 mime encoded string representing a byte array form of the .NET Framework object] 
    </data> 
    There are any number of "resheader" rows that contain simple 
    name/value pairs. 
    Each data row contains a name, and value. The row also contains a 
    type or mimetype. Type corresponds to a .NET class that support 
    text/value conversion through the TypeConverter architecture. 
    Classes that don't support this are serialized and stored with the 
    mimetype set. 
    The mimetype is used forserialized objects, and tells the 
    ResXResourceReader how to depersist the object. This is currently not 
    extensible. For a given mimetype the value must be set accordingly: 
    Note - application/x-microsoft.net.object.binary.base64 is the format 
    that the ResXResourceWriter will generate, however the reader can 
    read any of the formats listed below. 
    mimetype: application/x-microsoft.net.object.binary.base64 
    value   : The object must be serialized with 
            : System.Serialization.Formatters.Binary.BinaryFormatter 
            : and then encoded with base64 encoding. 
    mimetype: application/x-microsoft.net.object.soap.base64 
    value   : The object must be serialized with 
            : System.Runtime.Serialization.Formatters.Soap.SoapFormatter 
            : and then encoded with base64 encoding. 

    mimetype: application/x-microsoft.net.object.bytearray.base64 
    value   : The object must be serialized into a byte array 
            : using a System.ComponentModel.TypeConverter 
            : and then encoded with base64 encoding. 
    --> 
  <xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata"> 
    <xsd:element name="root" msdata:IsDataSet="true"> 
      <xsd:complexType> 
        <xsd:choice maxOccurs="unbounded"> 
          <xsd:element name="data"> 
            <xsd:complexType> 
              <xsd:sequence> 
                <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> 
                <xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" /> 
              </xsd:sequence> 
              <xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" /> 
              <xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" /> 
              <xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" /> 
            </xsd:complexType> 
          </xsd:element> 
          <xsd:element name="resheader"> 
            <xsd:complexType> 
              <xsd:sequence> 
                <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> 
              </xsd:sequence> 
              <xsd:attribute name="name" type="xsd:string" use="required" /> 
            </xsd:complexType> 
          </xsd:element> 
        </xsd:choice> 
      </xsd:complexType> 
    </xsd:element> 
  </xsd:schema> 
  <resheader name="resmimetype"> 
    <value>text/microsoft-resx</value> 
  </resheader> 
  <resheader name="version"> 
    <value>1.3</value> 
  </resheader> 
  <resheader name="reader"> 
    <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> 
  </resheader> 
  <resheader name="writer"> 
    <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> 
  </resheader> 
  <data name="btnRun.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="btnRun.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="btnRun.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="tbxOutput.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="tbxOutput.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="tbxOutput.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="tbxInput.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="tbxInput.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="tbxInput.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="ddeClient.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="ddeClient.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="ddeClient.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="$this.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="$this.Language" type="System.Globalization.CultureInfo, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>(Default)</value> 
  </data> 
  <data name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="$this.Localizable" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="$this.GridSize" type="System.Drawing.Size, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> 
    <value>8, 8</value> 
  </data> 
  <data name="$this.Name"> 
    <value>ddeServer</value> 
  </data> 
  <data name="$this.DrawGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>True</value> 
  </data> 
  <data name="$this.TrayHeight" type="System.Int32, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>25</value> 
  </data> 
  <data name="$this.SnapToGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>True</value> 
  </data> 
  <data name="$this.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="$this.Icon" type="System.Drawing.Icon, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a" mimetype="application/x-microsoft.net.object.bytearray.base64"> 
    <value> 
        AAABAAEAICAAAAAAAACoCAAAFgAAACgAAAAgAAAAQAAAAAEACAAAAAAAgAQAAAAAAAAAAAAAAAEAAAAA 
        AABZo0gAaqlcAE+fPQBWokUA2dnZANDQ0ADOz84AV6JGAOXl5QDr6+sAfrxwAFGlPwDKzckA1NTUAJq7 
        kgB5r24A09PTALTFsQD09PQApb+gAOLi4gCKtYAAaKhZADiXIwDDysEAu9y0APj4+ACXyYwAPZooAF+l 
        UABeq00Anr2XAI63hQBsql4ASp03AOHh4QBSoEEAr8OqAOXx4gDX19cAda9nAN3d3QBRoD8AOJgjALnb 
        sgDU6dAASZ02AFSmQgD39/cAf71xAIm1fwB9sHIAcLVgAO727ADx8fEA3NzcAPD37gDByr8Aw+C8ALPX 
        qwDS09IAeq9uAIKydwC7x7gA4fDeAJDFhABvq2IA6OjoALDJqgDy+PEAl7qPAGaoVwDV1dUA1+rSAKbR 
        nABGnzIAgLF1AOz16gC4xrUAxuLAAHuwcADHzMYA7fTrAGmpWwA7mSYAmLuRADOVHQBwrGMAVaFEAPb7 
        9gDY2NgAhbR6AK/DqwCww6wA4ODgAP7//gD9/f0A5OTkAJC7hwBjp1QAiLV/AHmvbQBEnjAAssSvAPLy 
        8gCnz50A9vb2APPz8wDw8PAAUKQ9AO7u7gDR0tEA7e3tANbq0gCKtYEAbKpfAH2wcQB/sXQAkLeHAM/P 
        zwBuq2AAqcGjAHauagCUx4kAbrRfAI22gwBUoUMA5ubmALLXqgA1liAAS545AKO/nQDR0dEAsdGqAPv7 
        +wDc7dkAQpovAP///wAxlBsAz8/PAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 
        AAAAAAAA//////////////////////////////////////////////////////////////////////// 
        //////////////////////////////////////////////////////////////////////////////// 
        //////////8/PVz///////////////////////////////////8MUIGKH/////////////////8RAAAA 
        AAAAAGT/////EYKKiopG/////////////////4OKioqKioqKU///BhUXioqKinb///////////////// 
        VYqKioqKiop0//8hioqKioqKTP////////////////8VioqKioqKijIMFoqKioqKiop1//////////// 
        /////1uKioqKioqKPn6KioqKioqKijP///////8QN38JaxJqUkAtT4B7NEuKioqKioqKioqKZf////8N 
        bomJiYmJiYlZNTiJiYmJiSZKL4qKioqKiop6////WoaJiRoJXgSE/yiKioocC3xBO4dfcRttioqKikL/ 
        //9siWAp////////AYqKioqKioqKimYxLEU6HoqKAf///xSJcP////////8BioqKioqKioqKioqKKwpJ 
        GQtH/////2gw/////////wGKioqKioqKioqKioqKiooKTYX/////EBJD////////AYqKioqKioqKioqK 
        ioqKiopUaQh3////BQg2BP////9XioqKioqKioqKioqKioqKiooAbxQF/////wUjYUj//w+KioqKioqK 
        ioqKioqKioqKigf//w3/////////JwQ8YoqKioqKioqKioqKioqKioqKA/////////////////9EioqK 
        ioqKioqKioqKioqKiooD/////////////////w6KioqKioqKioqKioqKioqKiiT///////////////// 
        E4qKioqKioqKeCCKioqKioqKAv////////////////9nioqKioqKY07/E4qKioqKiooC//////////// 
        /////1GKioqKVn3///8lioqKioqKiiL/////////////////BoqKioh5/////xiKioqKioqKKv////// 
        ////////////LoodOf///////1gCAgNzcl0G//////////////////8HD/////////////////////// 
        /////////////////w7///////////////////////////////////////////////////////////// 
        //////////////////////////////////////////////////////////////////////////////// 
        /////////////////////////////////8f///8H/8AeB//AGAf/wBgH/8AAB//AAAfgAAAHgAAABwBA 
        AAcPwAAHH8AAB5/AAAePwAABw8AAAPDAAAb+AAAH/8AAB//AAAf/wAAH/8AQB//AcAf/wPAH/+H4B//n 
        ////7/////////////////// 
</value> 
  </data> 
</root> 

</pre>

--------------

ddeClient.vb

最后写一个类,启动dde服务,把接收到的数据,放置到excel中。

启动和结束代码

/* 

Public Sub BeginDDEServer() 

    System.Diagnostics.Debug.WriteLine("-------------- Begin DDE Server Test --------------") 

    ClearVariable() 

    ' Initialize the DDE subsystem. This only needs to be done once. 
    If g_lInstID <> 0 Then EndDDEServer() 

    DDEInitial() 

    'TranslateError() 

    ' set topics in "QUOTE, DES, ESTIMATES, FUNDA, HISTORY, FINET" 
    DDECreateStringHandles("PS") 
    CreateDDETopic("QUOTE")  ',('EUR-FX','last') 
    CreateDDETopic("DES") 
    CreateDDETopic("ESTIMATES") 
    CreateDDETopic("FUNDA") 
    CreateDDETopic("HISTORY") 
    CreateDDETopic("FINET") 

    'TranslateError() 
    DDEServerRegister(g_lInstID, g_hszDDEServer) 

    'TranslateError() 

End Sub 

Public Sub CreateDDETopic(ByRef strTopic As String) 
    DDECreateStringHandles("", strTopic) 
End Sub 

Public Sub EndDDEServer() 
    'TranslateError() 

    DDEFreeStringHandles() 
    'TranslateError() 

    DDEServerUnregister() 
    'TranslateError() 

    ' Break down the link with the DDE subsystem. 
    DDEUninitialize() 
    'TranslateError() 

    ClearVariable() 
    System.Diagnostics.Debug.WriteLine("------------------- end DDE Server Test -----------------------") 

End Sub 

*/ 

原文如下 

Public Class ddeClient 
    '************************************************************************* 
    '    created:    2005/08/03 
    '    created:    3:8:2005   15:31 
    '    filename:     D:/vbdde/ddeClient.vb 
    '    file path:    D:/vbdde 
    '    file base:    Win32 
    '    file ext:    vb 
    '    author:        Peter 
    '    
    '************************************************************************* 
    Inherits System.Windows.Forms.UserControl 

    Private newExcelDDE As Object 
    Private oldTanslateString As String 

#Region " Windows 窗体设计器生成的代码 " 

    Public Sub New() 
        MyBase.New() 

        '该调用是 Windows 窗体设计器所必需的。 
        InitializeComponent() 

        '在 InitializeComponent() 调用之后添加任何初始化 
        oldTanslateString = "" 

        newExcelDDE = New ExcelDDE 
        ' Start DDE Server (By Peter) 
        newExcelDDE.BeginDDEServer() 
        'Timer1.Enabled = True 
        DDETimer.Enabled = True 
        DDETimer.Interval = 400 
        DDETimer.Start() 

    End Sub 

    'UserControl 重写 dispose 以清理组件列表。 
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) 
        If disposing Then 
            If Not (components Is Nothing) Then 
                components.Dispose() 
            End If 

            ' Stop DDEServer (By Peter) 
            ddeInput = "" 
            ddeOutput = "" 
            oldTanslateString = "" 
            newExcelDDE.EndDDEServer() 
        End If 
        MyBase.Dispose(disposing) 
    End Sub 

    'Windows 窗体设计器所必需的 
    Private components As System.ComponentModel.IContainer 

    '注意: 以下过程是 Windows 窗体设计器所必需的 
    '可以使用 Windows 窗体设计器修改此过程。 
    '不要使用代码编辑器修改它。 
    Public WithEvents CtrlName As System.Windows.Forms.Label 
    Public WithEvents DDETimer As System.Windows.Forms.Timer 
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() 
        Me.components = New System.ComponentModel.Container 
        Me.DDETimer = New System.Windows.Forms.Timer(Me.components) 
        Me.CtrlName = New System.Windows.Forms.Label 
        Me.SuspendLayout() 
        ' 
        'DDETimer 
        ' 
        Me.DDETimer.Interval = 1000 
        ' 
        'CtrlName 
        ' 
        Me.CtrlName.Font = New System.Drawing.Font("宋体", 18.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(134, Byte)) 
        Me.CtrlName.ForeColor = System.Drawing.SystemColors.ControlLight 
        Me.CtrlName.Location = New System.Drawing.Point(0, 0) 
        Me.CtrlName.Name = "CtrlName" 
        Me.CtrlName.Size = New System.Drawing.Size(48, 24) 
        Me.CtrlName.TabIndex = 0 
        Me.CtrlName.Text = "DDE" 
        ' 
        'PSDde 
        ' 
        Me.BackColor = System.Drawing.SystemColors.Desktop 
        Me.Controls.Add(Me.CtrlName) 
        Me.Name = "PSDde" 
        Me.Size = New System.Drawing.Size(48, 24) 
        Me.ResumeLayout(False) 

    End Sub 

#End Region 

    Private Sub DDETimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DDETimer.Tick 
        ' Input handlings 
        If newExcelDDE.TanslateString.ToString().Trim.Equals("") Then 
            ddeInput = "" 
            ddeOutput = "" 
            oldTanslateString = "" 
            Exit Sub 
        End If 
        If Not oldTanslateString.Equals(newExcelDDE.TanslateString.ToString()) Then  '修改20050922 
            oldTanslateString = newExcelDDE.TanslateString.ToString() 
            ddeInput = newExcelDDE.TanslateString.ToString() 
        End If 

        If ReferenceEquals(ddeOutput, Nothing) Then Exit Sub 
        If ddeOutput.Trim.Equals("") Then Exit Sub 

        newExcelDDE.TanslateStringWithValue = ddeOutput 
        newExcelDDE.UpdateExcel() 
        '''添加的语句 
        ddeOutput = "" 
    End Sub 
End Class

----

资源文件ddeclient.resx


<pre>

<?xml version="1.0" encoding="utf-8"?> 
<root> 
  <!-- 
    Microsoft ResX Schema 
    Version 1.3 
    The primary goals of this format is to allow a simple XML format 
    that is mostly human readable. The generation and parsing of the 
    various data types are done through the TypeConverter classes 
    associated with the data types. 
    Example: 
    ... ado.net/XML headers & schema ... 
    <resheader name="resmimetype">text/microsoft-resx</resheader> 
    <resheader name="version">1.3</resheader> 
    <resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader> 
    <resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader> 
    <data name="Name1">this is my long string</data> 
    <data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data> 
    <data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64"> 
        [base64 mime encoded serialized .NET Framework object] 
    </data> 
    <data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> 
        [base64 mime encoded string representing a byte array form of the .NET Framework object] 
    </data> 
    There are any number of "resheader" rows that contain simple 
    name/value pairs. 
    Each data row contains a name, and value. The row also contains a 
    type or mimetype. Type corresponds to a .NET class that support 
    text/value conversion through the TypeConverter architecture. 
    Classes that don't support this are serialized and stored with the 
    mimetype set. 
    The mimetype is used forserialized objects, and tells the 
    ResXResourceReader how to depersist the object. This is currently not 
    extensible. For a given mimetype the value must be set accordingly: 
    Note - application/x-microsoft.net.object.binary.base64 is the format 
    that the ResXResourceWriter will generate, however the reader can 
    read any of the formats listed below. 
    mimetype: application/x-microsoft.net.object.binary.base64 
    value   : The object must be serialized with 
            : System.Serialization.Formatters.Binary.BinaryFormatter 
            : and then encoded with base64 encoding. 
    mimetype: application/x-microsoft.net.object.soap.base64 
    value   : The object must be serialized with 
            : System.Runtime.Serialization.Formatters.Soap.SoapFormatter 
            : and then encoded with base64 encoding. 

    mimetype: application/x-microsoft.net.object.bytearray.base64 
    value   : The object must be serialized into a byte array 
            : using a System.ComponentModel.TypeConverter 
            : and then encoded with base64 encoding. 
    --> 
  <xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata"> 
    <xsd:element name="root" msdata:IsDataSet="true"> 
      <xsd:complexType> 
        <xsd:choice maxOccurs="unbounded"> 
          <xsd:element name="data"> 
            <xsd:complexType> 
              <xsd:sequence> 
                <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> 
                <xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" /> 
              </xsd:sequence> 
              <xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" /> 
              <xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" /> 
              <xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" /> 
            </xsd:complexType> 
          </xsd:element> 
          <xsd:element name="resheader"> 
            <xsd:complexType> 
              <xsd:sequence> 
                <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> 
              </xsd:sequence> 
              <xsd:attribute name="name" type="xsd:string" use="required" /> 
            </xsd:complexType> 
          </xsd:element> 
        </xsd:choice> 
      </xsd:complexType> 
    </xsd:element> 
  </xsd:schema> 
  <resheader name="resmimetype"> 
    <value>text/microsoft-resx</value> 
  </resheader> 
  <resheader name="version"> 
    <value>1.3</value> 
  </resheader> 
  <resheader name="reader"> 
    <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> 
  </resheader> 
  <resheader name="writer"> 
    <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> 
  </resheader> 
  <data name="DDETimer.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="DDETimer.Location" type="System.Drawing.Point, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> 
    <value>17, 17</value> 
  </data> 
  <data name="DDETimer.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Public</value> 
  </data> 
  <data name="CtrlName.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="CtrlName.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="CtrlName.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Public</value> 
  </data> 
  <data name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="$this.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="$this.SnapToGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>True</value> 
  </data> 
  <data name="$this.DrawGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>True</value> 
  </data> 
  <data name="$this.TrayHeight" type="System.Int32, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>80</value> 
  </data> 
  <data name="$this.Language" type="System.Globalization.CultureInfo, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>(Default)</value> 
  </data> 
  <data name="$this.Localizable" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>False</value> 
  </data> 
  <data name="$this.DefaultModifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> 
    <value>Assembly</value> 
  </data> 
  <data name="$this.Name"> 
    <value>PSDde</value> 
  </data> 
  <data name="$this.GridSize" type="System.Drawing.Size, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> 
    <value>8, 8</value> 
  </data> 
</root> 

</pre>

----------------------

粘贴结束,dde说起来不是什么难以理解的东西,也许大家都一样,困在了那么一点上,花费了好久,才知道原来如此。

能够把自己多年以前的东西分享出来,有幸被人借鉴,也算是一种幸运。

展开阅读全文

DDE

01-15

鏈夊叧DDE鐨勯棶棰?浣跨敤浠ヤ笅浠g爜,浣嗗氨鏄鎴风鍜屾湇鍔$杩炴帴涓嶄笂.璇烽珮鎵嬫寚鐐?rn瀹㈡埛绔?nPrivate Sub Form_Load()rn Text1.LinkTopic = "鏈嶅姟宸ョ▼|DDE_Text"rn Text1.LinkItem = "txtserver"rn Label2.LinkTopic = "鏈嶅姟宸ョ▼|DDE_Text"rn Label2.LinkItem = "clock"rn rnRetry:rn On Error GoTo Handle '璁剧疆閿欒闄烽槺锛屾崟鑾峰彲鑳戒骇鐢熺殑閿欒rn Label2.LinkMode = 1 '閲囩敤鑷姩鏂瑰紡鎺ユ敹绋嬪簭鏈嶅姟鍣ㄧ殑鏃堕挓鏁版嵁鏇存柊鏍囩鏄剧ずrn Cmdreq.Enabled = Falsern cmdUpdate.Enabled = Truern rnHandle:rn If Err = 282 Then '濡傛灉鏈嶅姟鍣ㄧ▼搴忚繕娌℃湁杩愯锛屽垯杩愯瀹冿紝鍐嶈繘琛岄摼鎺ャ€?n Dim xrn Dim Fname As Stringrn rn Fname = App.Path + "\鏈嶅姟宸ョ▼.exe"rn x = Shell(Fname, vbNormalFocus)rn Exit Subrn Resume Retryrn Elsern Error Errrn Exit Subrn End IfrnEnd SubrnrnPrivate Sub Option1_Click(Index As Integer)rn Select Case Indexrn Case 0 '鑷姩鏂瑰紡,璇锋眰鎸夐挳鏃犳晥rn Text1.LinkMode = 1rn Cmdreq.Enabled = Falsern Label1.Caption = "璁剧疆浜嗚嚜鍔ㄦ柟寮?rn Case 1 'Manual 鑷姩鏂瑰紡,璇锋眰鎸夐挳鏈夋晥 'rn Text1.LinkMode = 2rn Cmdreq.Enabled = Truern Label1.Caption = "璁剧疆浜嗘墜鍔ㄦ柟寮?rn Case 2 ' Notify 閫氱煡鏂瑰紡,璇锋眰鎸夐挳鏃犳晥rn Text1.LinkMode = 3rn Cmdreq.Enabled = Falsern Label1.Caption = "璁剧疆浜嗛€氱煡鏂瑰紡"rn Case 3rn Text1.LinkMode = 0rn Cmdreq.Enabled = Falsern cmdUpdate.Enabled = Falsern Label1.Caption = "DDE瀵硅瘽缁撴潫"rn End SelectrnEnd SubrnrnPrivate Sub Text1_LinkNotify()rn Label1.Caption = "鏁版嵁宸叉敼鍙橈紝璇锋寜[鏇存柊]鎸夐挳鎺ュ彈鏂版暟鎹紒"rn cmdUpdate.Enabled = TruernEnd SubrnrnPrivate Sub Cmdreq_Click()rn Text1.LinkRequestrnEnd SubrnrnPrivate Sub cmdUpdate_Click()rn Text1.LinkRequest '璇锋眰寰楀埌鏂版暟鎹?n cmdUpdate.Enabled = False '缃甗鏇存柊]鎸夐挳涓嶅彲鐢?nEnd SubrnrnPrivate Sub Text1_LinkError(LinkErr As Integer)rn MsgBox "DDE閾炬帴閿欒锛?rnEnd Subrn鏈嶅姟绔?rnPrivate Sub cmdExit_Click()rn EndrnEnd SubrnrnPrivate Sub Form_Load()rn TxtServer.Text = " 濂冲+浠紝鍏堢敓浠紝璇锋敞鎰忥紒 鏈湇鍔″櫒灏嗗彂甯冩渶鏂版秷鎭€?rnEnd SubrnPrivate Sub Timer1_Timer()rn Clock.Caption = Time$rnEnd Subrn 论坛

没有更多推荐了,返回首页