Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Command1_Click()
ShellExecute Me.hWnd, "Open", "C:\aa.c", "", App.Path, 1
End Sub
ShellExecute Me.hWnd, "Open", "C:\aa.c", "", App.Path, 1
End Sub
解决方案 »
- 急救-很简单的问题-dataCombo
- 请问:用ado如何导出access97格式的数据库(在线等)
- 如何让VB根据实际运行的机器环境自动调用Excel2K或Excel XP
- 高手帮忙看看?
- mapx 5.0从哪可以下载?我已经找了一下午了也没有找到!
- SQL中除了单引号,还有没有其他符号需要替换
- 十万火急!数据库损坏!!!
- 问个很简单的问题。怎样获得字符串的长度。取得字符串的子集用什么函数?
- Excel导入Sql server2000中openrowset的使用时奇怪问题!
- 如何在recordset中用insert into 在指定行插入数据
- 哪位有VBNPR32D.OCX,可以发一个吗[email protected]
- 简单问题,解决加分
'This example requires a command button (Command1)
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Const SE_ERR_NOASSOC = 31
Const sOperation As String = "open" ' Constants for shell operations
Const sRun As String = "RUNDLL32.EXE"
Const sParameters As String = "shell32.dll,OpenAs_RunDLL "
Private Function shelldoc(sfile As String)
Dim sPath As String, RetVal As Long, _
lRet As Long
lRet = ShellExecute(GetDesktopWindow(), sOperation, sfile, _
vbNullString, vbNullString, SW_SHOWNORMAL)
If lRet = SE_ERR_NOASSOC Then ' No association exists
'Create a buffer
sPath = Space(255)
'Get the system directory
RetVal = GetSystemDirectory(sPath, 255)
'Remove all unnecessary chr$(0)'s
'and move on the stack
sPath = Left$(sPath, RetVal)
lRet = ShellExecute(GetDesktopWindow(), "open", sRun, _
sParameters + sfile, sPath, SW_SHOWNORMAL)
End If
End Function
Private Sub Command1_Click()
' Change the file extensions so that one
' has a program associated with it and the
' other does not.
Call shelldoc("C:\myfile.txt")
Call shelldoc("C:\myfile.sarsaparilla")
End Sub
' 取得窗口函数的地址
Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf SubClass1_WndMessage)
' 用SubClass1_WndMessage代替窗口函数处理消息 SysMenuHwnd = GetSystemMenu(Form1.hwnd, False) Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2000, vbNullString)
Call AppendMenu(SysMenuHwnd, MF_STRING, 2001, "关于本程序(&A)")
Call AppendMenu(SysMenuHwnd, MF_SEPARATOR, 2002, vbNullString)
Call AppendMenu(SysMenuHwnd, MF_STRING, 2003, "恢复系统菜单(&R)")
End SubPrivate Sub Form_Unload(Cancel As Integer)
If OldWindowProc <> GetWindowLong(Form1.hwnd, GWL_WNDPROC) Then
Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, OldWindowProc)
End If
End SubOption Explicit' API函数声明
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long,
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long,
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal
lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal
lParam As Long) As LongPublic Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long)
As Long
Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal
wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal
lpDirectory As String, ByVal nShowCmd As Long) As Long' 常数声明
Public Const WM_SYSCOMMAND = &H112
' 单击控制框产生此消息
Public Const MF_SEPARATOR = &H800&
' 为菜单加一条分隔线
Public Const MF_STRING = &H0&
' 在菜单中加一个字符串
Public Const GWL_WNDPROC = (-4)' 全局变量
Public OldWindowProc As Long
' 保存默认的窗口函数地址
Public SysMenuHwnd As Long
' 保存系统菜单句柄Public Function SubClass1_WndMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long,
ByVal lp As Long) As Long
If Msg <> WM_SYSCOMMAND Then
SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
' 如果消息不是WM_SYSCOMMAND,就调用默认的窗口函数处理
Exit Function
End If Select Case wp
Case 2001
Call MsgBox("本程序实现了修改系统菜单的功能 ", vbOKOnly + vbInformation)
Case 2003
Call GetSystemMenu(Form1.hwnd, True)
Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, OldWindowProc)
Call MsgBox("已经恢复了默认的系统菜单 ", vbOKOnly + vbInformation)
Case Else
SubClass1_WndMessage = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
Exit Function
End Select SubClass1_WndMessage = TrueEnd Function 以上代码来自: SourceCode Explorer(源代码数据库)
复制时间: 02-6-20 22:35
当前版本: 1.0.710
作者: Shawls
个人主页: Http://Shawls.Yeah.Net
E-Mail: [email protected]
QQ: 9181729