隨便羅嗦幾句，自己已經好幾年沒有寫什麼東西了，而自己已經從事這一行好久了，希望能提供一些東西給大家，好與壞無所謂。

很早的時候做過DDE方面的程式，那是在2005年剛來深圳的時候，公司的一個產品需要在excel中動態顯示資料，臨時做了這麼個東西，那個產品是vb.net做的，因此就現在vc下面測試後移到vb中應用，還真的成功了。但是時間不經意間已經過去6年時間了，自己早已經不再涉及vb的東西，看到有個朋友提到這方面的東西向我諮詢，於是有了把自己的那個程式拿出來，希望能夠對需要的人一點幫助。

DDE 的步驟就不用列出了，網上很多，也能從程式碼中瞭解到。用到的函式如下

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

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

打包到一個類中

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

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

啟動一個類獲取資料

        '*************************************************************************
    '    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="