module1.bas

大量优秀的vb编程

Attribute VB_Name = "Module1"

Public Const CBF_FAIL_ADVISES = &H4000
Public Const CBF_FAIL_ALLSVRXACTIONS = &H3F000
Public Const CBF_FAIL_CONNECTIONS = &H2000
Public Const CBF_FAIL_EXECUTES = &H8000
Public Const CBF_FAIL_POKES = &H10000
Public Const CBF_FAIL_REQUESTS = &H20000
Public Const CBF_FAIL_SELFCONNECTIONS = &H1000

Public Const CP_WINANSI = 1004

Public Const XCLASS_FLAGS = &H4000
Public Const XTYP_EXECUTE = (&H50 Or XCLASS_FLAGS)

'-----------------------------------------------------------
' SUB: CreateGroup
'
' 这个函数建立程序组
'
' IN: [frm] - 一个包含有Name属性为lblDDe的Lable的窗口
'     [strGroup] - 要建立的程序组的名字
'     [strTitle] - 程序项的标题
'     [strCmd] - 程序项指向的程序
'     [intDDE] - 标识建立程序组还是程序项
Sub CreateGroup(frm As Form, ByVal strGroup As String, ByVal strCmd As String, ByVal strTitle As String, ByVal intDDE As Integer, ByVal fLog As Boolean)
    Const strCOMMA$ = ","
    Const strRESTORE$ = ", 1)]"
    Const strACTIVATE$ = ", 5)]"
    Const strENDCMD$ = ")]"
    Const strSHOWGRP$ = "[ShowGroup("
    Const strADDGRP$ = "[CreateGroup("
    Const strREPLITEM$ = "[ReplaceItem("
    Const strADDITEM$ = "[AddItem("

    Dim intIdx As Integer
    Dim intRetry As Integer
    
    For intRetry = 1 To 20
        On Error Resume Next
        frm.lblDDe.LinkTopic = "PROGMAN|PROGMAN"
        If Err = 0 Then
            Exit For
        End If
        DoEvents
    Next intRetry
            
    '手动建立连接
    frm.lblDDe.LinkMode = 2
    frm.lblDDe.LinkTimeout = 100

    If Err = 0 Then
        Select Case intDDE
            Case 1  '建立程序项
                frm.lblDDe.LinkExecute strADDGRP & strGroup & strENDCMD
                frm.lblDDe.LinkExecute strREPLITEM & strTitle & strENDCMD
                frm.lblDDe.LinkExecute strADDITEM & strCmd & strCOMMA & strTitle & String$(3, strCOMMA) & strENDCMD
            Case 2  '建立程序组
                frm.lblDDe.LinkExecute strADDGRP & strGroup & strENDCMD
                frm.lblDDe.LinkExecute strSHOWGRP & strGroup & strRESTORE
        End Select
    End If
    
    '断开DDE联接
    frm.lblDDe.LinkMode = 0
    frm.lblDDe.LinkTopic = ""
End Sub

Sub Main()
  Dim astr As String
  'MsgBox "OK"
  CreateGroup Form1, "TESTGroup", vbstringNULL, vbstringNULL, 2, True
  CreateGroup Form1, "TESTGroup", "d:\lt\text.exe", "TEST 2002", 1, True
End Sub