''''---------------------------------------------------------------------------------------
'''' Module    : Module1
'''' DateTime  : 2005-9-24 01:35
'''' Author    : Lingll
'''' Purpose   :
''''---------------------------------------------------------------------------------------

Option Explicit
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" _
    (ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long

Public Declare Function CreateDialogParam Lib "user32.dll" _
        Alias "CreateDialogParamA" ( _
        ByVal hInstance As Long, ByVal lpName As Long, _
        ByVal hWndParent As Long, ByVal lpDialogFunc As Long, _
        ByVal lParamInit As Long) As Long

Public Const SW_SHOW As Long = 5
Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Const WM_SYSCOMMAND As Long = &H112
Public Const SC_CLOSE As Long = &HF060&
Public Declare Function EndDialog Lib "user32.dll" (ByVal hDlg As Long, ByVal nResult As Long) As Long

Public Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (ByRef lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32.dll" (ByRef lpMsg As MSG) As Long
Public Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (ByRef lpMsg As MSG) As Long
Public Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Public Function DialogProc( _
        ByVal hwndDlg&, ByVal uMsg&, _
        ByVal wParam&, ByVal lParam&) As Long
If uMsg = WM_SYSCOMMAND Then
    If wParam = SC_CLOSE Then
        Call EndDialog(hwndDlg, 0)
        PostQuitMessage 0
        DialogProc = 0
    End If
End If
End Function

Public Sub Main()
Dim hDlg&
Dim tMsg As MSG
Dim hIns&

hIns = LoadLibrary("shdoclc.dll")
hDlg = CreateDialogParam(hIns, 24581, _
        0, AddressOf DialogProc, 0)
FreeLibrary hIns

ShowWindow hDlg, SW_SHOW

While GetMessage(tMsg, 0, 0, 0)
    Call TranslateMessage(tMsg)
    Call DispatchMessage(tMsg)
Wend

End Sub

最好编译了再运行,不然可能会有些问题