├── .gitignore ├── examples ├── README.md ├── Beep.bas ├── Sleep.bas ├── GetTempPath.bas ├── GetUserName.bas ├── GetComputerName.bas ├── GetSystemMetrics.bas ├── EnumDisplayMonitors.bas ├── GetWindowRect.bas ├── GetTempFileName.bas ├── ShellExecute.bas ├── GetLocaleInfo.bas ├── VkKeyScanEx.bas ├── SetWindowPos │ └── HWND_TOPMOST.bas ├── clipboard │ └── put-text.bas ├── FindWindow │ └── FindWindowEx.bas ├── SendMessage │ └── WM_SETTEXT.bas ├── EnumWindows.bas ├── FormatMessage.bas ├── CreateProcess.bas ├── BringWindowToTop.bas ├── SendInput.bas ├── PSAPI │ └── EnumProcessModules.bas ├── EnumChildWindows.bas ├── SetWindowsHookEx │ └── WH_KEYBOARD_LL.bas ├── key-press.bas ├── DbgHelp │ └── ListExportedFuncsOfDll.bas ├── winsock │ └── webserver.bas ├── CreateWindowEx │ ├── listbox.bas │ └── helloWorld.bas └── SetWinEventHook │ └── EVENT_OBJECT_CREATE.bas ├── README.md ├── ConvenienceWrapperOle.bas ├── ole.bas ├── wsock32.bas ├── ConvenienceWrapper.bas └── WinAPI.bas /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | -------------------------------------------------------------------------------- /examples/README.md: -------------------------------------------------------------------------------- 1 | See https://renenyffenegger.ch/notes/development/languages/VBA/Win-API/examples/index 2 | -------------------------------------------------------------------------------- /examples/Beep.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | call Beep(440, 200) 6 | call Beep(880, 200) 7 | 8 | end sub 9 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # WinAPI-4-VBA 2 | Windows API for Visual Basic for Applications 3 | 4 | See https://renenyffenegger.ch/notes/development/languages/VBA/Win-API 5 | -------------------------------------------------------------------------------- /examples/Sleep.bas: -------------------------------------------------------------------------------- 1 | sub main() 2 | 3 | msgBox "I am going to sleep for three soconds" 4 | 5 | ' 6 | ' The Sleep call expects the duration in milliseconds. 7 | ' 3000 milliseconds is 3 seconds 8 | ' 9 | Sleep 3000 10 | 11 | msgBox "Woken up" 12 | 13 | end sub 14 | -------------------------------------------------------------------------------- /examples/GetTempPath.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim tempPath as string * 512 6 | dim result as long 7 | 8 | result = GetTempPath(512, tempPath) 9 | 10 | if result <> 0 then 11 | msgBox "Temp path: " & tempPath 12 | else 13 | msgBox "Calling GetTempPath failed" 14 | end if 15 | 16 | end sub 17 | 18 | -------------------------------------------------------------------------------- /examples/GetUserName.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim userName as string * 32 6 | dim result as long 7 | 8 | result = GetUserName(userName, 32) 9 | 10 | if result <> 0 then 11 | msgBox "The currently logged in user is " & userName 12 | else 13 | msgBox "Calling GetUserName failed" 14 | end if 15 | 16 | end sub 17 | -------------------------------------------------------------------------------- /examples/GetComputerName.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim NetBiosName as string * 32 6 | dim result as long 7 | 8 | result = GetComputerName(NetBiosName, 32) 9 | 10 | if result <> 0 then 11 | msgBox "The Net BIOS name of the computer is " & NetBiosName 12 | else 13 | msgBox "Calling GetComputerName failed" 14 | end if 15 | 16 | end sub 17 | -------------------------------------------------------------------------------- /ConvenienceWrapperOle.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | function CoCreateGuid_ as GUID ' { 4 | 5 | if CoCreateGuid(CoCreateGuid_) <> 0 then 6 | MsgBox "Something went wrong with CoCreateGuid" 7 | end if 8 | 9 | end function ' } 10 | 11 | function StringFromGUID2_(rguid as GUID) as string ' { 12 | 13 | StringFromGUID2_ = space$(38) 14 | 15 | call StringFromGUID2 (rguid, strPtr(StringFromGUID2_), 38*2) 16 | 17 | end function ' } 18 | -------------------------------------------------------------------------------- /examples/GetSystemMetrics.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() ' { 4 | 5 | debug.print "Number of display monitors on the desktop: " & GetSystemMetrics(SM_CMONITORS ) 6 | debug.print "Width of primary monitor: " & GetSystemMetrics(SM_CXSCREEN ) 7 | debug.print "Height of primary monitor: " & GetSystemMetrics(SM_CYSCREEN ) 8 | debug.print "Slow (low-end) processor: " & GetSystemMetrics(SM_SLOWMACHINE) 9 | 10 | end sub ' } 11 | -------------------------------------------------------------------------------- /examples/EnumDisplayMonitors.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | EnumDisplayMonitors 0, 0, addressOf monitorEnumProc, 0 5 | end sub 6 | 7 | 8 | function monitorEnumProc(byVal hMonitor as long, byVal hdcMonitor as long, byRef rMonitor as RECT, byVal dwData as long) as long 9 | debug.print "Found monitor with top left = " & rMonitor.left & "," & rMonitor.top & " and size = " & (rMonitor.right-rMonitor.left) & "x" (rMonitor.bottom-rMonitor.top) 10 | 11 | ' Return true so as to continue with the enumeration 12 | monitorEnumProc = true 13 | end function 14 | -------------------------------------------------------------------------------- /examples/GetWindowRect.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim hWndNotepad as long 6 | 7 | ' 8 | ' Start notepad 9 | ' 10 | ShellExecute 0, "Open", "notepad.exe", "", "", 1 11 | 12 | ' 13 | ' Wait for notepad to initialize. 14 | ' 15 | Sleep 200 16 | 17 | ' 18 | ' Find the window handle for notepad 19 | ' 20 | hWndNotepad = FindWindow("notepad", vbNullString) 21 | 22 | dim r as RECT 23 | call GetWindowRect(hWndNotepad, r) 24 | msgBox "Notepad dimensions: " & (r.right - r.left) & " x " & (r.bottom - r.top) & ", top left corner at " & r.left & "/" & r.top 25 | 26 | 27 | end sub 28 | -------------------------------------------------------------------------------- /examples/GetTempFileName.bas: -------------------------------------------------------------------------------- 1 | sub main() 2 | 3 | dim tempPath as string * 512 4 | dim tempFile as string * 512 ' Should be MAX_PATH ! 5 | dim uUnique as long 6 | 7 | 8 | call GetTempPath(512, tempPath) 9 | 10 | uUnique = 0 ' Create unique temporary file names 11 | call GetTempFileName(tempPath, "abc", uUnique, tempFile) 12 | 13 | msgBox "The temporary file is " & tempFile 14 | 15 | ' 16 | ' The temporary file is not yet created. Open it and 17 | ' write something into it: 18 | ' 19 | open tempFile for output as 1 20 | 21 | print# 1, "Foo bar baz" 22 | print# 1, "One two three" 23 | 24 | close# 1 25 | 26 | end sub 27 | -------------------------------------------------------------------------------- /examples/ShellExecute.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub writeFile(filename as string) 4 | 5 | open filename for output as #1 6 | print# 1, "This is the file" 7 | print# 1, "with the filename " & filename 8 | close# 1 9 | 10 | end sub 11 | 12 | 13 | sub main() 14 | 15 | dim file_1 as string 16 | dim file_2 as string 17 | 18 | file_1 = environ("TEMP") & "\one.txt" 19 | file_2 = environ("TEMP") & "\two.txt" 20 | 21 | call writeFile(file_1) 22 | call writeFile(file_2) 23 | 24 | call ShellExecute(0, "Open", file_1 , "" , "", 1) 25 | call ShellExecute(0, "Open", "notepad.exe", file_2, "", 1) 26 | 27 | end sub 28 | -------------------------------------------------------------------------------- /examples/GetLocaleInfo.bas: -------------------------------------------------------------------------------- 1 | sub main() 2 | 3 | dim lLcid as long 4 | dim LCData as string 5 | dim locTxt as string 6 | dim rc as long 7 | 8 | lLcid = GetSystemDefaultLangID() 9 | 10 | LCData = string$(1024, 0) 11 | ' rc = GetLocaleInfo(lLcid, LOCALE_ILANGUAGE, LCData, len(LCData)) 12 | rc = GetLocaleInfo(lLcid, LOCALE_SNAME , LCData, len(LCData)) ' Get a string like "de-CH". 13 | 14 | if rc > 0 then 15 | ' Copy interesting part of LCData. Length is returned in rc, including 16 | ' \x0 character, therefore substracting 1. 17 | locTxt = left$(LCData, rc-1) 18 | debug.print "LOCALE_SNAME = " & locTxt 19 | else 20 | debug.print "Error occured: " & GetLastError() 21 | end if 22 | end sub 23 | -------------------------------------------------------------------------------- /examples/VkKeyScanEx.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | dim keyboardLayout as long 4 | 5 | sub main() ' { 6 | 7 | 8 | keyboardLayout = GetKeyboardLayout(0) 9 | 10 | showCharInfo "c" 11 | showCharInfo "C" 12 | showCharInfo "=" 13 | showCharInfo "+" 14 | ' showCharInfo chr(1) 15 | 16 | end sub ' } 17 | 18 | sub showCharInfo(char as string) ' { 19 | 20 | dim keyScan as integer 21 | dim shift as boolean 22 | dim ctrl as boolean 23 | dim vkKey as integer 24 | 25 | keyScan = VkKeyScanEx(asc(char), keyboardLayout) 26 | 27 | shift = keyScan and &h100 28 | ctrl = keyScan and &h200 29 | vkKey = keyScan and &h0ff 30 | 31 | debug.print char & ": " + iif(shift, "shift ", " ") + iif(ctrl, "ctrl ", " ") & chr(vkKey) & " " & vkKey 32 | 33 | 34 | end sub ' } 35 | -------------------------------------------------------------------------------- /examples/SetWindowPos/HWND_TOPMOST.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim hWndNotepad as long 6 | 7 | call ShellExecute(0, "Open", "notepad.exe", "" , "", 1) 8 | 9 | ' 10 | ' Sleep a short while to give notepad.exe time to start and initialize. 11 | ' Otherwise, the following FindWindow would be too early and not find 12 | ' any window. 13 | ' 14 | call Sleep(100) 15 | 16 | ' 17 | ' The first argument of FindWindow expects a class name. 18 | ' For notepad, the class name is notepad. 19 | ' 20 | hWndNotepad = FindWindow("notepad", vbNullString) 21 | 22 | if hWndNotepad = 0 then 23 | msgBox "could not find notepad window" 24 | exit sub 25 | end if 26 | 27 | ' 28 | ' Put the window to the topmost position: 29 | ' 30 | call SetWindowPos(hWndNotepad, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE) 31 | 32 | end sub 33 | -------------------------------------------------------------------------------- /examples/clipboard/put-text.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim memory as long 6 | dim lockedMemory as long 7 | dim text4clipboard as string 8 | 9 | text4clipboard = "This text was placed into the clipboard via VBA" 10 | 11 | memory = GlobalAlloc(GHND, len(text4clipboard) + 1) 12 | if memory = 0 then 13 | msgBox "GlobalAlloc failed" 14 | exit sub 15 | end if 16 | 17 | lockedMemory = GlobalLock(memory) 18 | if lockedMemory = 0 then 19 | msgBox "GlobalLock failed" 20 | exit sub 21 | end if 22 | 23 | lockedMemory = lstrcpy(lockedMemory, text4clipboard) 24 | 25 | call GlobalUnlock(memory) 26 | 27 | if openClipboard(0) = 0 Then 28 | msgBox "openClipboard failed" 29 | exit sub 30 | end if 31 | 32 | call EmptyClipboard() 33 | 34 | call SetClipboardData(CF_TEXT, memory) 35 | 36 | if CloseClipboard() = 0 then 37 | msgBox "CloseClipboard failed" 38 | end if 39 | 40 | end sub 41 | -------------------------------------------------------------------------------- /examples/FindWindow/FindWindowEx.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | dim hWndNotepadEdit as long 4 | 5 | sub main() 6 | 7 | dim hWndNotepad as long 8 | dim hWndNotepadEdit as long 9 | 10 | ' 11 | ' Start notepad 12 | ' 13 | ShellExecute 0, "Open", "notepad.exe", "", "", 1 14 | 15 | Sleep 200 16 | 17 | ' 18 | ' Find the window handle for notepad 19 | ' 20 | hWndNotepad = FindWindow("notepad", vbNullString) 21 | 22 | ' 23 | ' Find the window handle of the edit control 24 | ' in notepad: 25 | ' 26 | hWndNotepadEdit = FindWindowEx(hWndNotepad, 0, "Edit", vbNullString) 27 | 28 | debug.print "hWndNotepad = " & hWndNotepad 29 | debug.print "hWndNotepadEdit = " & hWndNotepadEdit 30 | debug.print "Parent of edit = " & GetParent(hWndNotepadEdit) 31 | 32 | ' 33 | ' Simulate pressing VK_F5 to insert the current date: 34 | ' 35 | PostMessage hWndNotepadEdit, WM_KEYDOWN, VK_F5, 1 36 | Sleep 50 37 | PostMessage hWndNotepadEdit, WM_KEYUP , VK_F5, 1 38 | 39 | Sleep 2000 40 | 41 | end sub 42 | -------------------------------------------------------------------------------- /examples/SendMessage/WM_SETTEXT.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim hWndNotepad as long 6 | dim hWndNotepadEdit as long 7 | 8 | ' 9 | ' Start notepad 10 | ' 11 | ShellExecute 0, "Open", "notepad.exe", "", "", 1 12 | ' 13 | ' Find the window handle for notepad 14 | ' 15 | hWndNotepad = FindWindow("notepad", vbNullString) 16 | while hWndNotepad = 0 17 | ' 18 | ' Wait a while if notepad window not yet initialized: 19 | ' 20 | Sleep 100 21 | hWndNotepad = FindWindow("notepad", vbNullString) 22 | wend 23 | 24 | ' 25 | ' Find the window handle of the edit control 26 | ' in notepad: 27 | ' 28 | hWndNotepadEdit = FindWindowEx(hWndNotepad, 0, "Edit", vbNullString) 29 | 30 | ' 31 | ' Send WM_SETTEXT to the edit control. 32 | ' 33 | ' Note,using PostMessage instead of SendMessage does not work. 34 | ' I have no clue why SendMessage works, but PostMessage does not! 35 | ' 36 | SendMessage hWndNotepadEdit, WM_SETTEXT, 0, byVal "Some text that was sent with WM_SETTEXT" 37 | 38 | end sub 39 | -------------------------------------------------------------------------------- /examples/EnumWindows.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | global r as long 4 | 5 | sub main() 6 | r = 1 7 | call EnumWindows(addressOf EnumWindowsProc, byVal 0&) 8 | end sub 9 | 10 | function EnumWindowsProc(byVal hWnd as long, byVal lParam as long) as long ' { 11 | 12 | dim windowText as string 13 | dim windowClass as string * 256 14 | dim retVal as long 15 | dim l as long 16 | 17 | cells(r, 1) = hWnd 18 | cells(r, 2) = GetParent(hWnd) 19 | 20 | windowText = space(GetWindowTextLength(hWnd) + 1) 21 | retVal = GetWindowText(hWnd, windowText, len(windowText)) 22 | windowText = left$(windowText, retVal) 23 | cells(r, 3) = windowText 24 | 25 | retVal = GetClassName(hWnd, windowClass, 255) 26 | windowClass = left$(windowClass, retVal) 27 | cells(r, 4) = windowClass 28 | 29 | 30 | 31 | r = r + 1 32 | 33 | ' 34 | ' Return true to indicate that we want to continue 35 | ' with the enumeration of the windows: 36 | ' 37 | EnumWindowsProc = true 38 | 39 | end function ' } 40 | -------------------------------------------------------------------------------- /examples/FormatMessage.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() 4 | 5 | dim errNo as long 6 | dim rc as long 7 | dim langId as long 8 | 9 | dim errStr as string * FORMAT_MESSAGE_TEXT_LEN 10 | 11 | ' 12 | ' The error number for which the text has to be retrieved: 13 | ' 14 | errNo = 1428 15 | 16 | ' 17 | ' The language into which to format the message. 0 = default language. 18 | ' 19 | langId = 0 20 | 21 | rc = FormatMessage ( _ 22 | FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _ 23 | 0 , _ 24 | errNo , _ 25 | langId , _ 26 | errStr , _ 27 | FORMAT_MESSAGE_TEXT_LEN , _ 28 | 0) 29 | 30 | if rc <> 0 then 31 | msgBox "Error text for " & errNo & " is: " & errStr 32 | else 33 | msgBox "Could not format message" 34 | end if 35 | 36 | end sub 37 | -------------------------------------------------------------------------------- /examples/CreateProcess.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() ' { 4 | 5 | dim secAttrPrc as SECURITY_ATTRIBUTES : secAttrPrc.nLength = len(secAttrPrc) 6 | dim secAttrThr as SECURITY_ATTRIBUTES : secAttrThr.nLength = len(secAttrThr) 7 | 8 | dim startInfo as STARTUPINFO ' : startInfo.cb = len(startInfo) 9 | dim procInfo as PROCESS_INFORMATION 10 | 11 | if CreateProcess ( _ 12 | lpApplicationName := vbNullString , _ 13 | lpCommandLine := "cmd.exe" , _ 14 | lpProcessAttributes := secAttrPrc , _ 15 | lpThreadAttributes := secAttrThr , _ 16 | bInheritHandles := false , _ 17 | dwCreationFlags := 0 , _ 18 | lpEnvironment := 0 , _ 19 | lpCurrentDirectory := environ("USERPROFILE") , _ 20 | lpStartupInfo := startInfo , _ 21 | lpProcessInformation := procInfo ) then 22 | 23 | else 24 | MsgBox "Couldn't create process" 25 | end if 26 | 27 | end sub ' } 28 | -------------------------------------------------------------------------------- /examples/BringWindowToTop.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | global captionPart_ as string 4 | 5 | sub main(captionPart as string) 6 | 7 | captionPart_ = captionPart 8 | 9 | call EnumWindows(addressOf EnumWindowsProc, byVal 0&) 10 | 11 | ' 12 | ' If called from the visual basic editor, sleep for a second 13 | ' so as to see the effect of the procedure 14 | ' 15 | call Sleep (1000) 16 | 17 | end sub 18 | 19 | function EnumWindowsProc(byVal hWnd as long, byVal lParam as long) as long ' { 20 | 21 | dim windowText as string 22 | dim windowClass as string * 256 23 | dim retVal as long 24 | 25 | windowText = space(GetWindowTextLength(hWnd) + 1) 26 | retVal = GetWindowText(hWnd, windowText, len(windowText)) 27 | windowText = left$(windowText, retVal) 28 | 29 | if inStr(1, windowText, captionPart_, vbTextCompare) then 30 | 31 | call ShowWindow(hWnd, SW_SHOW) 32 | call SetForeGroundWindow(hWnd) 33 | 34 | ' 35 | ' We have found a Window, the iteration 36 | ' process can be stopped 37 | ' 38 | EnumWindowsProc = false 39 | exit function 40 | 41 | end if 42 | 43 | EnumWindowsProc = true 44 | 45 | end function ' } 46 | -------------------------------------------------------------------------------- /examples/SendInput.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | dim keyInput() as INPUT_ 4 | dim sizeINPUT as long 5 | 6 | sub main() ' { 7 | 8 | sizeINPUT = lenB(keyInput(0)) 9 | 10 | call Windows_R() 11 | call Sleep(100) 12 | 13 | call pressAndRelease("notepad") 14 | call enter() 15 | 16 | call Sleep(200) 17 | 18 | pressAndRelease ("someText") 19 | 20 | end sub ' } 21 | 22 | sub Windows_R() ' { 23 | 24 | redim keyInput(0 to 3) 25 | 26 | keyInput(0).dwType = INPUT_KEYBOARD 27 | keyInput(0).dwFlags = 0 ' Press key 28 | keyInput(0).wVK = VK_LWIN 29 | 30 | keyInput(1).dwType = INPUT_KEYBOARD 31 | keyInput(1).dwFlags = 0 ' Press key 32 | keyInput(1).wVK = VkKeyScan(asc("r")) 33 | 34 | keyInput(2).dwType = INPUT_KEYBOARD 35 | keyInput(2).dwFlags = KEYEVENTF_KEYUP 36 | keyInput(2).wVK = VkKeyScan(asc("r")) 37 | 38 | keyInput(3).dwType = INPUT_KEYBOARD 39 | keyInput(3).dwFlags = KEYEVENTF_KEYUP 40 | keyInput(3).wVK = VK_LWIN 41 | call SendInput(4, keyInput(0), sizeINPUT) 42 | 43 | end sub ' } 44 | 45 | sub pressAndRelease(text as string) ' { 46 | 47 | dim c as string 48 | dim i as long 49 | redim keyInput(0 to len(text)*2 - 1) as INPUT_ 50 | 51 | for i = 0 to len(text) -1 ' { 52 | 53 | c = mid(text, i+1, 1) 54 | 55 | keyInput(i*2).dwType = INPUT_KEYBOARD 56 | keyInput(i*2).dwFlags = 0 57 | keyInput(i*2).wVK = VkKeyScan(asc(c)) 58 | 59 | keyInput(i*2+1).dwType = INPUT_KEYBOARD 60 | keyInput(i*2+1).dwFlags = KEYEVENTF_KEYUP 61 | keyInput(i*2+1).wVK = VkKeyScan(asc(c)) 62 | 63 | next i ' } 64 | 65 | call SendInput(i*2, keyInput(0), sizeINPUT) 66 | 67 | end sub ' } 68 | 69 | sub enter() ' { 70 | redim keyInput(0 to 1) ' 71 | 72 | keyInput(0).dwType = INPUT_KEYBOARD 73 | keyInput(0).dwFlags = 0 ' Press key 74 | keyInput(0).wVK = VK_RETURN 75 | 76 | keyInput(1).dwType = INPUT_KEYBOARD 77 | keyInput(1).dwFlags = KEYEVENTF_KEYUP 78 | keyInput(1).wVK = VK_RETURN 79 | 80 | call SendInput(2, keyInput(0), sizeINPUT) 81 | 82 | end sub ' } 83 | -------------------------------------------------------------------------------- /ole.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | enum HRESULT_values 4 | ' NULL_ = 0 5 | S_OK = 0 ' Operation successful 6 | S_FALSE = 1 7 | E_ABORT = &h80004004 ' Operation aborted 8 | E_ACCESSDENIED = &h80070005 ' General access denied error 9 | E_FAIL = &h80004005 ' Unspecified failure 10 | E_HANDLE = &h80070006 ' Invalid handle 11 | E_INVALIDARG = &h80070057 ' One or more arguments are not valid 12 | E_NOINTERFACE = &h80004002 ' No such interface supported 13 | E_NOTIMPL = &h80004001 ' Not implemented 14 | E_OUTOFMEMORY = &h8007000E ' Failed to allocate necessary memory 15 | E_POINTER = &h80004003 ' Invalid pointer 16 | E_UNEXPECTED = &h8000FFFF ' Unexpected failure 17 | end enum 18 | 19 | type GUID ' { 20 | ' 21 | ' Declared in rpcdce.h / included by rpc.h 22 | ' 23 | Data1 as long 24 | Data2 as integer 25 | Data3 as integer 26 | Data4 (0 to 7) as byte 27 | end type ' } 28 | 29 | declare function CoTaskMemAlloc lib "ole32" ( _ 30 | byVal cb as long) as long 31 | 32 | declare function CoCreateGuid lib "ole32" ( _ 33 | pguid as GUID) as long 34 | 35 | declare sub CoTaskMemFree lib "ole32" ( _ 36 | byVal pv as long) 37 | 38 | declare function IIDFromString lib "ole32" ( _ 39 | byVal lpsz as long, _ 40 | byVal lpiid as long) as long 41 | 42 | declare function StringFromGUID2 lib "ole32" ( _ 43 | rguid as GUID, _ 44 | byVal lpOleChar as any , _ 45 | byVal cbmax as long) as long 46 | 47 | declare function SysAllocStringByteLen lib "oleaut32" ( _ 48 | byVal psz as long, _ 49 | ByVal cblen as long) as long 50 | 51 | declare function VariantCopy lib "oleaut32" ( _ 52 | function CoCreateGuid_ as GUID ' { 53 | 54 | if CoCreateGuid(CoCreateGuid_) <> 0 then 55 | MsgBox "Something went wrong with CoCreateGuid" 56 | end if 57 | 58 | end function ' } 59 | 60 | function StringFromGUID2_(rguid as GUID) as string ' { 61 | 62 | StringFromGUID2_ = space$(38) 63 | 64 | call StringFromGUID2 (rguid, strPtr(StringFromGUID2_), 38*2) 65 | 66 | end function ' } 67 | byVal pvargDest as long, _ 68 | byRef pvargSrc as variant) as long 69 | -------------------------------------------------------------------------------- /examples/PSAPI/EnumProcessModules.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | sub main() ' { 4 | 5 | dim hProc as long 6 | 7 | hProc = GetCurrentProcess() 8 | if hProc = 0 then 9 | debug.print "Failed to find current process" 10 | exit sub 11 | end if 12 | 13 | call enumProcModules(hProc, environ$("TEMP") & "\enumProcModules.txt") 14 | 15 | end sub ' } 16 | 17 | sub enumProcModules(hProc as long, optional fileName as string) ' { 18 | 19 | const maxNumOfModules = 1024 20 | const sizeOfHANDLE = 4 21 | dim bytesNeeded as long 22 | 23 | dim bFilterModule as boolean 24 | dim lCountMatching as long 25 | dim bRetVal as boolean 26 | dim nofModules as long 27 | dim stringMaxPath as string * MAX_PATH 28 | dim moduleBaseName as string 29 | dim modulePath as string 30 | dim module_info as MODULEINFO 31 | dim lenString as long 32 | dim fileNo as integer 33 | 34 | dim moduleHandles(maxNumOfModules) as long 35 | 36 | if EnumProcessModules(hProc, moduleHandles(0), (maxNumOfModules * sizeOfHANDLE), bytesNeeded) = false then 37 | debug.print "EnumProcessModules failed" 38 | exit sub 39 | end if 40 | 41 | nofModules = bytesNeeded / sizeOfHANDLE 42 | 43 | if fileName <> "" then 44 | fileNo = freeFile() 45 | open fileName for output as #fileNo 46 | end if 47 | 48 | dim m as long 49 | for m = 0 to nofModules - 1 ' { 50 | 51 | if moduleHandles(m) = 0 then 52 | goto skipModule 53 | end if 54 | 55 | if GetModuleInformation(hProc, moduleHandles(m), module_info, bytesNeeded) = 0 then 56 | debug.print "Could not get module info" 57 | goto skipModule 58 | end if 59 | 60 | lenString = GetModuleFileNameEx(hProc, moduleHandles(m), stringMaxPath, MAX_PATH) 61 | modulePath = mid$(stringMaxPath, 1, lenString) 62 | 63 | lenString = GetModuleBaseName(hProc, moduleHandles(m), stringMaxPath, MAX_PATH) 64 | moduleBaseName = mid$(stringMaxPath, 1, lenString) 65 | 66 | if fileName = "" then 67 | debug.print modulePath 68 | debug.print " " & moduleBaseName 69 | debug.print " " & module_info.lpBaseOfDll 70 | debug.print " " & module_info.SizeofImage 71 | debug.print " " & module_info.EntryPoint 72 | else 73 | print# fileNo, modulePath 74 | print# fileNo, " " & moduleBaseName 75 | print# fileNo, " " & module_info.lpBaseOfDll 76 | print# fileNo, " " & module_info.SizeofImage 77 | print# fileNo, " " & module_info.EntryPoint 78 | end if 79 | 80 | skipModule: 81 | next m ' } 82 | 83 | if fileName <> "" then 84 | close# fileNo 85 | end if 86 | 87 | erase moduleHandles 88 | call CloseHandle(hProc) 89 | 90 | end sub ' } 91 | -------------------------------------------------------------------------------- /examples/EnumChildWindows.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | global row_ as long 4 | global indent_ as long 5 | global cbFunc as long 6 | const maxIter = 3333 7 | global cntIter as long 8 | 9 | ' 10 | ' The variable isTopLevel is set to true in the 11 | ' call back that iterates over the top level 12 | ' windows (CallBackFuncTopLevel). 13 | ' In the function that iterates over a top 14 | ' level's descendants, it is set to false. 15 | ' Thus, it was needed to determine if in a recursive 16 | ' strategy, I have to descend into the windows. 17 | ' I am not sure, if the variable is still needed... 18 | ' 19 | global isTopLevel as boolean 20 | 21 | sub main() 22 | row_ = 1 23 | indent_ = 1 24 | 25 | cbFunc = getAddr(addressOf CallBackFunc) 26 | 27 | ' 28 | ' Iterate over top level windows (?) 29 | ' 30 | call EnumWindows(addressOf CallBackFuncTopLevel, 0) 31 | 32 | end sub 33 | 34 | function getAddr(addr as long) as long 35 | getAddr = addr 36 | end function 37 | 38 | function CallBackFuncTopLevel(byVal hWnd as long, byVal lParam as long) as long 39 | 40 | isTopLevel = true 41 | call nextWindow(hWnd) 42 | 43 | CallBackFuncTopLevel = true 44 | 45 | end function 46 | 47 | function CallBackFunc(byVal hWnd as long, byVal lParam as long) as long 48 | 49 | 50 | dim hWndParent as long 51 | 52 | if cntIter > maxIter then 53 | CallBackFunc = false 54 | exit function 55 | end if 56 | 57 | ' 58 | ' Apparently, EnumChildWindows also iterates over GrandChildren 59 | ' and further descendants. 60 | ' We're interested in immediate children only: 61 | ' 62 | hWndParent = GetParent(hWnd) 63 | if not isTopLevel and hWndParent <> lParam then 64 | CallBackFunc = true 65 | exit function 66 | end if 67 | 68 | cntIter = cntIter + 1 69 | ' 70 | ' We're pretty sure that we're not a top level window: 71 | isTopLevel = false 72 | 73 | call nextWindow(hWnd) 74 | 75 | 76 | ' 77 | ' Return true to indicate that we want to continue 78 | ' with the enumeration of the windows: 79 | ' 80 | CallBackFunc = true 81 | 82 | end function 83 | 84 | sub nextWindow(hWnd as long) 85 | 86 | dim hWndParent as long 87 | dim windowText as string 88 | dim windowClass as string * 256 89 | dim retVal as long 90 | 91 | hWndParent = GetParent(hWnd) 92 | 93 | cells(row_, 1) = hWndParent 94 | cells(row_, 2) = hWnd 95 | ' cells(row_, 3) = lParam 96 | 97 | retVal = GetClassName(hWnd, windowClass, 255) 98 | windowClass = left$(windowClass, retVal) 99 | cells(row_, 4) = rtrim(windowClass) 100 | 101 | windowText = space(GetWindowTextLength(hWnd) + 1) 102 | retVal = GetWindowText(hWnd, windowText, len(windowText)) 103 | windowText = left$(windowText, retVal) 104 | cells(row_, 5 + indent_) = ">" & windowText 105 | 106 | row_ = row_ + 1 107 | indent_ = indent_ + 1 108 | call EnumChildWindows(hWnd, cbFunc, hWnd) 109 | indent_ = indent_ - 1 110 | 111 | end sub 112 | -------------------------------------------------------------------------------- /examples/SetWindowsHookEx/WH_KEYBOARD_LL.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | dim hookHandle as long 4 | dim hookStarted as boolean 5 | 6 | public cnt as long 7 | 8 | function LowLevelKeyboardProc(byVal nCode as long, byVal wParam as long, lParam as KBDLLHOOKSTRUCT) as long ' { 9 | 10 | dim upOrDown as string 11 | dim altKey as boolean 12 | dim char as string 13 | 14 | if nCode <> HC_ACTION then 15 | LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, byVal lParam) 16 | exit function 17 | end if 18 | 19 | select case wParam 20 | case WM_KEYDOWN : upOrDown = "keyDown" 21 | case WM_KEYUP : upOrDown = "keyUp" 22 | case WM_SYSKEYDOWN: upOrDown = "sysDown" 23 | case WM_SYSKEYUP : upOrDown = "sysUp" 24 | end select 25 | 26 | ' 27 | ' Apparently, the 5th bit is set if an ALT key was involved: 28 | ' 29 | altKey = lParam.flags and 32 30 | 31 | if ( lParam.vkCode >= asc("A") ) and ( lParam.vkCode <= asc("Z") ) then 32 | char = chr(lParam.vkCode) 33 | 34 | else 35 | 36 | select case lParam.vkCode 37 | case VK_ESCAPE : char = "esc" 38 | 39 | case VK_LCONTROL : char = "ctrl L" 40 | case VK_RCONTROL : char = "ctrl R" 41 | 42 | case VK_LMENU : char = "menu L" 43 | case VK_RMENU : char = "menu R" 44 | 45 | case VK_RIGHT : char = ">>" 46 | case VK_LEFT : char = "<<" 47 | case VK_UP : char = "^^" 48 | case VK_DOWN : char = "vv" 49 | 50 | case VK_LSHIFT : char = "shift L" 51 | case VK_RSHIFT : char = "shift R" 52 | 53 | case VK_LWIN : char = "win L" 54 | case VK_RWIN : char = "win R" 55 | 56 | case VK_RETURN : char = "enter" 57 | case else : char = "?" 58 | end select 59 | 60 | end if 61 | 62 | ' 63 | ' Display what the user has pressed. 64 | '(Needs Excel) 65 | ' 66 | cells(1,1) = upOrDown 67 | cells(1,2) = lParam.vkCode 68 | cells(1,3) = char 69 | cells(1,4) = lParam.flags 70 | 71 | if altKey then cells(1,5) = "alt" else cells(1,5) = "-" 72 | 73 | if lParam.vkCode = VK_ESCAPE then stopHook 74 | 75 | LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, byVal lParam) 76 | 77 | end function ' } 78 | 79 | public sub stopHook() ' { 80 | 81 | if hookStarted then 82 | UnhookWindowsHookEx hookHandle 83 | hookStarted = false 84 | end if 85 | 86 | cells.clear 87 | 88 | end sub ' } 89 | 90 | sub installHook() ' { 91 | 92 | ' don't hook the keyboard twice !! 93 | 94 | 95 | if hookStarted = false then 96 | hookHandle = SetWindowsHookEx( _ 97 | WH_KEYBOARD_LL , _ 98 | addressOf LowLevelKeyboardProc , _ 99 | application.hInstance , _ 100 | 0 ) 101 | 102 | if hookHandle <> 0 then 103 | hookStarted = true 104 | else 105 | msgBox "Could not install hook" 106 | end if 107 | 108 | else 109 | msgBox "Hook is already enabled" 110 | end if 111 | 112 | end sub ' } 113 | -------------------------------------------------------------------------------- /examples/key-press.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' https://stackoverflow.com/questions/11153995/is-there-any-event-that-fires-when-keys-are-pressed-when-editing-a-cell 3 | ' 4 | ' call trackKeyPressInit 5 | ' call stopKeyWatch 6 | ' 7 | ' TODO: Win 64 Api -> https://msdn.microsoft.com/en-us/VBA/Language-Reference-VBA/articles/ptrsafe-keyword 8 | ' 9 | option explicit 10 | 11 | private bExitLoop as boolean 12 | 13 | sub trackKeyPressInit() 14 | 15 | dim msgMessage as MSG 16 | dim propagateKeyPress as boolean 17 | dim iKeyCode as integer 18 | dim lXLhwnd as long 19 | 20 | on error GoTo errHandler: 21 | 22 | application.enableCancelKey = xlErrorHandler 23 | 24 | ' initialize this boolean flag. 25 | bExitLoop = False 26 | 27 | ' get the app hwnd. 28 | lXLhwnd = FindWindow("XLMAIN", application.caption) 29 | 30 | do 31 | WaitMessage 32 | 33 | ' Check for a key press and remove it from the msg queue. 34 | 35 | if PeekMessage (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then 36 | 37 | ' strore the virtual key code for later use. 38 | iKeyCode = msgMessage.wParam 39 | 40 | ' translate the virtual key code into a char msg. 41 | TranslateMessage msgMessage 42 | call PeekMessage(msgMessage, lXLhwnd, WM_CHAR, WM_CHAR, PM_REMOVE) 43 | 44 | ' for some obscure reason, the following 45 | ' keys are not trapped inside the event handler 46 | ' so we handle them here. 47 | 48 | if iKeyCode = vbKeyBack then SendKeys "{BS}" 49 | if iKeyCode = vbKeyReturn then SendKeys "{ENTER}" 50 | 51 | propagateKeyPress = true 52 | 53 | ' The VBA RaiseEvent statement does not seem to return ByRef arguments 54 | ' so we call a KeyPress routine rather than a propper event handler. 55 | call keyPressed(byVal msgMessage.wParam, byVal iKeyCode, propagateKeyPress) 56 | 57 | ' if the key pressed is allowed post it to the application. 58 | if propagateKeyPress then 59 | call PostMessage(lXLhwnd, msgMessage.Message, msgMessage.wParam, 0) 60 | end if 61 | end if 62 | errHandler: 63 | ' allow the processing of other msgs. 64 | doEvents 65 | loop until bExitLoop 66 | 67 | end sub 68 | 69 | sub stopKeyWatch() 70 | bExitLoop = true 71 | end sub 72 | 73 | 74 | 75 | private sub keyPressed(byVal KeyAscii as integer, _ 76 | byVal KeyCode as integer, _ 77 | byRef propagateKeyPress as boolean) 78 | 79 | debug.print keyAscii 80 | 81 | if chr(keyAscii) = "9" then 82 | bExitLoop = true 83 | end if 84 | 85 | if chr(keyAscii) = "8" then 86 | propagateKeyPress = false 87 | end if 88 | 89 | 90 | ' if Not Intersect(Target, Range("A1:D10")) Is Nothing Then 91 | ' if Chr(KeyAscii) Like "[0-9]" Then 92 | ' MsgBox MSG & Range("A1:D10").Address(False, False) _ 93 | ' & """ .", vbCritical, TITLE 94 | ' Cancel = True 95 | ' end If 96 | ' end If 97 | 98 | End Sub 99 | 100 | -------------------------------------------------------------------------------- /examples/DbgHelp/ListExportedFuncsOfDll.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' http://www.tech-archive.net/Archive/VB/microsoft.public.vb.general.discussion/2007-09/msg00228.html 3 | ' 4 | option explicit 5 | 6 | ' 7 | ' Hmmm… why is this necessary? 8 | ' 9 | private declare sub MoveMemoryLong lib "kernel32" alias "RtlMoveMemory" ( _ 10 | Target as any , _ 11 | byVal LPointer as long, _ 12 | byVal cbCopy as long) 13 | 14 | 15 | sub listExportedFuncs() ' { 16 | dim img as LOADED_IMAGE 17 | dim peHeader as IMAGE_NT_HEADERS32 ' Was IMAGE_PE_FILE_HEADER 18 | dim expTable as IMAGE_EXPORT_DIRECTORY_TABLE 19 | 20 | dim dllPath as string 21 | dllPath = "C:\Windows\System32\msvbvm60.dll" 22 | ' dllPath = "C:\Program Files (x86)\Common Files\microsoft shared\VBA\VBA7.1\VBE7.DLL" 23 | 24 | if MapAndLoad(dllPath, dllPath, img, true, true) = 0 then 25 | debug.print "Could not map " & dllPath 26 | exit sub 27 | end if 28 | 29 | on error goto err_ 30 | 31 | dim fOut as integer: fOut = freeFile 32 | open environ$("TEMP") & "\exportedFuncs.txt" for output as #fOut 33 | 34 | ' Copy PE file header: 35 | RtlMoveMemory byVal varPtr(peHeader), byVal img.FileHeader, lenb(peHeader) 36 | 37 | ' Get export table offset as relative virtual address (RVAs) 38 | dim expRVA as long 39 | expRVA = peHeader.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_EXPORT).RVA 40 | 41 | if expRVA = 0 then 42 | call UnMapAndLoad(img) 43 | end if 44 | 45 | ' Convert RVA to VA: 46 | dim expVA as long 47 | expVA = ImageRvaToVa(img.FileHeader, img.MappedAddress, expRVA, 0&) 48 | 49 | RtlMoveMemory byVal varPtr(expTable), byVal expVA, lenB(expTable) 50 | 51 | dim nofExports as long 52 | nofExports = expTable.NumberOfNames 53 | 54 | dim ptrToArrayOfExportedFuncNames as long 55 | dim ptrToArrayOfExportedFuncAddresses as long 56 | 57 | ptrToArrayOfExportedFuncNames = ImageRvaToVa(img.FileHeader, img.MappedAddress, expTable.AddressOfNames , 0&) 58 | ptrToArrayOfExportedFuncAddresses = ImageRvaToVa(img.FileHeader, img.MappedAddress, expTable.AddressOfFunctions, 0&) 59 | 60 | dim i as long 61 | for i = 0 to nofExports - 1 62 | 63 | dim RVAfuncName as long 64 | dim RVAfuncAddress as long 65 | 66 | MoveMemoryLong RVAfuncName , ptrToArrayOfExportedFuncNames , 4 67 | MoveMemoryLong RVAfuncAddress, ptrToArrayOfExportedFuncAddresses, 4 68 | 69 | dim VAfuncName as long 70 | dim VAfuncAddress as long 71 | 72 | VAfuncName = ImageRvaToVa(img.FileHeader, img.MappedAddress, RVAfuncName , 0&) 73 | VAfuncAddress = ImageRvaToVa(img.FileHeader, img.MappedAddress, RVAfuncAddress, 0&) 74 | 75 | print# fOut, VAfuncAddress & ": " & LPSTRtoBSTR(VAfuncName) 76 | 77 | ptrToArrayOfExportedFuncNames = ptrToArrayOfExportedFuncNames + 4 78 | ptrToArrayOfExportedFuncAddresses = ptrToArrayOfExportedFuncAddresses + 4 79 | next i 80 | 81 | call UnMapAndLoad(img) 82 | 83 | close# fOut 84 | exit sub 85 | 86 | err_: 87 | call UnMapAndLoad(img) 88 | debug.print "Error occured: " & err.description 89 | end sub ' listExportedFuncs } 90 | 91 | private function LPSTRtoBSTR(byVal lpString as long) as string ' { 92 | dim lenS as long 93 | dim ptrToZero as long 94 | 95 | lenS = lstrlen(lpString) 96 | 97 | LPSTRtoBSTR = string$(lenS, 0) 98 | RtlMoveMemory byVal StrPtr(LPSTRtoBSTR), byVal lpString, lenS 99 | 100 | LPSTRtoBSTR = StrConv(LPSTRtoBSTR, vbUnicode) 101 | 102 | ptrToZero = inStr(1, LPSTRtoBSTR, chr(0), 0) 103 | 104 | if ptrToZero > 0 then 105 | LPSTRtoBSTR = Left$(LPSTRtoBSTR, ptrToZero - 1) 106 | end if 107 | 108 | end function ' } 109 | -------------------------------------------------------------------------------- /wsock32.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' https://github.com/michaelneu/webxcel was very helpful 3 | ' 4 | option explicit 5 | 6 | public const AF_INET = 2 7 | public const FD_SETSIZE = 64 8 | public const INADDR_ANY = 0 9 | public const SOCK_STREAM = 1 10 | public const SOL_SOCKET = 65535 11 | Public Const SO_RCVTIMEO = &H1006 12 | public const WSADESCRIPTION_LEN = 256 13 | public const WSASYS_STATUS_LEN = 128 14 | public const WSADESCRIPTION_LEN_ARRAY = WSADESCRIPTION_LEN + 1 15 | public const WSASYS_STATUS_LEN_ARRAY = WSASYS_STATUS_LEN + 1 16 | 17 | type WSADATA ' { 18 | wVersion as integer 19 | wHighVersion as integer 20 | szDescription as string * WSADESCRIPTION_LEN_ARRAY 21 | szSystemStatus as string * WSASYS_STATUS_LEN_ARRAY 22 | iMaxSockets as integer 23 | iMaxUdpDg as integer 24 | lpVendorInfo as string 25 | end type ' } 26 | 27 | type IN_ADDR ' { 28 | s_addr as long 29 | end type ' } 30 | 31 | type fd_set ' { 32 | fd_count as integer 33 | fd_array(FD_SETSIZE) as long 34 | end type ' } 35 | 36 | type timeval ' { 37 | tv_sec as long 38 | tv_usec as long 39 | end type ' } 40 | 41 | type sockaddr ' { 42 | sa_family as integer 43 | sa_data as string * 14 44 | end type ' } 45 | 46 | type sockaddr_in ' { 47 | sin_family as integer 48 | sin_port as integer 49 | sin_addr as IN_ADDR 50 | sin_zero as string * 8 51 | end type ' } 52 | 53 | ' { 54 | declare Function WSAStartup lib "wsock32.dll" (byVal versionRequired as long, wsa as WSADATA) as long 55 | declare Function WSAGetLastError lib "wsock32.dll" () as long 56 | declare Function WSACleanup lib "wsock32.dll" () as long 57 | declare Function socket lib "wsock32.dll" (byVal addressFamily as long, byVal socketType as long, byVal protocol as long) as long 58 | declare Function htons lib "wsock32.dll" (byVal hostshort as long) as integer 59 | declare Function bind lib "wsock32.dll" (byVal socket as long, name as sockaddr_in, byVal nameLength as integer) as long 60 | declare Function listen lib "wsock32.dll" (byVal socket as long, byVal backlog as integer) as long 61 | declare Function select_ lib "wsock32.dll" alias "select" (byVal nfds as integer, readfds as fd_set, writefds as fd_set, exceptfds as fd_set, timeout as timeval) as integer 62 | declare Function accept lib "wsock32.dll" (byVal socket as long, clientAddress as sockaddr, clientAddressLength as integer) as long 63 | declare Function setsockopt lib "wsock32.dll" (byVal socket as long, byVal level as long, byVal optname as long, ByRef optval as long, byVal optlen as integer) as long 64 | declare Function send lib "wsock32.dll" (byVal socket as long, buffer as string, byVal bufferLength as long, byVal flags as long) as long 65 | declare Function recv lib "wsock32.dll" (byVal socket as long, byVal buffer as string, byVal bufferLength as long, byVal flags as long) as long 66 | declare Function closesocket lib "wsock32.dll" (byVal s as long) as long 67 | ' } 68 | 69 | public sub FD_ZERO(byRef s as fd_set) ' { 70 | s.fd_count = 0 71 | end sub ' } 72 | 73 | sub FD_SET_(byVal fd as long, byRef s as fd_set) ' { 74 | dim i as integer 75 | i = 0 76 | 77 | do while i < s.fd_count 78 | if s.fd_array(i) = fd Then 79 | exit do 80 | end if 81 | 82 | i = i + 1 83 | loop 84 | 85 | if i = s.fd_count then 86 | if s.fd_count < FD_SETSIZE then 87 | s.fd_array(i) = fd 88 | s.fd_count = s.fd_count + 1 89 | end if 90 | end if 91 | 92 | end sub ' } 93 | -------------------------------------------------------------------------------- /examples/winsock/webserver.bas: -------------------------------------------------------------------------------- 1 | ' 2 | ' https://github.com/michaelneu/webxcel was very helpful 3 | ' 4 | option explicit 5 | 6 | sub main() ' { 7 | 8 | if not initWinsock then 9 | msgBox "Could not initialize Winsock" 10 | end if 11 | 12 | debug.print "winsock initialized" 13 | 14 | dim serverSocket as long 15 | serverSocket = createServerSocket(8888) 16 | 17 | acceptConnections serverSocket 18 | 19 | closeSocket serverSocket 20 | WSACleanup 21 | 22 | end sub ' } 23 | 24 | function createServerSocket(byVal port as long) ' { 25 | 26 | createServerSocket = socket(AF_INET, SOCK_STREAM, 0) 27 | 28 | dim endPoint as sockaddr_in 29 | endPoint.sin_family = AF_INET 30 | endPoint.sin_addr.s_addr = INADDR_ANY 31 | endpoint.sin_port = htons(port) 32 | 33 | ' debug.print "lenB: " & lenB(endPoint) 34 | 35 | dim rc as long 36 | rc = bind(createServerSocket, endpoint, 16) 37 | if rc <> 0 then 38 | msgBox "Could not bind, error = " & WSAGetLastError() 39 | exit function 40 | end if 41 | 42 | rc = listen(createServerSocket, 10) ' 10 = backlog 43 | if rc <> 0 then 44 | msgBox "Could not listen" 45 | end if 46 | 47 | end function ' } 48 | 49 | sub acceptConnections(serverSocket as long) ' { 50 | 51 | dim clientSocket as long 52 | 53 | dim i as long 54 | i = 0 55 | 56 | do while i < 200 57 | i = i + 1 58 | sleep 100 59 | debug.print "i = " & i 60 | 61 | clientSocket = getClientSocket(serverSocket) 62 | 63 | if clientSocket = 0 then 64 | goto SKIP_THIS_ITERATION 65 | end if 66 | 67 | dim reqText as string 68 | reqText = getStringFromSocket(clientSocket) 69 | 70 | dim textResponse as string 71 | textResponse = "HTTP/1.1 200 OK" & chr(10) 72 | textResponse = textResponse & "Content-Type: text/html" & chr(10) 73 | textResponse = textResponse & chr(10) 74 | textResponse = textResponse & "" & chr(10) 75 | textResponse = textResponse & "Request was:
"
 76 |        textResponse = textResponse & reqText
 77 |        textResponse = textResponse & "
" 78 | 79 | send clientSocket, byVal textResponse, len(textResponse), 0 80 | 81 | closeSocket clientSocket 82 | 83 | SKIP_THIS_ITERATION: 84 | loop 85 | 86 | end sub ' } 87 | 88 | function getClientSocket(serverSocket as long) as long ' { 89 | dim fdSet as fd_set 90 | dim emptyFdSet as fd_set 91 | dim rc as integer 92 | 93 | FD_ZERO fdSet 94 | FD_SET_ serverSocket, fdSet 95 | 96 | dim timeOutMs as long 97 | timeOutMs = 500 98 | 99 | dim timeOut as timeval 100 | timeOut.tv_sec = timeOutMs / 1000 101 | timeOut.tv_usec = timeOutMs Mod 1000 102 | 103 | rc = select_(serverSocket, fdSet, emptyFdSet, emptyFdSet, timeOut) 104 | if rc = 0 then 105 | getClientSocket = 0 106 | exit function 107 | end if 108 | 109 | dim socketAddress as sockaddr 110 | getClientSocket = accept(serverSocket, socketAddress, 16) 111 | 112 | if getClientSocket = -1 then 113 | getClientSocket = 0 114 | exit function 115 | end if 116 | 117 | rc = setsockopt(getClientSocket, SOL_SOCKET, SO_RCVTIMEO, timeOutMs, 4) 118 | 119 | end function ' } 120 | 121 | function getStringFromSocket(s as long) ' { 122 | dim message as string 123 | dim buffer as string * 1024 124 | dim readBytes as long 125 | 126 | message = "" 127 | 128 | do 129 | buffer = "" 130 | readBytes = recv(s, buffer, len(buffer), 0) 131 | 132 | if readBytes > 0 Then 133 | message = message & Trim(buffer) 134 | end if 135 | loop while readBytes > 0 136 | 137 | getStringFromSocket = trim(message) 138 | 139 | end function ' } 140 | 141 | function initWinsock() as boolean ' { 142 | 143 | dim wsaVersion as long 144 | wsaVersion = 257 145 | 146 | 147 | dim rc as long 148 | dim wsa as WSADATA 149 | 150 | rc = WSAStartup(wsaVersion, wsa) 151 | 152 | if rc <> 0 then 153 | initWinsock = false 154 | exit function 155 | end if 156 | 157 | initWinsock = true 158 | 159 | end function ' } 160 | -------------------------------------------------------------------------------- /examples/CreateWindowEx/listbox.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | dim hWndListBox as longPtr 4 | 5 | function getAddressOfCallback(addr as long) as long 6 | getAddressOfCallback=addr 7 | end function 8 | 9 | 10 | function main() 11 | 12 | dim hWnd as longPtr 13 | dim regClass as integer 14 | dim tq84Class as WNDCLASSEX 15 | dim msg_ as MSG 16 | 17 | tq84Class.cbSize = lenB(tq84Class) 18 | tq84Class.style = CS_HREDRAW or CS_VREDRAW 19 | tq84Class.lpfnwndproc = getAddressOfCallback(AddressOf WindowProc) 20 | tq84Class.cbClsextra = 0 21 | tq84Class.cbWndExtra = 0 22 | tq84Class.hInstance = 0 23 | tq84Class.hIcon = LoadIcon (0, IDI_APPLICATION) 24 | tq84Class.hIconSm = LoadIcon (0, IDI_APPLICATION) 25 | tq84Class.hCursor = LoadCursor (0, IDC_ARROW ) 26 | tq84Class.hbrBackground = GetStockObject( WHITE_BRUSH ) 27 | tq84Class.lpszMenuName = 0 28 | tq84Class.lpszClassName ="TQ84CLASS" 29 | 30 | regClass= RegisterClassEx(tq84Class) 31 | 32 | debug.print "creating main window" 33 | hWnd = CreateWindowEx( _ 34 | 0 , _ 35 | "TQ84CLASS" , _ 36 | "Title of window" , _ 37 | WS_OVERLAPPEDWINDOW , _ 38 | CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _ 39 | 0, 0, 0, 0) 40 | 41 | debug.print "main window created, hWnd = " & hWnd 42 | 43 | if hWnd = 0 then 44 | msgBox "Failed to create window" 45 | exit function 46 | end if 47 | 48 | ShowWindow hWnd, SW_SHOWNORMAL 49 | debug.print "main window is shown, hWndListBox = " & hWndListBox 50 | 51 | ' 52 | ' Filling some items into the list box with SendMessage. 53 | ' Note the »byVal« for the strings. 54 | ' 55 | SendMessage hWndListBox, LB_ADDSTRING, 0, byVal "Foo" 56 | SendMessage hWndListBox, LB_ADDSTRING, 0, byVal "Bar" 57 | SendMessage hWndListBox, LB_ADDSTRING, 0, byVal "Baz" 58 | dim i as long 59 | for i = 1 to 50 60 | SendMessage hWndListBox, LB_ADDSTRING, 0, byVal "i = " & i 61 | next i 62 | 63 | 64 | ' UpdateWindow hWnd 65 | ' SetFocus hWnd 66 | 67 | do while 0 <> GetMessage(msg_, 0, 0, 0) 68 | TranslateMessage msg_ 69 | DispatchMessage msg_ 70 | loop 71 | 72 | end function 73 | 74 | function WindowProc( _ 75 | byVal hWnd as longPtr, _ 76 | byVal msg_ as long , _ 77 | byVal wParam as long , _ 78 | byVal lParam as long) as longPtr 79 | 80 | dim ps as PAINTSTRUCT 81 | dim clientRect as RECT 82 | dim hdc as longPtr 83 | 84 | dim text as string 85 | 86 | select case msg_ 87 | 88 | case WM_CREATE 89 | 90 | debug.print "Creating listbox, hWnd = " & hWnd 91 | 92 | hWndListBox = CreateWindowEx( _ 93 | 0 , _ 94 | "listbox" , _ 95 | 0 , _ 96 | LBS_HASSTRINGS or WS_CHILD or WS_VISIBLE or WS_VSCROLL, _ 97 | 0, 0, 0, 0 , _ 98 | hWnd , _ 99 | 0, 0, 0 ) 100 | 101 | 102 | if hWndListBox = 0 then 103 | msgBox "Could not create listbox, error = " & GetLastError() 104 | WindowProc = -1 105 | else 106 | WindowProc = 0 107 | end if 108 | exit function 109 | 110 | case WM_SIZE 111 | 112 | if hWndListBox <> 0 then 113 | MoveWindow hWndListBox, 0, 0, LOWORD(lParam), HIWORD(lParam), true 114 | end if 115 | 116 | case WM_DESTROY 117 | 118 | PostQuitMessage 0 119 | exit function 120 | 121 | end select 122 | 123 | WindowProc = DefWindowProc(hwnd, msg_, wParam, lParam) 124 | 125 | end function 126 | -------------------------------------------------------------------------------- /examples/CreateWindowEx/helloWorld.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | ' global th as long 4 | 5 | function getAddressOfCallback(addr as long) as long 6 | ' 7 | ' https://renenyffenegger.ch/notes/development/languages/VBA/language/operators/addressOf 8 | ' 9 | getAddressOfCallback=addr 10 | end function 11 | 12 | sub main ' { 13 | 14 | dim tid as long 15 | dim th as long 16 | 17 | ' if th <> 0 then 18 | ' debug.print "Thread already created" 19 | ' exit sub 20 | ' end if 21 | 22 | if true then 23 | call createWin(0) 24 | else 25 | ' 26 | ' Experimental: trying to create the window in its 27 | ' own thread. Does not really work... 28 | ' 29 | debug.print "Trying to create a thread" 30 | th = CreateThread ( _ 31 | 0 , _ 32 | 0 , _ 33 | addressOf createWin , _ 34 | 0 , _ 35 | 0 , _ 36 | tid) 37 | 38 | if th = 0 then 39 | msgBox "failed to create thread, error code: " & GetLastError() 40 | exit sub 41 | end if 42 | 43 | debug.print "Thread is created, thread id = " & tid 44 | end if 45 | 46 | end sub ' } 47 | 48 | ' sub closeThread() ' { 49 | ' 50 | ' ' if th <> 0 then 51 | ' ' debug.print "Closing handle of thread" 52 | ' ' CloseHandle(th) 53 | ' ' th = 0 54 | ' ' else 55 | ' ' debug.print "th = 0" 56 | ' ' end if 57 | ' 58 | ' end sub ' } 59 | 60 | function createWin(lpParam as long) as long ' { 61 | 62 | dim hWnd as longPtr 63 | dim regClass as integer 64 | dim tq84Class as WNDCLASSEX 65 | dim msg_ as MSG 66 | 67 | tq84Class.cbSize = lenB(tq84Class) 68 | tq84Class.style = CS_HREDRAW or CS_VREDRAW 69 | tq84Class.lpfnwndproc = getAddressOfCallback(addressOf WindowProc) 70 | tq84Class.cbClsextra = 0 71 | tq84Class.cbWndExtra = 0 72 | tq84Class.hInstance = 0 73 | tq84Class.hIcon = LoadIcon (0, IDI_APPLICATION) 74 | tq84Class.hIconSm = LoadIcon (0, IDI_APPLICATION) 75 | tq84Class.hCursor = LoadCursor (0, IDC_ARROW ) 76 | tq84Class.hbrBackground = GetStockObject( WHITE_BRUSH ) 77 | tq84Class.lpszMenuName = 0 78 | tq84Class.lpszClassName ="TQ84CLASS" 79 | 80 | regClass= RegisterClassEx(tq84Class) 81 | 82 | hWnd = CreateWindowEx( _ 83 | WS_EX_DLGMODALFRAME , _ 84 | "TQ84CLASS" , _ 85 | "Title of window" , _ 86 | WS_POPUPWINDOW or WS_CAPTION, _ 87 | 100, 100, 500, 200, _ 88 | 0, 0, 0, 0) 89 | 90 | if hWnd = 0 then 91 | msgBox "Failed to create window" 92 | exit function 93 | end if 94 | 95 | ShowWindow hWnd, SW_SHOWNORMAL 96 | UpdateWindow hWnd 97 | SetFocus hWnd 98 | 99 | ' 100 | ' Enter message loop until WM_QUIT is encountered: 101 | ' 102 | do while 0 <> GetMessage(msg_, 0, 0, 0) 103 | TranslateMessage msg_ 104 | DispatchMessage msg_ 105 | loop 106 | 107 | createWin = msg_.wParam 108 | 109 | end function ' } 110 | 111 | ' { WindowProc 112 | function WindowProc( _ 113 | byVal lhwnd as longPtr, _ 114 | byVal msg_ as long , _ 115 | byVal wParam as long , _ 116 | byVal lParam as long) as longPtr 117 | 118 | dim ps as PAINTSTRUCT 119 | dim clientRect as RECT 120 | dim hdc as longPtr 121 | 122 | dim text as string 123 | 124 | select case msg_ 125 | 126 | case WM_PAINT 127 | 128 | hdc = BeginPaint(lhwnd, ps) 129 | call GetClientRect(lhwnd, clientRect) 130 | text = "Hello world" 131 | 132 | call DrawText( _ 133 | hdc, _ 134 | text, _ 135 | len(text), _ 136 | clientRect, _ 137 | DT_SINGLELINE or DT_CENTER or DT_VCENTER) 138 | 139 | call EndPaint(lhwnd, ps) 140 | 141 | exit function 142 | 143 | case WM_DESTROY 144 | 145 | PostQuitMessage 0 146 | exit function 147 | 148 | end select 149 | 150 | WindowProc = DefWindowProc(lhwnd, msg_, wParam, lParam) 151 | 152 | end function ' } 153 | -------------------------------------------------------------------------------- /examples/SetWinEventHook/EVENT_OBJECT_CREATE.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | dim hh as long 4 | 5 | function getAddressOfCallback(addr as long) as long 6 | ' 7 | ' https://renenyffenegger.ch/notes/development/languages/VBA/language/operators/addressOf 8 | ' 9 | getAddressOfCallback=addr 10 | end function 11 | 12 | sub main ' { 13 | 14 | dim hWnd as longPtr 15 | dim regClass as integer 16 | dim tq84Class as WNDCLASSEX 17 | dim msg_ as MSG 18 | 19 | tq84Class.cbSize = lenB(tq84Class) 20 | tq84Class.style = CS_HREDRAW or CS_VREDRAW 21 | tq84Class.lpfnwndproc = getAddressOfCallback(addressOf WindowProc) 22 | tq84Class.cbClsextra = 0 23 | tq84Class.cbWndExtra = 0 24 | tq84Class.hInstance = application.hInstance 25 | tq84Class.hIcon = LoadIcon (0, IDI_APPLICATION) 26 | tq84Class.hIconSm = LoadIcon (0, IDI_APPLICATION) 27 | tq84Class.hCursor = LoadCursor (0, IDC_ARROW ) 28 | tq84Class.hbrBackground = GetStockObject( WHITE_BRUSH ) 29 | tq84Class.lpszMenuName = 0 30 | tq84Class.lpszClassName ="TQ84CLASS" 31 | 32 | regClass= RegisterClassEx(tq84Class) 33 | 34 | hWnd = CreateWindowEx( _ 35 | WS_EX_DLGMODALFRAME , _ 36 | "TQ84CLASS" , _ 37 | "Title of window" , _ 38 | WS_POPUPWINDOW or WS_CAPTION, _ 39 | 100, 100, 500, 200, _ 40 | 0, 0, _ 41 | application.hInstance , _ 42 | 0) 43 | 44 | if hWnd = 0 then 45 | msgBox "Failed to create window" 46 | exit sub 47 | end if 48 | 49 | ShowWindow hWnd, SW_SHOWNORMAL 50 | 51 | ' 52 | ' Enter message loop until WM_QUIT is encountered: 53 | ' 54 | do while 0 <> GetMessage(msg_, 0, 0, 0) 55 | TranslateMessage msg_ 56 | DispatchMessage msg_ 57 | loop 58 | 59 | end sub ' } 60 | 61 | ' { WindowProc 62 | function WindowProc( _ 63 | byVal lhwnd as longPtr, _ 64 | byVal msg_ as long , _ 65 | byVal wParam as long , _ 66 | byVal lParam as long) as longPtr 67 | 68 | dim ps as PAINTSTRUCT 69 | dim clientRect as RECT 70 | dim hdc as longPtr 71 | 72 | dim text as string 73 | 74 | select case msg_ 75 | 76 | case WM_CREATE 77 | 78 | hh = SetWinEventHook( _ 79 | EVENT_OBJECT_CREATE , _ 80 | EVENT_OBJECT_CREATE , _ 81 | 0 , _ 82 | addressOf WinEventProc , _ 83 | 0& , _ 84 | 0& , _ 85 | WINEVENT_OUTOFCONTEXT or WINEVENT_SKIPOWNPROCESS) 86 | 87 | debug.print "hh = " & hh ", last error = " & GetLastError() 88 | 89 | case WM_PAINT 90 | 91 | hdc = BeginPaint(lhwnd, ps) 92 | call GetClientRect(lhwnd, clientRect) 93 | text = "SetWinEventHook" 94 | 95 | call DrawText( _ 96 | hdc, _ 97 | text, _ 98 | len(text), _ 99 | clientRect, _ 100 | DT_SINGLELINE or DT_CENTER or DT_VCENTER) 101 | 102 | call EndPaint(lhwnd, ps) 103 | 104 | exit function 105 | 106 | case WM_DESTROY 107 | 108 | PostQuitMessage 0 109 | exit function 110 | 111 | end select 112 | 113 | WindowProc = DefWindowProc(lhwnd, msg_, wParam, lParam) 114 | 115 | end function ' } 116 | 117 | ' { WinEventProc 118 | function WinEventProc( _ 119 | byVal hookHandle as long, _ 120 | byVal lEvent as long, _ 121 | byVal hWnd as long, _ 122 | byVal idObject as long, _ 123 | byVal idChild as long, _ 124 | byVal idEventThread as long, _ 125 | byVal dwmsEventTime as long _ 126 | ) as long 127 | 128 | 129 | if lEvent = EVENT_OBJECT_CREATE then 130 | debug.print "An object was created" 131 | elseif lEvent = EVENT_OBJECT_DESTROY then 132 | debug.print "An object was destroyed" 133 | elseif lEvent = EVENT_SYSTEM_FOREGROUND then 134 | debug.print "EVENT_SYSTEM_FOREGROUND" 135 | elseif lEvent = EVENT_OBJECT_SHOW then 136 | debug.print "EVENT_OBJECT_SHOW" 137 | else 138 | debug.print "Unexpected event" 139 | end if 140 | 141 | end function ' } 142 | -------------------------------------------------------------------------------- /ConvenienceWrapper.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | global g_hWnd as long 4 | global captionPart_ as string 5 | global className_ as string 6 | global windowText_ as string 7 | 8 | sub clipboardPutText(txt as string) ' { 9 | dim memory as long 10 | dim lockedMemory as long 11 | 12 | memory = GlobalAlloc(GHND, len(txt) + 1) 13 | if memory = 0 then 14 | msgBox "GlobalAlloc failed" 15 | exit sub 16 | end if 17 | 18 | lockedMemory = GlobalLock(memory) 19 | if lockedMemory = 0 then 20 | msgBox "GlobalLock failed" 21 | exit sub 22 | end if 23 | 24 | lockedMemory = lstrcpy(lockedMemory, txt) 25 | 26 | call GlobalUnlock(memory) 27 | 28 | if openClipboard(0) = 0 Then 29 | msgBox "openClipboard failed" 30 | exit sub 31 | end if 32 | 33 | call EmptyClipboard() 34 | 35 | call SetClipboardData(CF_TEXT, memory) 36 | 37 | if CloseClipboard() = 0 then 38 | msgBox "CloseClipboard failed" 39 | end if 40 | end sub ' } 41 | 42 | function GetWindowText_(hWnd as long) as string ' { 43 | dim retVal as long 44 | 45 | GetwindowText_ = space(GetWindowTextLength(hWnd) + 1) 46 | retVal = GetWindowText(hWnd, GetWindowText_, len(GetwindowText_)) 47 | GetWindowText_ = left$(GetwindowText_, retVal) 48 | 49 | end function ' } 50 | 51 | function GetClassName_(hWnd as long) as string ' { 52 | dim windowClass as string * 256 53 | dim retVal as long 54 | 55 | retVal = GetClassName(hWnd, windowClass, 255) 56 | GetClassName_ = left(windowClass, retVal) 57 | 58 | end function ' } 59 | 60 | function GetComputerName_() as string ' { 61 | dim NetBiosName as string * 32 62 | dim rc as long 63 | dim length as long 64 | 65 | length = 32 66 | rc = GetComputerName(NetBiosName, length) 67 | 68 | if rc <> 0 then 69 | GetComputerName_ = left$(NetBiosName, length) 70 | exit function 71 | end if 72 | 73 | GetComputerName_ = "?" 74 | 75 | end function ' } 76 | 77 | function GetEnvironmentVariable_(name as string) as string ' { 78 | dim envVar as string * 4096 ' Yes... I had a case where a length of 3696 was needed! 79 | dim length as long 80 | length = GetEnvironmentVariable(name, envVar, 4096) 81 | GetEnvironmentVariable_ = left$(envVar, length) 82 | end function ' } 83 | 84 | function GetLastErrorText() as string ' { 85 | dim errNo as long 86 | dim rc as long 87 | dim langId as long 88 | 89 | errNo = GetLastError() 90 | GetLastErrorText = string$(FORMAT_MESSAGE_TEXT_LEN, chr(0)) 91 | 92 | langId = 0 93 | 94 | rc = FormatMessage ( _ 95 | FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _ 96 | 0 , _ 97 | errNo , _ 98 | langId , _ 99 | GetLastErrorText , _ 100 | FORMAT_MESSAGE_TEXT_LEN , _ 101 | 0) 102 | 103 | if rc = 0 then 104 | GetLastErrorText = errNo 105 | end if 106 | end function ' } 107 | 108 | function FindWindow_WindowNameContains(captionPart as string) as long ' { 109 | captionPart_ = captionPart 110 | call EnumWindows(addressOf FindWindow_WindowNameContains_cb, byVal 0&) 111 | FindWindow_WindowNameContains = g_hWnd 112 | end function ' } 113 | 114 | function FindWindow_WindowNameContains_cb(byVal hWnd as long, byVal lParam as long) as long ' { 115 | 116 | dim windowText as string 117 | dim windowClass as string * 256 118 | dim retVal as long 119 | 120 | windowText = space(GetWindowTextLength(hWnd) + 1) 121 | retVal = GetWindowText(hWnd, windowText, len(windowText)) 122 | windowText = left$(windowText, retVal) 123 | 124 | if inStr(1, windowText, captionPart_, vbTextCompare) then 125 | 126 | g_hWnd = hWnd 127 | 128 | ' 129 | ' We have found a Window, the iteration 130 | ' process can be stopped 131 | ' 132 | FindWindow_WindowNameContains_cb = false 133 | exit function 134 | 135 | end if 136 | 137 | FindWindow_WindowNameContains_cb = true 138 | 139 | end function ' } 140 | 141 | function FindWindow_ClassName(className as string) as long ' { 142 | captionPart_ = className 143 | g_hWnd = 0 144 | call EnumWindows(addressOf FindWindow_ClassName_cb, byVal 0&) 145 | FindWindow_ClassName = g_hWnd 146 | end function ' } 147 | 148 | function FindWindow_ClassName_cb(byVal hWnd as long, byVal lParam as long) as long ' { 149 | 150 | dim windowText as string 151 | dim windowClass as string * 256 152 | dim retVal as long 153 | 154 | if GetClassName_(hWnd) = captionPart_ then 155 | 156 | g_hWnd = hWnd 157 | FindWindow_ClassName_cb = false 158 | exit function 159 | 160 | end if 161 | 162 | FindWindow_ClassName_cb = true 163 | 164 | end function ' } 165 | 166 | function FindWindow_ClassName_WindowText(className as string, windowText as string) as long ' { 167 | className_ = className 168 | windowText_ = windowText 169 | g_hWnd = 0 170 | call EnumWindows(addressOf FindWindow_ClassName_WindowText_cb, byVal 0&) 171 | FindWindow_ClassName_WindowText = g_hWnd 172 | end function ' } 173 | 174 | function FindWindow_ClassName_WindowText_cb(byVal hWnd as long, byVal lParam as long) as long ' { 175 | 176 | if GetClassName_(hWnd) = className_ and GetWindowText_(hWnd) = windowText_ then 177 | 178 | g_hWnd = hWnd 179 | FindWindow_ClassName_WindowText_cb = false 180 | exit function 181 | 182 | end if 183 | 184 | FindWindow_ClassName_WindowText_cb = true 185 | 186 | end function ' } 187 | 188 | function GetWindowRect_(hWnd as long) as RECT ' { 189 | dim r as RECT 190 | GetWindowRect hWnd, r 191 | GetWindowRect_ = r 192 | end function ' } 193 | 194 | sub shellOpen(path as string, optional parameters as string = vbNullString, optional directory as string = vbNullString) ' { 195 | ShellExecute 0, "Open", path, parameters, directory, 1 196 | end sub ' } 197 | 198 | sub SendInputText(text as string) ' { 199 | dim i as long 200 | dim c as string 201 | ' dim input_ as INPUT_ 202 | dim input_(1) as INPUT_ 203 | dim sizeINPUT as long 204 | 205 | dim shift as boolean 206 | dim keyScan as integer 207 | dim vkKey as integer 208 | 209 | dim isEscaped as boolean 210 | 211 | dim keyboardLayout as long 212 | 213 | sizeINPUT = lenB(input_(0)) 214 | 215 | ' keyboardLayout = GetKeyboardLayout(0) 216 | keyboardLayout = GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow(), 0)) 217 | 218 | input_(0).dwType = INPUT_KEYBOARD 219 | 220 | isEscaped = false 221 | for i = 0 to len(text) - 1 ' { 222 | c = mid(text, i+1, 1) 223 | 224 | if isEscaped then ' { 225 | 226 | if c = "n" then ' { 227 | vkKey = VK_RETURN 228 | isEscaped = false 229 | shift = false 230 | else 231 | debug.print "Unhandled escaped character " & c 232 | goto skip_iteration 233 | end if 234 | else 235 | 236 | if c = "\" then ' { 237 | isEscaped = true 238 | goto skip_iteration 239 | end if ' } 240 | 241 | keyScan = VkKeyScanEx(asc(c), keyboardLayout) 242 | shift = keyScan and &h100 243 | vkKey = keyScan and &h0ff 244 | 245 | end if 246 | 247 | input_(0).dwFlags = 0 248 | 249 | if shift then ' if c >= "A" and c<= "Z" then ' { 250 | input_(0).wVK = VK_LSHIFT 251 | SendInput 1, input_(0), sizeINPUT 252 | end if ' } 253 | 254 | input_(0).wVK = vkKey ' input_(0).wVK = VkKeyScan(asc(lcase(c))) 255 | SendInput 1, input_(0), sizeINPUT 256 | 257 | input_(0).dwFlags = KEYEVENTF_KEYUP 258 | SendInput 1, input_(0), sizeINPUT 259 | 260 | if shift then ' if c >= "A" and c<= "Z" then ' { 261 | input_(0).wVK = VK_LSHIFT 262 | SendInput 1, input_(0), sizeINPUT 263 | end if ' } 264 | 265 | skip_iteration: 266 | next i ' } 267 | 268 | end sub ' } 269 | 270 | ' sub SendInputTextOld(text as string) ' { 271 | ' dim i as long 272 | ' dim c as string 273 | ' ' dim input_ as INPUT_ 274 | ' dim input_(1) as INPUT_ 275 | ' dim sizeINPUT as long 276 | ' 277 | ' sizeINPUT = lenB(input_(0)) 278 | ' 279 | ' input_(0).dwType = INPUT_KEYBOARD 280 | ' 281 | ' for i = 0 to len(text) - 1 ' { 282 | ' c = mid(text, i+1, 1) 283 | ' 284 | ' input_(0).dwFlags = 0 285 | ' 286 | ' if c >= "A" and c<= "Z" then ' { 287 | ' input_(0).wVK = VK_LSHIFT 288 | ' SendInput 1, input_(0), sizeINPUT 289 | ' end if ' } 290 | ' 291 | ' 292 | ' input_(0).wVK = VkKeyScan(asc(lcase(c))) 293 | ' SendInput 1, input_(0), sizeINPUT 294 | ' 295 | ' input_(0).dwFlags = KEYEVENTF_KEYUP 296 | ' SendInput 1, input_(0), sizeINPUT 297 | ' 298 | ' if c >= "A" and c<= "Z" then ' { 299 | ' input_(0).wVK = VK_LSHIFT 300 | ' SendInput 1, input_(0), sizeINPUT 301 | ' end if ' } 302 | ' 303 | ' next i ' } 304 | ' 305 | ' end sub ' } 306 | -------------------------------------------------------------------------------- /WinAPI.bas: -------------------------------------------------------------------------------- 1 | option explicit 2 | 3 | 4 | ' { Types 5 | type INPUT_ ' typedef struct tagINPUT ' { 6 | dwType as long 7 | wVK as integer 8 | wScan as integer ' KEYBDINPUT ki; 9 | dwFlags as long ' HARDWAREINPUT hi; 10 | dwTime as long ' '}; 11 | dwExtraInfo as long ' '} INPUT, *PINPUT; 12 | dwPadding as currency ' 8 extra bytes, because mouses take more. 13 | end type ' } 14 | 15 | 16 | private type IMAGE_DATA_DIRECTORY ' WinNT.h { 17 | RVA as long ' Relative VA 18 | Size as long 19 | end type ' } 20 | 21 | private const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16 22 | 23 | type IMAGE_EXPORT_DIRECTORY_TABLE ' WinNT.h { 24 | Characteristics as long 25 | TimeDateStamp as long 26 | MajorVersion as integer 27 | MinorVersion as integer 28 | Name as long 29 | Base as long 30 | NumberOfFunctions as long 31 | NumberOfNames as long 32 | AddressOfFunctions as long ' Relative virtual address (RVA) from base of image. Points to an array of RVAs of functions/symbols in the module 33 | AddressOfNames as long ' Relative virtual address (RVA) from base of image 34 | AddressOfNameOrdinals as long ' Relative virtual address (RVA) from base of image 35 | end type ' } 36 | 37 | type IMAGE_OPTIONAL_HEADER32 ' WinNT.h { 38 | ' 39 | ' 2019-01-24: Renamed from IMAGE_OPTIONAL_HEADER 40 | ' 41 | ' Standard fields: 42 | Magic as integer 43 | MajorLinkerVersion as byte 44 | MinorLinkerVersion as byte 45 | SizeOfCode as long 46 | SizeOfInitializedData as long 47 | SizeOfUninitializedData as long 48 | AddressOfEntryPoint as long 49 | BaseOfCode as long 50 | BaseOfData as long 51 | 52 | ' NT additional fields: 53 | ImageBase as long 54 | SectionAlignment as long 55 | FileAlignment as long 56 | MajorOperatingSystemVersion as integer 57 | MinorOperatingSystemVersion as integer 58 | MajorImageVersion as integer 59 | MinorImageVersion as integer 60 | MajorSubsystemVersion as integer 61 | MinorSubsystemVersion as integer 62 | Win32VersionValue as long 63 | SizeOfImage as long 64 | SizeOfHeaders as long 65 | CheckSum as long 66 | Subsystem as integer 67 | DllCharacteristics as integer 68 | SizeOfStackReserve as long 69 | SizeOfStackCommit as long 70 | SizeOfHeapReserve as long 71 | SizeOfHeapCommit as long 72 | LoaderFlags as long 73 | NumberOfRvaAndSizes as long 74 | ' Data directories 75 | DataDirectory(0 to IMAGE_NUMBEROF_DIRECTORY_ENTRIES) as IMAGE_DATA_DIRECTORY ' 17*8 + 96 = 232 76 | end type ' } 77 | 78 | type IMAGE_FILE_HEADER ' { WinNT.h / COFF file header 79 | ' 80 | ' 2019-01-24: Renamed from IMAGE_COFF_HEADER 81 | ' 82 | Machine as integer 83 | NumberOfSections as integer 84 | TimeDateStamp as long 85 | PointerToSymbolTable as long 86 | NumberOfSymbols as long 87 | SizeOfOptionalHeader as integer 88 | Characteristics as integer 89 | end type ' } 90 | 91 | type IMAGE_NT_HEADERS32 ' WinNT.h { 92 | ' 93 | ' 2019-01-24: renamed from »IMAGE_PE_FILE_HEADER«. 94 | ' 95 | ' Compare with IMAGE_NT_HEADERS64, also defined in WinNT.h 96 | ' 97 | Signature as long 98 | FileHeader as IMAGE_FILE_HEADER 99 | OptionalHeader as IMAGE_OPTIONAL_HEADER32 ' or IMAGE_OPTIONAL_HEADER64 100 | end type ' } 101 | 102 | type WNDCLASSEX ' { 103 | cbSize as long 104 | style as long ' See CS_* constants 105 | ' lpfnwndproc as longPtr 106 | lpfnwndproc as long 107 | cbClsextra as long 108 | cbWndExtra as long 109 | hInstance as longPtr 110 | hIcon as longPtr 111 | hCursor as longPtr 112 | hbrBackground as longPtr 113 | ' hInstance as long 114 | ' hIcon as long 115 | ' hCursor as long 116 | ' hbrBackground as long 117 | lpszMenuName as string 118 | lpszClassName as string 119 | hIconSm as longPtr 120 | ' hIconSm as long 121 | end type ' } 122 | 123 | public const INPUT_KEYBOARD as long = 1 124 | public const MAPVK_VK_TO_CHAR as long = 2 ' Used in MapVirtualKey 125 | public const MAPVK_VK_TO_VSC as long = 0 ' Used in MapVirtualKey 126 | public const KEYEVENTF_KEYUP as long = 2 ' Used for dwFlags in INPUT_ 127 | 128 | type KBDLLHOOKSTRUCT ' { 129 | vkCode as long ' virtual key code in range 1 .. 254 130 | scanCode as long ' hardware code 131 | flags as long ' bit 4: alt key was pressed 132 | time as long 133 | dwExtraInfo as long 134 | end type ' } 135 | 136 | type POINTAPI ' { 137 | x as long 138 | y as long 139 | end type ' } 140 | 141 | type PROCESS_INFORMATION ' { Used for CreateProcess() 142 | hProcess as longPtr 143 | hThread as longPtr 144 | dwProcessId as long 145 | dwThreadId as long 146 | end type ' } 147 | 148 | type RECT ' { 149 | left as long 150 | top as long 151 | right as long 152 | bottom as long 153 | end type ' } 154 | 155 | type LIST_ENTRY ' { Used by LOADED_IMAGE 156 | FLink as long 157 | Blink as long 158 | end type ' } 159 | 160 | ' 161 | ' LOADED_IMAGE 162 | ' Is defined in both ImageHlp.h and DbgHelp.h 163 | ' 164 | type LOADED_IMAGE ' 48 bytes (46 bytes packed ) ' { Used with MapAndLoad 165 | ModuleName as long 166 | hFile as long 167 | MappedAddress as long ' Base address of mapped file 168 | FileHeader as long ' Pointer to IMAGE_NT_HEADERS32 ' (Compare with IMAGE_NT_HEADERS64) -- Note: the pointed to IMAGE_NT_HEADERS32 also has a member named FileHeader. 169 | LastRvaSection as long ' Pointer to first COFF section header (section table)? 2019-01-24: Renamed from pLstRvaSection 170 | NumberOfSections as long 171 | Sections as long ' Pointer to IMAGE_SECTION_HEADER (First COFF section header (section table)??) 172 | Characteristics as long ' Image characteristics value 173 | fSystemImage as byte ' bool 174 | fDOSImage as byte ' bool 175 | ' 176 | ' At least in C, the compiler pads the following two (new) members 177 | ' with the previous two bytes into 4 byte so that in C, adding 178 | ' or omitting them should not change anything. 179 | ' 180 | ' fReadOnly as byte ' bool 181 | ' Version as byte ' UCHAR 182 | ' 183 | ' ---------------------------------------------------------- 184 | Links as LIST_ENTRY ' 2 longs 185 | SizeOfImage as long 186 | end type ' } 187 | 188 | public type MODULEINFO ' { 189 | lpBaseOfDll as long 190 | SizeOfImage as long 191 | EntryPoint as long 192 | end type ' } 193 | 194 | type MSG ' { 195 | hWnd as long 196 | message as long 197 | wParam as long 198 | lParam as long 199 | time as long 200 | pt as POINTAPI 201 | end type ' } 202 | 203 | type PAINTSTRUCT ' { 204 | ' hdc as longPtr 205 | hdc as long 206 | fErase as long 207 | rcPaint as RECT 208 | fRestore as long 209 | fIncUpdate as long 210 | rgbReserved(0 to 31) as byte 211 | 'rgbReserved(32) as byte 'this was declared incorrectly in VB API viewer 212 | end type ' } 213 | 214 | type SECURITY_ATTRIBUTES ' { Used for CreateProcess() 215 | nLength as long 216 | lpSecurityDescriptor as longPtr 217 | bInheritHandle as long 218 | end type ' } 219 | 220 | type STARTUPINFO ' { Used for CreateProcess 221 | cb as long 222 | lpReserved as string 223 | lpDesktop as string 224 | lpTitle as string 225 | dwX as long 226 | dwY as long 227 | dwXSize as long 228 | dwYSize as long 229 | dwXCountChars as long 230 | dwYCountChars as long 231 | dwFillAttribute as long 232 | dwFlags as long 233 | wShowWindow as integer 234 | cbReserved2 as integer 235 | lpReserved2 as byte 236 | hStdInput as longPtr 237 | hStdOutput as longPtr 238 | hStdError as longPtr 239 | end type ' } 240 | 241 | ' } 242 | ' { Constants 243 | 244 | ' { C 245 | 246 | ' CS_* - WindowClass styles / see WNDCLASSEX { 247 | public const CS_HREDRAW = &H2 248 | public const CS_VREDRAW = &H1 249 | ' } 250 | 251 | public const CF_TEXT = 1 252 | 253 | ' Process Creation Flags, used for CreateProcess { 254 | 255 | public const CREATE_NEW_CONSOLE = &h00000010 256 | public const CREATE_SUSPENDED = &h00000004 257 | public const DEBUG_ONLY_THIS_PROCESS = &h00000002 258 | 259 | ' } 260 | 261 | ' Used in CreateWindowEx to indicate default position and dimension. 262 | public const CW_USEDEFAULT = &H80000000 263 | 264 | ' } 265 | ' { D 266 | ' { DT constants, used for DrawText 267 | public const DT_CENTER = &h01 268 | public const DT_SINGLELINE = &h20 269 | public const DT_VCENTER = &h04 270 | ' } 271 | ' } 272 | ' { E 273 | ' EVENT_* constants ' { 274 | ' Used for SetWinEventHook 275 | public const EVENT_OBJECT_CREATE = &h8000 276 | public const EVENT_OBJECT_DESTROY = &h8001 277 | public const EVENT_OBJECT_SHOW = &h8002 278 | public const EVENT_SYSTEM_FOREGROUND = &h0003 279 | ' } 280 | ' } 281 | ' { F 282 | public const FORMAT_MESSAGE_FROM_SYSTEM = &h1000 283 | public const FORMAT_MESSAGE_IGNORE_INSERTS = &h0200 284 | public const FORMAT_MESSAGE_TEXT_LEN = &h00a0 285 | ' } 286 | ' { G 287 | public const GHND = &h42 288 | ' } 289 | ' { H 290 | public const HC_ACTION = 0 291 | 292 | ' Used for nCode in CBTProc (SetWindowsHookEx / WH_CBT). 293 | public const HCBT_ACTIVATE = 5 294 | 295 | public const HSHELL_WINDOWCREATED = 1 ' Top-level unowned window has been created. Used in WH_SHELL callback. 296 | 297 | ' { HWND_* contstans 298 | ' These can be used for the parameter hWndInsertAfter in SetWindowPos() 299 | ' 300 | public const HWND_BOTTOM = 1 301 | public const HWND_BROADCAST = &HFFFF& 302 | public const HWND_NOTOPMOST = -2 303 | public const HWND_TOP = 0 304 | public const HWND_TOPMOST = -1 305 | 306 | ' } 307 | ' } 308 | ' { I 309 | ' IDC_ARROW, See -> LoadCursor 310 | public const IDC_ARROW = 32512& 311 | ' IDI_APPLICATION, See -> LoadIcon 312 | public const IDI_APPLICATION = 32512& 313 | 314 | public const IMAGE_DIRECTORY_ENTRY_EXPORT = 0 315 | public const IMAGE_DIRECTORY_ENTRY_IMPORT = 1 316 | 317 | ' } 318 | ' { L 319 | 320 | public const LB_ADDSTRING = &h0180 321 | 322 | ' List box styles 323 | public const LBS_HASSTRINGS = &H40 324 | 325 | public const LOCALE_SNAME = &h0000005c 326 | 327 | ' } 328 | ' { M 329 | public const MAX_PATH as integer = 260 330 | 331 | ' MEM_*: Used for VirtualAlloc or VirtualFree 332 | public const MEM_RESERVE_AND_COMMIT as long = &H3000 333 | public const MEM_RELEASE as long = &H8000 334 | 335 | ' } 336 | ' { P 337 | 338 | ' Use for flProtect in VirtualAlloc: 339 | public const PAGE_EXECUTE_RW as long = &H40 340 | 341 | public const PM_REMOVE as long = &H1 342 | ' } 343 | ' { S 344 | 345 | ' SM_* constants for GetSystemMetrics() { 346 | public const SM_CMONITORS = 80 ' Number of display monitors 347 | public const SM_CXSCREEN = 0 ' Width of primary monitor 348 | public const SM_CYSCREEN = 1 ' Height of primary monitor 349 | public const SM_SLOWMACHINE = 73 ' Non zero if slow (low-end) processor 350 | ' } 351 | 352 | public const SMTO_ABORTIFHUNG = &H2& 353 | 354 | public const SPI_SETNONCLIENTMETRICS = &H2A& 355 | 356 | ' SW_* constants for ShowWindow() { 357 | public const SW_FORCEMINIMIZE = 11 ' Minimizes a window. 358 | public const SW_HIDE = 0 ' Hides the window and activates another window. 359 | public const SW_MAXIMIZE = 3 ' Maximizes a window. 360 | public const SW_MINIMIZE = 6 ' Minimizes the specified window and activates the next top-level window. 361 | public const SW_RESTORE = 9 ' Activates and displays the window. 362 | public const SW_SHOW = 5 ' Activates the window. 363 | public const SW_SHOWMAXIMIZED = 3 ' Activates the window and displays it as a maximized window. 364 | public const SW_SHOWMINIMIZED = 2 ' Activates the window and displays it as a minimized window. 365 | public const SW_SHOWMINNOACTIVE = 7 ' Displays the window as a minimized window (without activating the window). 366 | public const SW_NORMAL = 1 367 | public const SW_SHOWNA = 8 ' Displays the window in its current size and position (without activating the window). 368 | public const SW_SHOWNOACTIVATE = 4 ' Displays a window in its most recent size and position (without activating the window). 369 | public const SW_SHOWNORMAL = 1 ' Activates and displays a window. 370 | ' } 371 | 372 | ' { SWP_* constants for SetWindowPos 373 | public const SWP_NOSIZE as long = &h1 374 | public const SWP_NOMOVE as long = &h2 375 | public const SWP_NOZORDER as long = &h4 376 | public const SWP_NOREDRAW as long = &h8 377 | public const SWP_NOACTIVATE as long = &h10 378 | public const SWP_FRAMECHANGED as long = &h20 379 | public const SWP_SHOWWINDOW as long = &h40 380 | public const SWP_HIDEWINDOW as long = &h80 381 | public const SWP_NOCOPYBITS as long = &h100 382 | public const SWP_NOOWNERZORDER as long = &h200 383 | public const SWP_NOSENDCHANGING as long = &h400 384 | public const SWP_DEFERERASE as long = &h2000 385 | public const SWP_ASYNCWINDOWPOS as long = &h4000 386 | ' } 387 | 388 | ' } 389 | ' { V 390 | public const VK_LBUTTON = &h001 ' { Virtual keys 391 | public const VK_RBUTTON = &h002 392 | public const VK_CANCEL = &h003 ' Implemented as Ctrl-Break on most keyboards 393 | public const VK_MBUTTON = &h004 394 | public const VK_XBUTTON1 = &h005 395 | public const VK_XBUTTON2 = &h006 396 | public const VK_BACK = &h008 397 | public const VK_TAB = &h009 398 | public const VK_CLEAR = &h00c 399 | public const VK_RETURN = &h00d ' Enter 400 | public const VK_SHIFT = &h010 401 | public const VK_CONTROL = &h011 402 | public const VK_MENU = &h012 403 | public const VK_PAUSE = &h013 404 | public const VK_CAPITAL = &h014 405 | public const VK_KANA = &h015 406 | public const VK_HANGUEL = &h015 407 | public const VK_HANGUL = &h015 408 | public const VK_JUNJA = &h017 409 | public const VK_FINAL = &h018 410 | public const VK_HANJA = &h019 411 | public const VK_KANJI = &h019 412 | public const VK_ESCAPE = &h01b 413 | public const VK_CONVERT = &h01c 414 | public const VK_NONCONVERT = &h01d 415 | public const VK_ACCEPT = &h01e 416 | public const VK_MODECHANGE = &h01f 417 | public const VK_SPACE = &h020 418 | public const VK_PRIOR = &h021 419 | public const VK_NEXT = &h022 420 | public const VK_END = &h023 421 | public const VK_HOME = &h024 422 | public const VK_LEFT = &h025 423 | public const VK_UP = &h026 424 | public const VK_RIGHT = &h027 425 | public const VK_DOWN = &h028 426 | public const VK_SELECT = &h029 427 | public const VK_PRINT = &h02a 428 | public const VK_EXECUTE = &h02b 429 | public const VK_SNAPSHOT = &h02c 430 | public const VK_INSERT = &h02d 431 | public const VK_DELETE = &h02e 432 | public const VK_HELP = &h02f 433 | public const VK_LWIN = &h05b 434 | public const VK_RWIN = &h05c 435 | public const VK_APPS = &h05d 436 | public const VK_SLEEP = &h05f 437 | public const VK_NUMPAD0 = &h060 438 | public const VK_NUMPAD1 = &h061 439 | public const VK_NUMPAD2 = &h062 440 | public const VK_NUMPAD3 = &h063 441 | public const VK_NUMPAD4 = &h064 442 | public const VK_NUMPAD5 = &h065 443 | public const VK_NUMPAD6 = &h066 444 | public const VK_NUMPAD7 = &h067 445 | public const VK_NUMPAD8 = &h068 446 | public const VK_NUMPAD9 = &h069 447 | public const VK_MULTIPLY = &h06a 448 | public const VK_ADD = &h06b 449 | public const VK_SEPARATOR = &h06c 450 | public const VK_SUBTRACT = &h06d 451 | public const VK_DECIMAL = &h06e 452 | public const VK_DIVIDE = &h06f 453 | public const VK_F1 = &h070 454 | public const VK_F2 = &h071 455 | public const VK_F3 = &h072 456 | public const VK_F4 = &h073 457 | public const VK_F5 = &h074 458 | public const VK_F6 = &h075 459 | public const VK_F7 = &h076 460 | public const VK_F8 = &h077 461 | public const VK_F9 = &h078 462 | public const VK_F10 = &h079 463 | public const VK_F11 = &h07a 464 | public const VK_F12 = &h07b 465 | public const VK_F13 = &h07c 466 | public const VK_F14 = &h07d 467 | public const VK_F15 = &h07e 468 | public const VK_F16 = &h07f 469 | public const VK_F17 = &h080 470 | public const VK_F18 = &h081 471 | public const VK_F19 = &h082 472 | public const VK_F20 = &h083 473 | public const VK_F21 = &h084 474 | public const VK_F22 = &h085 475 | public const VK_F23 = &h086 476 | public const VK_F24 = &h087 477 | public const VK_NUMLOCK = &h090 478 | public const VK_SCROLL = &h091 479 | public const VK_LSHIFT = &h0a0 480 | public const VK_RSHIFT = &h0a1 481 | public const VK_LCONTROL = &h0a2 482 | public const VK_RCONTROL = &h0a3 483 | public const VK_LMENU = &h0a4 ' This is apparently the left "Alt" key 484 | public const VK_RMENU = &h0a5 ' This is apparently the right "Alt" key 485 | public const VK_BROWSER_BACK = &h0a6 486 | public const VK_BROWSER_FORWARD = &h0a7 487 | public const VK_BROWSER_REFRESH = &h0a8 488 | public const VK_BROWSER_STOP = &h0a9 489 | public const VK_BROWSER_SEARCH = &h0aa 490 | public const VK_BROWSER_FAVORITES = &h0ab 491 | public const VK_BROWSER_HOME = &h0ac 492 | public const VK_VOLUME_MUTE = &h0ad 493 | public const VK_VOLUME_DOWN = &h0ae 494 | public const VK_VOLUME_UP = &h0af 495 | public const VK_MEDIA_NEXT_TRACK = &h0b0 496 | public const VK_MEDIA_PREV_TRACK = &h0b1 497 | public const VK_MEDIA_STOP = &h0b2 498 | public const VK_MEDIA_PLAY_PAUSE = &h0b3 499 | public const VK_LAUNCH_MAIL = &h0b4 500 | public const VK_LAUNCH_MEDIA_SELECT = &h0b5 501 | public const VK_LAUNCH_APP1 = &h0b6 502 | public const VK_LAUNCH_APP2 = &h0b7 503 | public const VK_OEM_1 = &h0ba 504 | public const VK_OEM_PLUS = &h0bb 505 | public const VK_OEM_COMMA = &h0bc 506 | public const VK_OEM_MINUS = &h0bd 507 | public const VK_OEM_PERIOD = &h0be 508 | public const VK_OEM_2 = &h0bf 509 | public const VK_OEM_3 = &h0c0 510 | public const VK_OEM_4 = &h0db 511 | public const VK_OEM_5 = &h0dc 512 | public const VK_OEM_6 = &h0dd 513 | public const VK_OEM_7 = &h0de 514 | public const VK_OEM_8 = &h0df 515 | public const VK_OEM_102 = &h0e2 516 | public const VK_PROCESSKEY = &h0e5 517 | public const VK_PACKET = &h0e7 518 | public const VK_ATTN = &h0f6 519 | public const VK_EXSEL = &h0f8 520 | public const VK_PLAY = &h0fa 521 | public const VK_NONAME = &h0fc ' } 522 | ' } 523 | ' { W 524 | ' WH_* constants used for SetWindowsHookEx { 525 | ' 526 | public const WH_CBT = 5 527 | public const WH_KEYBOARD_LL = 13 ' Low level keyboard events (compare with WH_KEYBOARD) 528 | public const WH_SHELL = 10 ' Notification of shell events, such as creation of top level windows. 529 | ' } 530 | ' { WM_*: Window messsages 531 | public const WM_CHAR = &h0102 532 | public const WM_CLOSE = &H0010 533 | public const Wm_CREATE = &H0001 534 | public const WM_DESTROY = &H0002 535 | public const WM_KEYDOWN = &h0100 536 | public const WM_KEYUP = &h0101 537 | public const WM_PAINT = &H000F 538 | public const WM_SETTEXT = &h000C 539 | public const WM_SETTINGCHANGE = &H001A 540 | public const WM_SIZE = &h0005 541 | public const WM_SYSKEYDOWN = &h0104 542 | public const WM_SYSKEYUP = &h0105 543 | ' } 544 | 545 | ' { WS_* / Window styles 546 | public const WS_VISIBLE = &H10000000 547 | public const WS_VSCROLL = &H200000 548 | public const WS_TABSTOP = &H10000 549 | public const WS_THICKFRAME = &H40000 550 | public const WS_MAXIMIZE = &H1000000 551 | public const WS_MAXIMIZEBOX = &H10000 552 | public const WS_MINIMIZE = &H20000000 553 | public const WS_MINIMIZEBOX = &H20000 554 | public const WS_SYSMENU = &H80000 555 | public const WS_BORDER = &H800000 556 | public const WS_DLGFRAME = &H400000 557 | public const WS_CAPTION = WS_BORDER or WS_DLGFRAME 558 | public const WS_CHILD = &H40000000 559 | public const WS_CHILDWINDOW = WS_CHILD 560 | public const WS_CLIPCHILDREN = &H2000000 561 | public const WS_CLIPSIBLINGS = &H4000000 562 | public const WS_DISABLED = &H8000000 563 | public const WS_EX_ACCEPTFILES = &H10& 564 | public const WS_EX_DLGMODALFRAME = &H1& 565 | public const WS_EX_NOPARENTNOTIFY = &H4& 566 | public const WS_EX_STATICEDGE = &H20000 567 | public const WS_EX_TOPMOST = &H8& 568 | public const WS_EX_TRANSPARENT = &H20& 569 | public const WS_GROUP = &H20000 570 | public const WS_HSCROLL = &H100000 571 | public const WS_ICONIC = WS_MINIMIZE 572 | public const WS_OVERLAPPED = &H0& 573 | public const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU or WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX 574 | public const WS_POPUP = &H80000000 575 | public const WS_POPUPWINDOW = WS_POPUP or WS_BORDER or WS_SYSMENU 576 | public const WS_SIZEBOX = WS_THICKFRAME 577 | public const WS_TILED = WS_OVERLAPPED 578 | public const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW 579 | ' } 580 | 581 | public const WINEVENT_OUTOFCONTEXT = 0 582 | public const WINEVENT_SKIPOWNPROCESS = 2 583 | ' } 584 | 585 | ' { Brushes - used for GetStockObject 586 | public const WHITE_BRUSH = 0 587 | public const BLACK_BRUSH = 4 588 | ' } 589 | 590 | ' } 591 | #if VBA7 then ' 32-Bit versions of Excel ' { 592 | 593 | ' { A 594 | declare function AttachThreadInput lib "user32" ( _ 595 | byVal idAttach as long, _ 596 | byVal idAttachTo as long, _ 597 | byVal fAttach as long) as long 598 | 599 | ' } 600 | ' { B 601 | declare function Beep lib "kernel32" ( _ 602 | byVal dwFreq as long, _ 603 | byVal dwDuration as long) as long 604 | 605 | declare ptrSafe function BeginPaint lib "user32" ( _ 606 | byVal hwnd as longPtr, _ 607 | lpPaint as PAINTSTRUCT) as longPtr 608 | 609 | declare function BringWindowToTop lib "user32" ( _ 610 | byVal lngHWnd as long) as long 611 | 612 | ' } 613 | ' { C 614 | 615 | ' CallNextHookEx { 616 | declare function CallNextHookEx lib "user32" ( _ 617 | byVal hHook as long, _ 618 | byVal nCode as long, _ 619 | byVal wParam as long, _ 620 | lParam as any ) as long 621 | ' } 622 | 623 | declare function CloseClipboard lib "User32" () as long 624 | 625 | declare function CloseHandle lib "kernel32" ( _ 626 | byVal hObject as long) as long 627 | 628 | ' CreateProcess { 629 | declare ptrSafe function CreateProcess lib "kernel32" alias "CreateProcessA" ( _ 630 | byVal lpApplicationName as string , _ 631 | byVal lpCommandLine as string , _ 632 | byRef lpProcessAttributes as SECURITY_ATTRIBUTES, _ 633 | byRef lpThreadAttributes as SECURITY_ATTRIBUTES, _ 634 | byVal bInheritHandles as long , _ 635 | byVal dwCreationFlags as long , _ 636 | byRef lpEnvironment as any , _ 637 | byVal lpCurrentDirectory as string , _ 638 | lpStartupInfo as STARTUPINFO , _ 639 | lpProcessInformation as PROCESS_INFORMATION) as longPtr 640 | ' } 641 | 642 | ' CreateThread { 643 | declare function CreateThread lib "kernel32" ( _ 644 | lpThreadAttributes as any , _ 645 | byVal dwStackSize as long, _ 646 | byVal lpStartAddress as long, _ 647 | byVal lParameter as long, _ 648 | byVal dwCreationFlags as long, _ 649 | lpThreadID as long) as long 650 | ' } 651 | 652 | ' CreateWindowEx { 653 | ' 654 | ' See CW_USEDEFAULT for x, y, nWidth and nHeight 655 | ' 656 | declare ptrSafe function CreateWindowEx lib "user32" alias "CreateWindowExA" ( _ 657 | byVal dwExStyle as long , _ 658 | byVal lpClassName as string , _ 659 | byVal lpWindowName as string , _ 660 | byVal dwStyle as long , _ 661 | byVal x as long , _ 662 | byVal y as long , _ 663 | byVal nWidth as long , _ 664 | byVal nHeight as long , _ 665 | byVal hWndParent as longPtr, _ 666 | byVal hMenu as longPtr, _ 667 | byVal hInstance as longPtr, _ 668 | lpParam as any) as longPtr 669 | ' } 670 | 671 | ' } 672 | ' { D 673 | 674 | ' DefWindowProc { 675 | declare ptrSafe function DefWindowProc lib "user32" alias "DefWindowProcA" ( _ 676 | byVal hwnd as longPtr, _ 677 | byVal wMsg as long , _ 678 | byVal wParam as longPtr, _ 679 | byVal lParam as longPtr) as longPtr 680 | ' } 681 | 682 | declare ptrSafe function DispatchMessage lib "user32" alias "DispatchMessageA" (lpMsg as MSG) as longPtr 683 | 684 | ' { DrawText 685 | ' Use a combination of DT constants for wFormat 686 | declare ptrSafe function DrawText lib "user32" alias "DrawTextA" ( _ 687 | byVal hdc as longPtr, _ 688 | byVal lpStr as string , _ 689 | byVal nCount as long , _ 690 | lpRect as RECT , _ 691 | byVal wFormat as long) as long 692 | ' } 693 | ' } 694 | ' { E 695 | 696 | declare function EmptyClipboard lib "User32" () as long 697 | 698 | declare function EnumProcessModules lib "PSAPI.DLL" ( _ 699 | byVal hProcess as long, _ 700 | lphModule as long, _ 701 | byVal cb as long, _ 702 | lpcbNeeded as long ) as long 703 | 704 | declare ptrSafe function EndPaint lib "user32" ( _ 705 | byVal hwnd as longPtr, _ 706 | lpPaint as PAINTSTRUCT) as long 707 | 708 | declare function EnumChildWindows lib "user32" ( _ 709 | byVal hWndParent as long, _ 710 | byVal lpEnumFunc as long, _ 711 | byVal lParam as long) as long 712 | 713 | declare function EnumWindows lib "user32" ( _ 714 | byVal lpEnumFunc as long, _ 715 | byVal lParam as long) as long 716 | 717 | declare function EnumDisplayMonitors lib "user32" ( _ 718 | byVal hdc as long, _ 719 | byVal lprcClip as long, _ 720 | byVal lpfnEnum as long, _ 721 | byVal dwData as long) as long 722 | ' } 723 | ' { F 724 | 725 | ' FindWindow: Find the top level window that matches lpClassName (if not null) and lpWindowName (if not null). { 726 | ' 727 | ' Some Class Names 728 | ' MS Access: OMain 729 | ' MS Excel: XLMAIN 730 | ' MS Outlook: rctrl_renwnd32 731 | ' MS Word: OpusApp 732 | ' Visual Basic Editor: wndclass_desked_gsk 733 | ' 734 | declare function FindWindow lib "user32" alias "FindWindowA" ( _ 735 | byVal lpClassName as string, _ 736 | byVal lpWindowName as string) as long 737 | ' } 738 | ' FindWindowEx { 739 | declare function FindWindowEx lib "user32" alias "FindWindowExA" ( _ 740 | byVal hWndParent as long , _ 741 | byVal hWndChildAfter as long , _ 742 | byVal lpClassName as string, _ 743 | byVal lpWindowName as string) as long 744 | ' } 745 | 746 | declare ptrSafe function FormatMessage lib "kernel32" alias "FormatMessageA" ( _ 747 | byVal dwFlags as long , _ 748 | lpSource as any , _ 749 | byVal dwMessageId as long , _ 750 | byVal dwLanguageId as long , _ 751 | byVal lpBuffer as string, _ 752 | byVal nSize as long , _ 753 | Arguments as longPtr) as long 754 | ' } 755 | ' { G 756 | ' GetActiveWindow { 757 | ' Returns the window of the *calling thread* that receives input (Hmmm... is this not the window returned with GetFocus()) 758 | ' Compare GetForegroundWindow 759 | declare function GetActiveWindow lib "user32" () as long 760 | ' } 761 | 762 | ' GetClassName { 763 | declare function GetClassName lib "user32.dll" alias "GetClassNameA" ( _ 764 | byVal hWnd as long, _ 765 | byVal lpClassName as string, _ 766 | byVal nMaxCount as long) as long 767 | ' } 768 | ' GetClientRect { 769 | declare ptrSafe function GetClientRect lib "user32" ( _ 770 | byVal hwnd as longPtr, _ 771 | lpRect as RECT ) as long 772 | ' } 773 | ' GetComputerName reads the NetBIOS name from the registry when the system is { 774 | ' started upc 775 | ' 776 | declare function GetComputerName lib "kernel32" alias "GetComputerNameA" ( _ 777 | byVal lpBuffer as string, _ 778 | byRef nSize as long) as long 779 | ' } 780 | 781 | declare ptrSafe function GetCurrentProcess lib "kernel32" () as longPtr 782 | 783 | declare function GetCurrentThreadId lib "kernel32" () as long 784 | 785 | declare function GetCursorPos lib "User32" (lpPoint as POINTAPI) as long 786 | 787 | declare function GetDesktopWindow lib "user32" () as long 788 | 789 | declare function GetEnvironmentVariable lib "kernel32" alias "GetEnvironmentVariableA" ( _ 790 | byVal lpName as string, _ 791 | byVal lpBuffer as string, _ 792 | byVal nSize as long) as long 793 | 794 | ' GetForegroundWindow { 795 | ' Returns the window that currently receives input. 796 | ' Compare with GetActiveWindow() 797 | declare function GetForegroundWindow lib "user32" () as long 798 | ' } 799 | ' GetLocaleInfo { 800 | ' Microsoft says that GetLocaleInfoEx is now preferred (for interoperability reasons). 801 | declare ptrSafe function GetLocaleInfo lib "kernel32" alias "GetLocaleInfoA" ( _ 802 | byVal lcid as long , _ 803 | byVal dwInfoType as long , _ 804 | byVal lpSrcStr as string, _ 805 | byVal cchSrc as long ) as long 806 | ' } 807 | ' GetM* { 808 | ' GetMessage { 809 | ' When GetMessage (and PeekMessage) encounter a WM_QUIT message, they will 810 | ' return 0. 811 | declare ptrSafe function GetMessage lib "user32" alias "GetMessageA" ( _ 812 | lpMsg as MSG , _ 813 | byVal hwnd as longPtr, _ 814 | byVal wMsgFilterMin as long , _ 815 | byVal wMsgFilterMax as long) as long 816 | ' } 817 | 818 | declare function GetModuleBaseName lib "PSAPI.DLL" alias "GetModuleBaseNameA" ( _ 819 | byVal hProcess as long , _ 820 | byVal hModule as long , _ 821 | byVal lpFilename as string, _ 822 | byVal nSize as long) as long 823 | 824 | declare function GetModuleFileNameEx lib "PSAPI" alias "GetModuleFileNameExA" ( _ 825 | byVal hProcess as long, _ 826 | byVal hModule as long, _ 827 | byVal lpFilename as string, nSize as long) as boolean 828 | 829 | declare function GetModuleInformation lib "PSAPI" ( _ 830 | byVal hProcess as long , _ 831 | byVal hModule as long , _ 832 | LPMODULEINFO as MODULEINFO, _ 833 | cb as long ) as boolean 834 | ' GetM } 835 | ' GetKeyboardLayout { 836 | declare function GetKeyboardLayout lib "user32" alias "GetKeyboardLayout" ( _ 837 | byVal idThread as long ) as long 838 | ' } 839 | 840 | declare ptrSafe function GetLastError lib "kernel32" () as long 841 | 842 | declare function GetModuleHandle lib "kernel32" alias "GetModuleHandleA" ( _ 843 | byVal lpModuleName as string) as long 844 | 845 | declare function GetParent lib "user32" ( _ 846 | byVal hwnd as long ) as long 847 | 848 | declare function GetProcAddress lib "kernel32" ( _ 849 | byVal module as long , _ 850 | byVal procName as string) as long 851 | 852 | ' GetProcessHeap { 853 | ' - See also HeapAlloc() 854 | declare ptrSafe function GetProcessHeap lib "kernel32" () As longPtr 855 | ' } 856 | 857 | ' { GetStockObject 858 | ' See also predefined brushes (such as WHITE_BRUSH, BLACK_BRUSH etc.) 859 | declare ptrSafe function GetStockObject lib "gdi32" ( _ 860 | byVal nIndex as long ) as longPtr 861 | ' } 862 | ' GetSystemDefaultLangID { 863 | declare ptrSafe function GetSystemDefaultLangID lib "kernel32" alias "GetSystemDefaultLangID" () as integer 864 | ' } 865 | 866 | ' GetSystemMetric { 867 | ' nIndex is one of the SM_* constants. 868 | declare ptrSafe function GetSystemMetrics lib "user32" ( _ 869 | byVal nIndex as long) as long 870 | ' } 871 | 872 | declare function GetTempFileName lib "kernel32" alias "GetTempFileNameA" ( _ 873 | byVal lpszPath as string, _ 874 | byVal lpPrefixString as string, _ 875 | byVal uUnique as long, _ 876 | byVal lpTempFileName as string) as long 877 | 878 | declare function GetTempPath lib "kernel32" alias "GetTempPathA" ( _ 879 | byVal nBufferLength as long, _ 880 | byVal lpBuffer as string) as long 881 | 882 | declare function GetWindowRect lib "user32.dll" ( _ 883 | byVal hwnd as long, _ 884 | byRef lpRect as RECT ) as long 885 | 886 | declare function GetWindowThreadProcessId lib "user32" ( _ 887 | byVal hwnd as long, _ 888 | lpdwProcessId as long) as long 889 | 890 | declare function GetWindowText lib "user32" alias "GetWindowTextA" ( _ 891 | byVal hWnd as long , _ 892 | byVal lpString as string, _ 893 | byVal nMaxCount as long ) as long 894 | 895 | declare function GetWindowTextLength lib "user32" alias "GetWindowTextLengthA" ( _ 896 | byVal hWnd as long ) as long 897 | 898 | declare function GetUserName lib "advapi32.dll" alias "GetUserNameA" ( _ 899 | byVal lpBuffer as string, _ 900 | nSize as long ) as long 901 | 902 | declare function GlobalAlloc lib "kernel32" ( _ 903 | byVal wFlags as long, _ 904 | byVal dwBytes as long) as long 905 | 906 | ' GlobalLock { 907 | ' Compare with GlobalUnlock 908 | declare function GlobalLock lib "kernel32" ( _ 909 | byVal hMem as long) as long 910 | ' } 911 | 912 | ' GlobalUnlock { 913 | ' Compare with GlobalLock 914 | declare function GlobalUnlock lib "kernel32" ( _ 915 | byVal hMem as long ) as long 916 | ' } 917 | 918 | ' } 919 | ' { H 920 | 921 | ' HeapAlloc { 922 | ' 923 | ' hHeap: Use GetProcessHeap() or HeapCreate 924 | ' 925 | ' - Compare with -> VirtualAlloc 926 | ' 927 | declare ptrSafe function HeapAlloc lib "kernel32" ( _ 928 | byVal hHeap as longPtr, _ 929 | byVal dwFlags as long , _ 930 | byVal dwBytes as longPtr) as longPtr 931 | ' } 932 | 933 | ' } 934 | ' { I 935 | declare function IsIconic lib "user32" ( _ 936 | byVal hwnd as long) as long 937 | 938 | declare function ImageRvaToVa lib "Imagehlp.dll" ( _ 939 | byVal NTHeaders as long, _ 940 | byVal Base as long, _ 941 | byVal RVA as long, _ 942 | byVal LastRvaSection as long) as long 943 | 944 | ' } 945 | ' { L 946 | 947 | 948 | declare function lstrlen lib "kernel32" alias "lstrlenA" ( _ 949 | byVal lpsz as long) as long 950 | 951 | declare function lstrcpy lib "kernel32" ( _ 952 | byVal lpString1 as any, _ 953 | byVal lpString2 as any) as long 954 | 955 | ' LoadCursor { 956 | ' See also constants IDC_ARROW etc 957 | declare ptrSafe function LoadCursor lib "user32" alias "LoadCursorA" ( _ 958 | byVal hInstance as longPtr, _ 959 | byVal lpCursorName as string ) as longPtr 960 | ' } 961 | 962 | ' LoadIcon { 963 | ' See also -> IDI_APPLICATION 964 | declare ptrSafe function LoadIcon lib "user32" alias "LoadIconA" ( _ 965 | byVal hInstance as longPtr, _ 966 | byVal lpIconName as string) as longPtr 967 | ' } 968 | ' LoadKeyboardLayout { 969 | ' TODO: VkKeyScanEx loadkeyboardlayout makelangid LANG_SYSTEM_DEFAULT LANG_USER_DEFAULT 970 | declare ptrSafe function LoadKeyboardLayout lib "user32" alias "LoadKeyboardLayoutA" ( _ 971 | byVal pwszKLID as string, _ 972 | byVal flags as long) as longPtr 973 | ' } 974 | 975 | ' } 976 | ' { M 977 | 978 | ' Map* { 979 | declare function MapAndLoad lib "Imagehlp.dll" ( _ 980 | byVal ImageName as string, _ 981 | byVal DLLPath as string, _ 982 | LoadedImage as LOADED_IMAGE, _ 983 | DotDLL as long, _ 984 | ReadOnly as long) as long 985 | 986 | declare function MapVirtualKey lib "user32" alias "MapVirtualKeyA" ( _ 987 | byVal wCode as long, _ 988 | byVal wMapType as long) as long 989 | 990 | declare function MapVirtualKeyEx lib "user32" alias "MapVirtualKeyExA" ( _ 991 | byVal wCode as long, _ 992 | byVal wMapType as long, _ 993 | byVal dwhkl as long) as long 994 | 995 | ' Map } 996 | 997 | 998 | declare ptrSafe function MessageBox lib "user32" alias "MessageBoxW" ( _ 999 | byVal hwnd as longPtr, _ 1000 | byVal lpText as longPtr, _ 1001 | byVal lpCaption as longPtr, _ 1002 | byVal wType as long) as long 1003 | 1004 | declare ptrSafe function MoveWindow lib "user32" alias "MoveWindow" ( _ 1005 | byVal hwnd as longPtr, _ 1006 | byVal x as long , _ 1007 | byVal y as long , _ 1008 | byVal nWidth as long , _ 1009 | byVal nHeight as long , _ 1010 | byVal bRepaint as long ) as long 1011 | 1012 | ' } 1013 | ' { O 1014 | declare function OpenClipboard lib "User32" ( _ 1015 | byVal hwnd as long) as long 1016 | 1017 | 1018 | declare function OpenProcess lib "kernel32" ( _ 1019 | byVal dwDesiredAccess as long, _ 1020 | byVal bInheritHandle as long, _ 1021 | byVal dwProcessId as long) as long 1022 | ' } 1023 | ' { P 1024 | 1025 | ' PeekMessage { 1026 | ' See also -> GetMessage 1027 | declare function PeekMessage lib "user32" alias "PeekMessageA" ( _ 1028 | byRef lpMsg as MSG , _ 1029 | byVal hwnd as long, _ 1030 | byVal wMsgFilterMin as long, _ 1031 | byVal wMsgFilterMax as long, _ 1032 | byVal wRemoveMsg as long) as long 1033 | ' } 1034 | 1035 | declare ptrSafe function PostMessage lib "user32" alias "PostMessageA" ( _ 1036 | byVal hwnd as longPtr, _ 1037 | byVal wMsg as long , _ 1038 | byVal wParam as longPtr, _ 1039 | lParam as any) as long 1040 | 1041 | declare ptrSafe sub PostQuitMessage lib "user32" (byVal nExitCode as long) 1042 | 1043 | ' } 1044 | ' { R 1045 | ' RegisterClassEx { 1046 | declare ptrSafe function RegisterClassEx lib "user32" alias "RegisterClassExA" ( _ 1047 | pcWndClassEx as WNDCLASSEX ) as integer 1048 | ' } 1049 | 1050 | declare ptrSafe sub RtlMoveMemory lib "kernel32" ( _ 1051 | byRef dest as any , _ 1052 | byRef source as any , _ 1053 | byVal size as longPtr) 1054 | 1055 | declare ptrSafe sub RtlZeroMemory lib "kernel32" ( _ 1056 | dest as any , _ 1057 | byVal length as long ) 1058 | 1059 | 1060 | ' } 1061 | ' { S 1062 | declare function SendInput lib "user32" ( _ 1063 | byVal nInputs as long, _ 1064 | byRef pInputs as any , _ 1065 | byVal cbSize as long) as long 1066 | 1067 | declare function SendMessage lib "user32" alias "SendMessageA" ( _ 1068 | byVal hwnd as long, _ 1069 | byVal wMsg as long, _ 1070 | byVal wParam as long, _ 1071 | lParam as any) as long 1072 | 1073 | ' SendMessageW { 1074 | ' 1075 | ' The wide-character variant of SendMessage is needed if 1076 | ' a string needs to be passed with lParam. See for example 1077 | ' https://renenyffenegger.ch/notes/Windows/registry/environment-variables 1078 | ' 1079 | declare function SendMessageW lib "user32" alias "SendMessageW" ( _ 1080 | byVal hwnd as long, _ 1081 | byVal wMsg as long, _ 1082 | byVal wParam as long, _ 1083 | lParam as any) as long 1084 | ' } 1085 | 1086 | declare function SendMessageTimeoutW lib "user32" alias "SendMessageTimeoutW" ( _ 1087 | byVal hwnd as long, _ 1088 | ByVal msg as long, _ 1089 | byVal wParam as long, _ 1090 | byVal lParam as long, _ 1091 | byVal fuFlags as long, _ 1092 | byVal uTimeout as long, _ 1093 | lpdwResult as long) as long 1094 | 1095 | declare function SetClipboardData lib "User32" ( _ 1096 | byVal wFormat as long, _ 1097 | byVal hMem as long) as long 1098 | 1099 | ' { Set * 1100 | 1101 | declare function SetEnvironmentVariable lib "kernel32" alias "SetEnvironmentVariableA" ( _ 1102 | byVal lpName as string, _ 1103 | byVal lpValue as string) as long 1104 | 1105 | declare ptrSafe function SetFocus lib "user32" (byVal hwnd as longPtr) as longPtr 1106 | 1107 | declare function SetForegroundWindow lib "user32" (byVal hWnd as long) as long 1108 | 1109 | declare function SetWindowsHookEx lib "user32" alias "SetWindowsHookExA" ( _ 1110 | byVal idHook as long, _ 1111 | byVal lpfn as long, _ 1112 | byVal hmod as long, _ 1113 | byVal dwThreadId as long) as long 1114 | 1115 | declare function SetWindowPos lib "user32" ( _ 1116 | byVal hWnd as long, _ 1117 | byVal hWndInsertAfter as long, _ 1118 | byVal x as long, _ 1119 | byVal y as long, _ 1120 | byVal cx as long, _ 1121 | byVal cy as long, _ 1122 | byVal uFlags as long) as long 1123 | ' 1124 | ' Use one of the SWP_* constants for wFlags 1125 | ' 1126 | 1127 | declare function SetWindowText lib "user32" alias "SetWindowTextA" ( _ 1128 | byVal hWnd as long , _ 1129 | byVal lpString as string) as long 1130 | 1131 | ' SetWinEventHook. The counter-function is UnhookWinEvent { 1132 | ' 1133 | declare function SetWinEventHook lib "user32.dll" ( _ 1134 | byVal eventMin as long , _ 1135 | byVal eventMax as long , _ 1136 | byVal hmodWinEventProc as long , _ 1137 | byVal pfnWinEventProc as long , _ 1138 | byVal idProcess as long , _ 1139 | byVal idThread as long , _ 1140 | byVal dwFlags as long) as long 1141 | ' } 1142 | ' } 1143 | declare function ShellExecute lib "shell32.dll" alias "ShellExecuteA" ( _ 1144 | byVal hwnd as long , _ 1145 | byVal lpOperation as string, _ 1146 | byVal lpFile as string, _ 1147 | byVal lpParameters as string, _ 1148 | byVal lpDirectory as string, _ 1149 | byVal lpShowCmd as long) as long 1150 | 1151 | ' ShowWindow { 1152 | ' 1153 | ' Use one of the SW*_ constants for nCmdSHow 1154 | ' 1155 | declare ptrSafe function ShowWindow lib "user32" ( _ 1156 | byVal hwnd as long, _ 1157 | byVal nCmdSHow as long) as long 1158 | ' } 1159 | 1160 | declare sub Sleep lib "kernel32" (byVal dwMilliseconds as long ) 1161 | ' } 1162 | ' { T 1163 | ' TranslateMessage translates virtual-key messages into character messages. { 1164 | declare ptrSafe function TranslateMessage lib "user32" (byRef lpMsg as MSG) as long 1165 | ' } 1166 | ' } 1167 | ' { U 1168 | ' UnhookWinEvent: unhook hooks established with SetWinEventHook { 1169 | ' 1170 | declare function UnhookWinEvent lib "user32.dll" ( _ 1171 | byRef hWinEventHook as long) as long 1172 | ' } 1173 | 1174 | declare function UnMapAndLoad lib "Imagehlp.dll" (LoadedImage as LOADED_IMAGE) as long 1175 | 1176 | declare function UnhookWindowsHookEx lib "user32" (byVal hHook as long ) as long 1177 | 1178 | declare ptrSafe function UpdateWindow lib "user32" (byVal hwnd as longPtr) as long 1179 | 1180 | ' } 1181 | ' { V 1182 | 1183 | ' VirtualAlloc { 1184 | ' - Use one of the MEM_* constants for flAllocationType 1185 | ' - Use PAGE_* for flProtect 1186 | ' - See also VirtualFree 1187 | ' - Compare with HeapAlloc 1188 | declare ptrSafe function VirtualAlloc lib "kernel32" ( _ 1189 | byVal address as longPtr, _ 1190 | byVal size as longPtr, _ 1191 | byVal flAllocationType as long , _ 1192 | byVal flProtect as long) as longPtr 1193 | ' } 1194 | ' VirtualFree { 1195 | ' - See also MEM_* 1196 | ' - See also VirtualAlloc 1197 | declare ptrSafe function VirtualFree lib "kernel32" ( _ 1198 | byVal lpAddress as longPtr, _ 1199 | byVal size as longPtr, _ 1200 | byVal dwFreeType as long ) as long 1201 | 1202 | ' } 1203 | ' VirtualProtect { 1204 | declare function VirtualProtect lib "kernel32" ( _ 1205 | lpAddress as long , _ 1206 | byVal dwSize as long , _ 1207 | byVal flNewProtect as long , _ 1208 | lpflOldProtect as long) as long 1209 | ' } 1210 | declare function VkKeyScan lib "user32" alias "VkKeyScanA" ( _ 1211 | byVal cChar as byte) as integer 1212 | 1213 | ' VkKeyScanEx { 1214 | ' Convert a "character" into a *xvirtual key code* and a *shift state*. 1215 | ' dwhkl apparently refers to a kayboard layout which can be optained 1216 | ' with GetKeyboardLayout. 1217 | declare ptrSafe function VkKeyScanEx lib "user32" alias "VkKeyScanExA" ( _ 1218 | byVal ch as byte , _ 1219 | byVal dwhkl as longPtr ) as integer 1220 | ' } 1221 | 1222 | ' } 1223 | ' { W 1224 | declare function WaitMessage lib "user32" () as long 1225 | ' } 1226 | ' } 1227 | #else ' 64-Bit versions of Excel ' { 1228 | 1229 | declare ptrSafe sub Sleep lib "kernel32" (byVal dwMilliseconds as longPtr) 1230 | 1231 | 1232 | #end if ' } 1233 | ' Helpers { 1234 | 1235 | function LOBYTE(dw as long) as byte ' { 1236 | LOBYTE = dw and &h000000ff 1237 | end function ' } 1238 | 1239 | function LOWORD(dw as long) as long ' { 1240 | if dw And &H8000& then 1241 | LOWORD = &H8000 Or (dw And &H7FFF&) 1242 | else 1243 | LOWORD = dw And &HFFFF& 1244 | end if 1245 | end function ' } 1246 | 1247 | function HIWORD(dw as long) as long ' { 1248 | 1249 | if dw and &H80000000 then 1250 | HIWORD = (dw \ 65535) - 1 1251 | else 1252 | HIWORD = dw \ 65535 1253 | end if 1254 | 1255 | end function ' } 1256 | 1257 | ' } 1258 | --------------------------------------------------------------------------------