关于VB中的API函数
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, _
lpOverlapped As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, _
phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, _
ByVal nSize As Long) As Long
Public Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const NORMAL_PRIORITY_CLASS As Long = &H20&
Public Const STARTF_USESTDHANDLES As Long = &H100&
Public Const STARTF_USESHOWWINDOW As Long = &H1&
Public Const SW_HIDE As Long = 0&
Public Const INFINITE As Long = &HFFFF&
帮忙加注释
[解决办法]
'Example Name: Starting Default Browser
'------------------------------------------
'
' BAS Moudel Code
'
'------------------------------------------
Option Explicit
Public Const CREATE_NEW_CONSOLE As Long = &H10
Public Const NORMAL_PRIORITY_CLASS As Long = &H20
Public Const INFINITE As Long = -1
Public Const STARTF_USESHOWWINDOW As Long = &H1
Public Const SW_SHOWNORMAL As Long = 1
Public Const MAX_PATH As Long = 260
Public Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Public Const ERROR_FILE_NOT_FOUND As Long = 2
Public Const ERROR_PATH_NOT_FOUND As Long = 3
Public Const ERROR_FILE_SUCCESS As Long = 32 'my constant
Public Const ERROR_BAD_FORMAT As Long = 11
Public Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Public Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" _
(ByVal lpAppName As String, _
ByVal lpCommandLine As String, _
ByVal lpProcessAttributes As Long, _
ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Declare Function FindExecutable Lib "shell32" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long
Public Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long
'------------------------------------------
'
' Form Code
'
'------------------------------------------
Option Explicit
Private Sub Command1_Click()
Dim sURL As String
'the URL to open, of course!
sURL = "http://www.mvps.org/vbnet/"
'if the call returns false, display a message
If Not StartNewBrowser(sURL) Then
MsgBox "No dice!"
End If
End Sub
Private Function StartNewBrowser(sURL As String) As Boolean
'start a new instance of the user's browser
'at the page passed as sURL
Dim success As Long
Dim hProcess As Long
Dim sBrowser As String
Dim start As STARTUPINFO
Dim proc As PROCESS_INFORMATION
sBrowser = GetBrowserName(success)
'did sBrowser get correctly filled?
If success >= ERROR_FILE_SUCCESS Then
'prepare STARTUPINFO members
With start
.cb = Len(start)
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = SW_SHOWNORMAL
End With
'start a new instance of the default
'browser at the specified URL. The
'lpCommandLine member (second parameter)
'requires a leading space or the call
'will fail to open the specified page.
success = CreateProcess(sBrowser, _
" " & sURL, _
0&, 0&, 0&, _
NORMAL_PRIORITY_CLASS, _
0&, 0&, start, proc)
'if the process handle is valid, return success
StartNewBrowser = proc.hProcess <> 0
'don't need the process
'handle anymore, so close it
Call CloseHandle(proc.hProcess)
'and close the handle to the thread created
Call CloseHandle(proc.hThread)
End If
End Function
Private Function GetBrowserName(dwFlagReturned As Long) As String
'find the full path and name of the user's
'associated browser
Dim hFile As Long
Dim sResult As String
Dim sTempFolder As String
'get the user's temp folder
sTempFolder = GetTempDir()
'create a dummy html file in the temp dir
hFile = FreeFile
Open sTempFolder & "dummy.html" For Output As #hFile
Close #hFile
'get the file path & name associated with the file
sResult = Space$(MAX_PATH)
dwFlagReturned = FindExecutable("dummy.html", sTempFolder, sResult)
'clean up
Kill sTempFolder & "dummy.html"
'return result
GetBrowserName = TrimNull(sResult)
End Function
Private Function TrimNull(item As String)
'remove string before the terminating null(s)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End Function
Public Function GetTempDir() As String
'retrieve the user's system temp folder
Dim tmp As String
tmp = Space$(256)
Call GetTempPath(Len(tmp), tmp)
GetTempDir = TrimNull(tmp)
End Function
