API函数的声明及其典型示例
而我们的人生或许就该是如此的一个境界与心态,空于万物,也就不会被万物纠葛。真正做到万物从心流过,而不留痕迹。只管善良,待机缘条件成熟,便会有好的结果;若一直作恶,待条件时机到来,就不会有善果。生活,都在自己选择。跟我学VBA,我这里专注VBA, 授人以渔。我98年开始,从源码接触VBA已经20余年了,随着年龄的增长,越来越觉得有必要把这项技能传递给需要这项技术的职场人员。希望和数据打交道的朋友,都
而我们的人生或许就该是如此的一个境界与心态,空于万物,也就不会被万物纠葛。真正做到万物从心流过,而不留痕迹。只管善良,待机缘条件成熟,便会有好的结果;若一直作恶,待条件时机到来,就不会有善果。生活,都在自己选择。跟我学VBA,我这里专注VBA, 授人以渔。我98年开始,从源码接触VBA已经20余年了,随着年龄的增长,越来越觉得有必要把这项技能传递给需要这项技术的职场人员。希望和数据打交道的朋友,都来学习VBA,利用VBA,起码可以提高自己的工作效率,可以有时间多陪陪父母,多陪陪家人,何乐而不为呢?这讲我们继续学习64位Office API声明语句之65讲,这些内容是MS的权威资料,看似枯燥,但对于想学习API函数的朋友是非常有用的。
【分享成果,随喜正能量】万物从心而过,而心如若保持着这份淡定与空漠,那么一切的从心而过都会不留痕迹。这或许就可以说是佛家的开悟了吧。而我们的人生或许就该是如此的一个境界与心态,空于万物,也就不会被万物纠葛。真正做到万物从心流过,而不留痕迹。这便是人生。只管善良,待机缘条件成熟,便会有好的结果;若一直作恶,待条件时机到来,就不会有善果。生活,都在自己选择。 跟我学VBA,我这里专注VBA, 授人以渔。我98年开始,从源码接触VBA已经20余年了,随着年龄的增长,越来越觉得有必要把这项技能传递给需要这项技术的职场人员。希望和数据打交道的朋友,都来学习VBA,利用VBA,起码可以提高自己的工作效率,可以有时间多陪陪父母,多陪陪家人,何乐而不为呢? 这讲我们继续学习64位Office API声明语句之65讲,这些内容是MS的权威资料,看似枯燥,但对于想学习API函数的朋友是非常有用的。 Declarations by API function CloseClipboard Declare PtrSafe Function CloseClipboard Lib "User32" () As LongPtr CopyMemory #If VBA7 Then CreateProcess This is a complicated one because it has a lot of arguments. A fully functional example is included below the example declaration lines. Declare Function CreateProcess Lib "kernel32" _ DrawMenuBar #If VBA7 Then EmptyClipboard Declare PtrSafe Function EmptyClipboard Lib "User32" () As LongPtr FindWindow Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long FindWindowEx Private Declare Function FindWindowEx Lib "USER32" _ GdipCreateBitmapFromFile Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As LongPtr GdipCreateHBITMAPFromBitmap Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As LongPtr GdipDisposeImage Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr GdiplusShutdown Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr GdiplusStartup Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long Private Type GdiplusStartupInput Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr GetClassName Public Declare Function GetClassName Lib "USER32" Alias "GetClassNameA" _ GetDiskFreeSpaceEx Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _ Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias _ getDC Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long GetDesktopWindow Public Declare Function GetDesktopWindow Lib "USER32" () As Long getDeviceCaps Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long GetDriveType Private Declare Function GetDriveType Lib "kernel32" Alias _ GetExitCodeProcess #If VBA7 Then GetForegroundWindow Declare Function GetForegroundWindow Lib "user32.dll" () As Long getFrequency Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long GetKeyState #If VBA7 Then GetLastInputInfo #If VBA7 Then GetOpenFileName Option Explicit GetSystemMetrics Private Declare Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long GetTempPath Declare Function GetTempPath Lib "kernel32" _ getTickCount Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long getTime Private Declare Function timeGetTime Lib "winmm.dll" () As Long GetWindow Public Declare Function GetWindow Lib "USER32" _ GetWindowLong This is one of the few API functions that requires the Win64 compile constant: #If VBA7 Then GetWindowsDirectory Declare Function GetWindowsDirectory& Lib "kernel32" Alias _ GetWindowText Public Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _ GlobalAlloc Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr GlobalLock Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr InternetGetConnectedState Public Declare Function InternetGetConnectedState _ IsCharAlphaNumericA Private Declare Function IsCharAlphaNumericA Lib "USER32" (ByVal byChar As Byte) As Long lstrcopy Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr Mouse_Event #If VBA7 Then OleCreatePictureIndirect Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr 我20多年的VBA实践经验,全部浓缩在下面的各个教程中: 希望有志于学习VBA的职场朋友选择。API函数的声明及其典型示例
Declare Function CloseClipboard Lib "User32" () As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef destination As Any, ByRef SOURCE As Any, ByVal Length As LongPtr)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByRef destination As Any, ByRef SOURCE As Any, ByVal Length As Long)
#End If
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 lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Declare PtrSafe 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 lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As LongPtr
'Full example shown below, including the necessary structures
#If VBA7 Then
Declare PtrSafe 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 lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As LongPtr
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As LongPtr
hThread As LongPtr
dwProcessId As Long
dwThreadId As Long
End Type
Private 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 Byte
hStdInput As LongPtr
hStdOutput As LongPtr
hStdError As LongPtr
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As LongPtr
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#Else
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 lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Const INFINITE = &HFFFF
Const STARTF_USESHOWWINDOW = &H1
Private Enum enSW
SW_HIDE = 0
SW_NORMAL = 1
SW_MAXIMIZE = 3
SW_MINIMIZE = 6
End Enum
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private 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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Enum enPriority_Class
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
#End If
Private Function SuperShell(ByVal App As String, ByVal WorkDir As String, dwMilliseconds As Long, _
ByVal start_size As enSW, ByVal Priority_Class As enPriority_Class) As Boolean
Dim pclass As Long
Dim sinfo As STARTUPINFO
Dim pinfo As PROCESS_INFORMATION
'Not used, but needed
Dim sec1 As SECURITY_ATTRIBUTES
Dim sec2 As SECURITY_ATTRIBUTES
'Set the structure size
sec1.nLength = Len(sec1)
sec2.nLength = Len(sec2)
sinfo.cb = Len(sinfo)
'Set the flags
sinfo.dwFlags = STARTF_USESHOWWINDOW
'Set the window's startup position
sinfo.wShowWindow = start_size
'Set the priority class
pclass = Priority_Class
'Start the program
If CreateProcess(vbNullString, App, sec1, sec2, False, pclass, _
0&, WorkDir, sinfo, pinfo) Then
'Wait
' WaitForSingleObject pinfo.hProcess, dwMilliseconds
SuperShell = True
Else
SuperShell = False
End If
End Function
Sub Test()
Dim sFile As String
'Set the dialog's title
sFile = Application.GetOpenFilename("Executables (*.exe), *.exe", , "")
SuperShell sFile, Left(sFile, InStrRev(sFile, "\")), 0, SW_NORMAL, HIGH_PRIORITY_CLASS
End Sub
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "USER32" _
Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Declare PtrSafe Function GetClassName Lib "USER32" Alias "GetClassNameA" _
(ByVal hWnd As LongPtr, ByVal lpClassName As String, _
ByVal nMaxCount As LongPtr) As Long
Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
"GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
Currency, lpTotalNumberOfFreeBytes As Currency) As LongPtr
Private Declare PtrSafe Function GetDC Lib "USER32" (ByVal hWnd As LongPtr) As LongPtr
Public Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
"GetDriveTypeA" (ByVal sDrive As String) As Long
Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
"GetDriveTypeA" (ByVal sDrive As String) As LongPtr
Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal _
hProcess As LongPtr, lpExitCode As Long) As Long
#Else
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal _
hProcess As Long, lpExitCode As Long) As Long
#End If
Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Declare PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
Declare Function GetKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If
Private Type LASTINPUTINFO
cbSize As LongPtr
dwTime As LongPtr
End Type
Private Declare PtrSafe Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#Else
Private Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#End If
#If VBA7 Then
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
#Else
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
#End If
'/////////////////////////////////
'// End code GetOpenFileName //
'/////////////////////////////////
Public Function GetMyFile(strTitle As String) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
OpenFile.lpstrFilter = ""
OpenFile.nFilterIndex = 1
OpenFile.hwndOwner = 0
OpenFile.lpstrFile = String(257, 0)
#If VBA7 Then
OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = LenB(OpenFile)
#Else
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = Len(OpenFile)
#End If
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = strTitle
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
GetMyFile = ""
Else
GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If
End Function
Private Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpbuffer As String) As Long
Declare PtrSafe Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As longptr, _
ByVal lpbuffer As String) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
'
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Public Declare PtrSafe Function GetWindow Lib "USER32" _
(ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
#Else
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
#End If
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As Long)
Declare PtrSafe Function GetWindowsDirectory& Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpbuffer As String, _
ByVal nSize As LongPtr)
(ByVal hWnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Lib "wininet.dll" (lpdwFlags As Long, _
ByVal dwReserved As Long) As Boolean
Public Declare PtrSafe Function InternetGetConnectedState _
Lib "wininet.dll" (lpdwFlags As LongPtr, _
ByVal dwReserved As long) As Boolean
Private Declare PtrSafe Function IsCharAlphaNumericA Lib "USER32" (ByVal byChar As Byte) As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As LongPtr)
#Else
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
#End If
Private Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type