Wizard of Odd codex

💠Laissez Les Bon Code Roulez💠

User Tools

Site Tools


vba:windows_apis

Windows APIs

For VBA7, there is a requirement to have Pointer-Safe APIs. For backward compatibility, there is a requirement to have “older syntax”. The following modules are probably imperfect, but should be good enough.

This isn't exhaustive - but it's a cut of commonly-used structures and APIs.

The modules are semi-structured so they can be conditionally compiled properly.

WindowsAPI

_WindowsApi.bas
'
'   [_WindowsAPI]
'
Option Compare ' BINARY | TEXT | Database (if using MSAccess)
Option Explicit
 
#If VBA7 Then
'   Use _WindowsAPI7
'  Read version info into buffer
' /* Length of buffer for info *
' /* Information from GetFileVersionSize *
' /* Filename of version stamped file *
' Declare PtrSafe Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
' Declare PtrSafe Function VerQueryValue Lib "version.dll" (pBlock As Any, ByVal lpSubBlock As String, ByVal lplpBuffer As LongPtr, puLen As Long) As Long
#Else
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Shell32.DLL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, lpParameters As Any, lpDirectory As Any, ByVal nShowCmd As Long) As Long
 
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Version.DLL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
'
'   Returns size of version info in Bytes
'
Public Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
'
'   Read version info into buffer: Arguments:
'       1. Length of buffer for info.
'       2.Information from GetFileVersionSize.
'       3. Filename of version stamped file
'
Public Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
 
'
'   Returns selected version information from the specified
'version-information resource.
'
Public Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Kernel 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SystemTime) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare Function GetFreeSpace Lib "kernel32" (ByVal wFlags As Integer) As Long
Public Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetVersion Lib "kernel32" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetWinFlags Lib "kernel32" Alias "GetWinFlagsA" () As Long
Public Declare Function GetWindowsDirectory& Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long)
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) As Long
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SystemTime, lpFileTime As FILETIME) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Public Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Public Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
 
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByRef Source As Byte, ByVal Length As Long)
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - User 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal fRepaint As Long) As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Public Declare Function SetFocusAPI Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long)
Public Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Public Declare Function SetKeyboardState Lib "user32" (lppbKeyState As Any) As Long
Public Declare Function GetKeyboardState Lib "user32" (pbKeyState As Any) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
 
Public Const VK_SHIFT = &H10
Public Const VK_LSHIFT = &HA0
Public Const VK_RSHIFT = &HA1
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - AdvAPI 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Toolhelp.dll
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function SystemHeapInfo Lib "ToolHelp.dll" (shi As SYSHEAPINFO) As Integer
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Ole Accessibility / Automation / Programmability
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As typUUID, ByRef ppvObject As Object) As Long
' Public Declare Function LoadTypeLibEx Lib "oleaut32.dll" (ByVal szFile As Long, ByVal regkind As Long, pptlib As ITypeLib) As Long
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As GUID, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - msvbvm60
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - GDI 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - GDI+
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function GdipBitmapApplyEffect Lib "gdiplus.dll" (ByVal Image As Long, ByVal Effect As Long, ByVal roi As Long, ByVal useAuxData As Long, ByVal auxData As Long, ByVal auxDataSize As Long) As Long
Public Declare Function GdipCreateBitmapFromFile Lib "gdiplus.dll" (ByVal Filename As Long, bitmap As Long) As Long
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hbm As Long, ByVal hPal As Long, bitmap As Long) As Long
Public Declare Function GdipCreateBitmapFromHICON Lib "gdiplus" (ByVal hIcon As Long, bitmap As Long) As Long
Public Declare Function GdipCreateEffect Lib "gdiplus.dll" (ByVal cid1 As Long, ByVal cid2 As Long, ByVal cid3 As Long, ByVal cid4 As Long, Effect As Long) As Long
Public Declare Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hdc As Long, GpGraphics As Long) As Long
Public Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus.dll" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Public Declare Function GdipCreateHICONFromBitmap Lib "gdiplus" (ByVal bitmap As Long, hbmReturn As Long) As Long
Public Declare Function GdipDeleteEffect Lib "gdiplus.dll" (ByVal Effect As Long) As Long
Public Declare Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal graphics As Long) As Long
Public Declare Function GdipDisposeImage Lib "gdiplus.dll" (ByVal Image As Long) As Long
Public Declare Function GdipDrawImageRect Lib "gdiplus.dll" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
Public Declare Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As Long, Height As Long) As Long
Public Declare Function GdipGetImageThumbnail Lib "gdiplus.dll" (ByVal Image As Long, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As Long, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Public Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As Long, Width As Long) As Long
Public Declare Function GdipLoadImageFromStream Lib "gdiplus.dll" (ByVal stream As IUnknown, Image As Long) As Long
Public Declare Function GdipSaveImageToFile Lib "gdiplus.dll" (ByVal Image As Long, ByVal Filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function GdipSaveImageToStream Lib "gdiplus.dll" (ByVal Image As Long, ByVal stream As IUnknown, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function GdipSetEffectParameters Lib "gdiplus.dll" (ByVal Effect As Long, Params As Any, ByVal Size As Long) As Long
Public Declare Function GdiplusShutdown Lib "gdiplus.dll" (ByVal token As Long) As Long
Public Declare Function GdiplusStartup Lib "gdiplus.dll" (token As Long, inputbuf As GDIPStartupInput, Optional ByVal outputbuf As Long = 0) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - WinSock 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare Function gethostbyaddr Lib "ws2_32.dll" (addr As Long, ByVal addrLen As Long, ByVal addrType As Long) As Long
Public Declare Function gethostname Lib "ws2_32.dll" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, lpBuffer As INTERNET_CONNECTED_INFO, lpdwBufferLength As Long) As Boolean
Public Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, ByRef lpBuffer As Any, ByVal dwBufferLength As Long) As Long
Public Declare Function gethostbyname Lib "ws2_32.dll" (ByVal szHost As String) As Long
Public Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Public Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Public Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - ICMP
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
'Close an Internet Control Message Protocol (ICMP) handle that IcmpCreateFile opens.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpclosehandle.asp
Public Declare Function IcmpCloseHandle Lib "ICMP" (ByVal IcmpHandle As Long) As Long
'Create a handle on which Internet Control Message Protocol (ICMP) requests can be issued.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpcreatefile.asp
Public Declare Function IcmpCreateFile Lib "ICMP" () As Long
Public Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - OLE32.DLL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
' Some useful functions for GUID work, borrowed from COM
'
' NOTE: StringFromGUID2 is identical in what it does to the other ole32.dll
' functions StringFromIID and StringFromCLSID. Therefore, they are not
' defined here
 
Public Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal lpszProgID As Long, pclsid As GUID) As Long
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Public Declare Function CoCreateGuid Lib "ole32.dll" (rclsid As GUID) As Long
Public Declare Function CoCreateInstance Lib "ole32.dll" (rclsid As GUID, pUnkOuter As Any, ByVal dwClsContext As Long, riid As GUID, ppvObj As IUnknown) As Long
Public Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any) As Long
Public Declare Function GetHGlobalFromStream Lib "ole32" (ByVal pstm As Any, ByRef phglobal As Long) As Long
Public Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As typUUID) As Long
Public Declare Function IsEqualGUID Lib "ole32.dll" (rguid1 As GUID, rguid2 As GUID) As Long
Public Declare Function StringFromGUID2 Lib "ole32.dll" (rclsid As GUID, ByVal lpsz As Long, ByVal cbMax As Long) As Long
 
 
 
'Public Const IdleCountInterval = 1000
'Help Constants
'Public Const HELP_CONTEXT = &H1         'Display topic in ulTopic
'Public Const HELP_QUIT = &H2            'Terminate help
'Public Const HELP_INDEX = &H3           'Display index
'Public Const HELP_CONTENTS = &H3
'Public Const HELP_HELPONHELP = &H4      'Display help on using help
'Public Const HELP_SETINDEX = &H5        'Set the current Index for multi index help
'Public Const HELP_SETCONTENTS = &H5
'Public Const HELP_CONTXTPOPUP = &H8
'Public Const HELP_FORCEFILE = &H9
'Public Const HELP_KEY = &H101           'Display topic for keyword
'Public Const HELP_COMMAND = &H102
'Public Const HELP_PARTIALKEY = &H105    'call the search engine in winhelp
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Types / Structures
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' Only GDI+1.1:
'
 
Public Type BlurParameters
    Radius                          As Single
    ExpandEdges                     As Long
End Type
 
Public Type FILETIME
    dwLowDate                       As Long
    dwHighDate                      As Long
End Type
 
Public Type GDIPStartupInput
    GdiplusVersion                  As Long
    DebugEventCallback              As Long
    SuppressBackgroundThread        As Long
    SuppressExternalCodecs          As Long
End Type
 
Public Type HOSTENT
    hName                           As Long
    hAliases                        As Long
    hAddrType                       As Integer
    hLen                            As Integer
    hAddrList                       As Long
End Type
 
'
'   This structure describes the options that will be included in the
'   header of an IP packet.
'
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcetcpip/htm/cerefIP_OPTION_INFORMATION.asp
'
 
Public Type IP_OPTION_INFORMATION
    Ttl                             As Byte
    Tos                             As Byte
    Flags                           As Byte
    OptionsSize                     As Byte
    OptionsData                     As Long
End Type
 
'
'   This structure describes the data that is returned in response to an echo request.
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmp_echo_reply.asp
'
 
Public Type ICMP_ECHO_REPLY
    Address                         As Long
    Status                          As Long
    RoundTripTime                   As Long
    DataSize                        As Long
    Reserved                        As Integer
    ptrData                         As Long
    Options                         As IP_OPTION_INFORMATION
    Data                            As String * 250
End Type
 
Public Type ICMP_OPTIONS
    Ttl                             As Byte
    Tos                             As Byte
    Flags                           As Byte
    OptionsSize                     As Byte
    OptionsData                     As Long
End Type
 
 
Public Type INTERNET_CONNECTED_INFO
    dwConnectedState                As Long
    dwFlags                         As Long
End Type
 
Public Type MEMORYSTATUS
    dwLength                        As Long
    dwMemoryLoad                    As Long
    dwTotalPhys                     As Long
    dwAvailPhys                     As Long
    dwTotalPageFile                 As Long
    dwAvailPageFile                 As Long
    dwTotalVirtual                  As Long
    dwAvailVirtual                  As Long
End Type
 
Type POINTAPI
    x                               As Long
    y                               As Long
End Type
 
Type POINTL
    x                               As Long
    y                               As Long
End Type
 
Type RECT
    Left                            As Long
    Top                             As Long
    Right                           As Long
    Bottom                          As Long
End Type
 
Type WINDOWPLACEMENT
    Length                          As Long
    Flags                           As Long
    showCmd                         As Long
    ptMinPosition                   As POINTAPI
    ptMaxPosition                   As POINTAPI
    rcNormalPosition                As RECT
End Type
 
Public Type SYSHEAPINFO
    dwSize                          As Long
    wUserFreePercent                As Integer
    wGDIFreePercent                 As Integer
    hUserSegment                    As Integer
    hGDISegment                     As Integer
End Type
 
Public Type OSVERSIONINFO
    dwOSVersionInfoSize             As Long
    dwMajorVersion                  As Long
    dwMinorVersion                  As Long
    dwBuildNumber                   As Long
    dwPlatformId                    As Long
    szCSDVersion                    As String * 128    '  Maintenance string for PSS usage
End Type
 
Public Type OSVERSIONINFOEX
    dwOSVersionInfoSize             As Long
    dwMajorVersion                  As Long
    dwMinorVersion                  As Long
    dwBuildNumber                   As Long
    dwPlatformId                    As Long
    szCSDVersion                    As String * 128    '  Maintenance string for PSS usage
    wServicePackMajor               As Integer
    wServicePackMinor               As Integer
    wSuiteMask                      As Integer
    wProductType                    As Byte
    wReserved                       As Byte
End Type
 
Public Type PICTDESC
    cbSizeOfStruct                  As Long
    PicType                         As Long
    hImage                          As Long
    xExt                            As Long
    yExt                            As Long
End Type
 
 
'Only GDI+1.1:
 
Public Type SharpenParameters
    Radius                          As Single
    Amount                          As Single
End Type
 
Public Type TSize
    x                               As Double
    y                               As Double
End Type
 
Type SECURITY_ATTRIBUTES
    nLength                         As Long
    lpSecurityDescriptor            As LongPtr
    bInheritHandle                  As Long
End Type
 
'
'   Structure contains version information about a file.
'       (This information is language and code page independent.)
 
Public Type VS_FIXEDFILEINFO
    dwSignature                     As Long    'Contains the value 0xFEEFO4BD (szKey)
    dwStrucVersion                  As Long    'Specifies the binary version number of this structure.
    dwFileVersionMS                 As Long    'most significant 32 bits of the file's binary version number.
    dwFileVersionLS                 As Long    'least significant 32 bits of the file's binary version number.
    dwProductVersionLS              As Long    'most sig. 32 bits of binary version of product this file was distributed with.
    dwFileFlagsMask                 As Long    'least sig. 32 bits of binary version of product this file was distributed with.
    dwProductVersionMS              As Long    'Contains a bitmask that specifies the valid bits in dwFileFlags.
    dwFileFlags                     As Long    'Contains a bitmask that specifies the Boolean attributes of the file.
    dwFileOS                        As Long    'operating system for which this file was designed.
    dwFileType                      As Long    'general type of file.
    dwFileSubtype                   As Long    'function of the file.
    dwFileDateMS                    As Long    'most sig. 32 bits of the file's 64-bit binary creation date and time stamp.
    dwFileDateLS                    As Long    'least sig. 32 bits of the file's 64-bit binary creation date and time stamp.
End Type
 
 
Public Type typUUID                    'GUID
    Data1                           As Long
    Data2                           As Integer
    Data3                           As Integer
    Data4(7)                        As Byte
End Type
 
' Note that although Variants now have
' a VT_GUID type, this type is unsupported in VBA,
' so we must define our own here that will have the same
' binary layout as all GUIDs are expected by COM to
' have.
'
 
Public Type GUID
    Data1                           As Long
    Data2                           As Integer
    Data3                           As Integer
    Data4(7)                        As Byte    ' 0 to 7 (8 Bytes)
End Type
 
Public Type EncoderParameter
    UUID                            As GUID
    NumberOfValues                  As Long
    Type                            As Long
    Value                           As Long
End Type
 
Public Type EncoderParameters
    Count                           As Long
    Parameter                       As EncoderParameter
End Type
 
 
Public Type WSADATA
    wVersion                        As Integer
    wHighVersion                    As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets                     As Integer
    wMaxUDPDG                       As Integer
    dwVendorInfo                    As Long
End Type
 
Public Type SystemTime
    wYear                           As Integer
    wMonth                          As Integer
    wDayOfWeek                      As Integer
    wDay                            As Integer
    wHour                           As Integer
    wMinute                         As Integer
    wSecond                         As Integer
    wMilliseconds                   As Integer
End Type
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Enumerations
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Enum EShellShowConstants
    essSW_Hide = 0
    essSW_MAXIMIZE = 3
    essSW_MINIMIZE = 6
    essSW_SHOWMAXIMIZED = 3
    essSW_SHOWMINIMIZED = 2
    essSW_SHOWNORMAL = 1
    essSW_SHOWNOACTIVATE = 4
    essSW_SHOWNA = 8
    essSW_SHOWMINNOACTIVE = 7
    essSW_SHOWDEFAULT = 10
    essSW_RESTORE = 9
    essSW_SHOW = 5
End Enum
 
Public Enum ShellAndWaitResult
    Success = 0
    Failure = 1
    TimeOut = 2
    InvalidParameter = 3
    SysWaitAbandoned = 4
    UserWaitAbandoned = 5
    UserBreak = 6
End Enum
 
Public Enum ActionOnBreak
    IgnoreBreak = 0
    AbandonWait = 1
    PromptUser = 2
End Enum
 
Public Enum PicFileType
    pictypeBMP = 1
    pictypeGIF = 2
    pictypePNG = 3
    pictypeJPG = 4
End Enum
 
'
'   RGB Color Constants RGB(R,G,B) = Long(&HBBGGRR)
'
Public Enum eColorPalette
    Aqua = &HFFFF00
    Black = &H0
    Blue = &HFF0000
    Gray = &HC0C0C0
    Green = &HFF00
    Manila = &HA0FFFF
    PaleAqua = &HFFFFA0
    Red = &HFF
    White = &HFFFFFF
    Yellow = &HC0C0
End Enum
 
'
'   API declarations.
 
 
'*******************************************************************
'End user functions
'*******************************************************************
 
#End If

WindowsAPI7A

_WindowsApi7A.bas
'
'   [_WindowsAPI7A]
'
Option Compare Database
Option Explicit
#If VBA7 Then
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Shell32.DLL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As LongPtr, ByVal lpIconPath As String, lpiIcon As Long) As LongPtr
Public Declare PtrSafe Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As LongPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As LongPtr
Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
Public Declare PtrSafe Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As Any, ByVal lpDirectory As Any, ByVal nShowCmd As Long) As LongPtr
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Version.DLL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
'  Read version info into buffer
' /* Length of buffer for info *
' /* Information from GetFileVersionSize *
' /* Filename of version stamped file *
Public Declare PtrSafe Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As LongPtr, ByVal dwlen As Long, lpData As Any) As Long
Public Declare PtrSafe Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As LongPtr) As Long
'Public Declare PtrSafe Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, ByVal lplpBuffer As LongPtr, puLen As Long) As Long
Public Declare PtrSafe Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
 
'   (SJZ) 20131009:
'   Public Declare PtrSafe Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, ByVal lplpBuffer As LongPtr, puLen As Long) As Long
'
'   This is declared as shown below (private) within a module that uses it
'   due to a bug that I can't figure out right now
'
'   Private Declare Function apiVerQueryValue Lib "version.dll" Alias "VerQueryValueA" _
    (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Kernel 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
'   Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
Public Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
 
Public Declare PtrSafe Function CreateFileA Lib "kernel32" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As LongPtr    'Creates a file and returns a handle to it
 
'   Public Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare PtrSafe Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
'
'   Ordinarily this would be declared as:
'       Private Declare PtrSafe Function CreateThread Lib "kernel32" (lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As LongPtr, lpStartAddress As LongPtr, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As LongPtr
'
'   We want to live life on the edge though so we define it as this:
'
Public Declare PtrSafe Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As LongPtr, lpStartAddress As LongPtr, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As LongPtr
 
Public Declare PtrSafe Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Public Declare PtrSafe Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
 
Public Declare PtrSafe Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Public Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SystemTime) As Long
Public Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long
Public Declare PtrSafe Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPtr
Public Declare PtrSafe Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As LongPtr, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) As Long
Public Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As Long
 
Public Declare PtrSafe Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As String
Public Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare PtrSafe Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Public Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long    'Retrieves Drive Space Information
 
Public Declare PtrSafe Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare PtrSafe Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As LongPtr, lpExitCode As Long) As Long
Public Declare PtrSafe Function GetExitCodeThread Lib "kernel32" (ByVal hThread As LongPtr, lpExitCode As Long) As Long
Public Declare PtrSafe Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare PtrSafe Function GetFileTime Lib "kernel32" (ByVal hFile As LongPtr, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare PtrSafe Function FlushFileBuffers Lib "kernel32" (ByVal hFile As LongPtr) As Long
Public Declare PtrSafe Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
Public Declare PtrSafe Function GetLastError Lib "kernel32" () As Long    'Retrieves last error information
Public Declare PtrSafe Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'   Retrieves the long path associated with the specified short path
Public Declare PtrSafe Function GetLongPathNameA Lib "kernel32" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
Public Declare PtrSafe Function GetLongPathName Lib "kernel32" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
Public Declare PtrSafe Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As LongPtr, ByVal lpFileName As String, ByVal nSize As Long) As Long
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Public Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Public Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare PtrSafe Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare PtrSafe Function GetTempFilename Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
#If Win64 Then
Public Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
#End If
Public Declare PtrSafe Function getTickCount Lib "kernel32" Alias "GetTickCount" () As Long
Public Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As typTIME_ZONE_INFORMATION) As Long
Public Declare PtrSafe Function GetVersion Lib "kernel32" () As Long
Public Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare PtrSafe Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
 
'   Public Declare Function GetWinFlags Lib "kernel32" Alias "GetWinFlagsA" () As Long
Public Declare PtrSafe Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalHandle Lib "kernel32" (wMem As Any) As LongPtr
Public Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalReAlloc Lib "kernel32" (ByVal hMem As LongPtr, ByVal dwBytes As LongPtr, ByVal wFlags As Long) As LongPtr
Public Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Public Declare PtrSafe Function GlobalFlags Lib "kernel32" (ByVal hMem As LongPtr) As Long
 
Public Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As LongPtr
Public Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Public Declare PtrSafe Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As LongPtr
Public Declare PtrSafe Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As LongPtr
Public Declare PtrSafe Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As String) As LongPtr
Public Declare PtrSafe Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare PtrSafe Function lstrcmpi Lib "kernel32" Alias "lstrcmpiA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Public Declare PtrSafe Function lstrlenW Lib "kernel32" (ByVal lpString As String) As Long
 
Public Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
 
Public Declare PtrSafe Function QueryPerformanceFrequencyAny Lib "kernel32" Alias "QueryPerformanceFrequency" (lpFrequency As Any) As Long
Public Declare PtrSafe Function QueryPerformanceCounterAny Lib "kernel32" Alias "QueryPerformanceCounter" (lpPerformanceCount As Any) As Long
 
Public Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
 
Public Declare PtrSafe Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long
'   Declare PtrSafe Function SetFileTime Lib "kernel32" (ByVal hFile As LongPtr, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Public Declare PtrSafe Function SetFileTime Lib "kernel32" (ByVal hFile As LongPtr, lpCreationTime As Any, lpLastAccessTime As Any, lpLastWriteTime As Any) As Long
Public Declare PtrSafe Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Declare PtrSafe Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
Public Declare PtrSafe Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SystemTime, lpFileTime As FILETIME) As Long
Public Declare PtrSafe Function SystemTimeToTzSpecificLocalTime Lib "kernel32" (lpTimeZoneInformation As typTIME_ZONE_INFORMATION, lpUniversalTime As SystemTime, lpLocalTime As SystemTime) As Long
 
Public Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As LongPtr, ByVal dwMilliseconds As Long) As Long
Public Declare PtrSafe Function WaitForInputIdle Lib "user32" (ByVal hProcess As LongPtr, ByVal dwMilliseconds As Long) As Long
Public Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Public Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
 
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Public Declare PtrSafe Sub CopyMemoryBV Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpDestination As Any, ByVal lpSource As Any, ByVal Length As Long)
Public Declare PtrSafe Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Public Declare PtrSafe Sub GetLocalTime Lib "kernel32" (lpSystemTime As SystemTime)
Public Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpSystemTime As SystemTime)
Public Declare PtrSafe Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - User 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function AttachThreadInput Lib "user32" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
 
Public Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
 
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
 
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
 
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Public Declare PtrSafe Function FlashWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal bInvert As Long) As Long
 
Public Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Public Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'   Public Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Public Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Any) As Long
Public Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Public Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Public Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Any) As Long
Public Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Public Declare PtrSafe Function GetPriorityClipboardFormat Lib "user32" (lpPriorityList As Long, ByVal nCount As Long) As Long
Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Public Declare PtrSafe Function GetWindowPlacement Lib "user32" (ByVal hwnd As LongPtr, lpwndpl As WINDOWPLACEMENT) As Long
Public Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As LongPtr) As LongPtr
 
Public Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function IsZoomed Lib "user32" (ByVal hwnd As LongPtr) As Long
 
Public Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As LongPtr) As Long
 
Public Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
 
Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
 
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Public Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
 
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Function SetClipboardData Lib "user32" Alias "SetClipboardDataA" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Public Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function SetKeyboardState Lib "user32" (lppbKeyState As Any) As Long
Public Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Public Declare PtrSafe Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
 
Public Declare PtrSafe Function UpdateWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
 
Public Declare PtrSafe Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As LongPtr, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As LongPtr) As Long
 
#If Win64 Then
Public Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Public Declare PtrSafe Function GetClassLongPtr Lib "user32" Alias "GetClassLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#Else
Public Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Public Declare PtrSafe Function GetClassLongPtr Lib "user32" Alias "GetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Public Declare PtrSafe Function SetClassLongPtr Lib "user32" Alias "SetClassLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
#End If
 
'Help Constants
'Public Const HELP_CONTEXT = &H1         'Display topic in ulTopic
'Public Const HELP_QUIT = &H2            'Terminate help
'Public Const HELP_INDEX = &H3           'Display index
'Public Const HELP_CONTENTS = &H3
'Public Const HELP_HELPONHELP = &H4      'Display help on using help
'Public Const HELP_SETINDEX = &H5        'Set the current Index for multi index help
'Public Const HELP_SETCONTENTS = &H5
'Public Const HELP_CONTXTPOPUP = &H8
'Public Const HELP_FORCEFILE = &H9
'Public Const HELP_KEY = &H101           'Display topic for keyword
'Public Const HELP_COMMAND = &H102
'Public Const HELP_PARTIALKEY = &H105    'call the search engine in winhelp
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Types / Structures
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' Only GDI+1.1:
'
 
Public Type BlurParameters
    Radius                          As Single
    ExpandEdges                     As Long
End Type
 
Public Type FILETIME
    dwLowDate                       As Long
    dwHighDate                      As Long
End Type
 
Public Type GDIPStartupInput
    GdiplusVersion                  As Long
    DebugEventCallback              As Long
    SuppressBackgroundThread        As Long
    SuppressExternalCodecs          As Long
End Type
 
Public Type HOSTENT
    hName                           As Long
    hAliases                        As Long
    hAddrType                       As Integer
    hLen                            As Integer
    hAddrList                       As Long
End Type
 
'
'   This structure describes the options that will be included in the
'header of an IP packet.
'   http://msdn.microsoft.com/library/default.asp?url=/library/
'en-us/wcetcpip/htm/cerefIP_OPTION_INFORMATION.asp
'
 
Public Type IP_OPTION_INFORMATION
    Ttl                             As Byte
    Tos                             As Byte
    Flags                           As Byte
    OptionsSize                     As Byte
    OptionsData                     As Long
End Type
 
'
'   This structure describes the data that is returned in response to an echo request.
'   http://msdn.microsoft.com/library/default.asp?url=/library/
'en-us/wcesdkr/htm/_wcesdk_icmp_echo_reply.asp
'
 
Public Type ICMP_ECHO_REPLY
    Address                         As Long
    Status                          As Long
    RoundTripTime                   As Long
    DataSize                        As Long
    Reserved                        As Integer
    ptrData                         As Long
    Options                         As IP_OPTION_INFORMATION
    Data                            As String * 250
End Type
 
Public Type ICMP_OPTIONS
    Ttl                             As Byte
    Tos                             As Byte
    Flags                           As Byte
    OptionsSize                     As Byte
    OptionsData                     As Long
End Type
 
Public Type INTERNET_CONNECTED_INFO
    dwConnectedState                As Long
    dwFlags                         As Long
End Type
 
Public Type MEMORYSTATUS
    dwLength                        As Long
    dwMemoryLoad                    As Long
    dwTotalPhys                     As Long
    dwAvailPhys                     As Long
    dwTotalPageFile                 As Long
    dwAvailPageFile                 As Long
    dwTotalVirtual                  As Long
    dwAvailVirtual                  As Long
End Type
 
Public Type POINTAPI
    x                               As Long
    y                               As Long
End Type
 
Public Type POINTL
    x                               As Long
    y                               As Long
End Type
 
Public Type PROCESS_INFORMATION
    hProcess                        As LongPtr
    hThread                         As LongPtr
    dwProcessId                     As Long
    dwThreadID                      As Long
End Type
 
Public Type RECT
    Left                            As Long
    Top                             As Long
    Right                           As Long
    Bottom                          As Long
End Type
 
Public Type STARTUPINFO
    Cb                              As Long
    lpReserved                      As String
    lpDesktop                       As String
    lpTitle                         As String
    dwX                             As Long
    dwY                             As Long
    dwXSize                         As Long
    dwYSize                         As Long
    dwXCountChars                   As Long
    dwYCountChars                   As Long
    dwFillAttribute                 As Long
    dwFlags                         As Long
    wShowWindow                     As Integer
    cbReserved2                     As Integer
    lpReserved2                     As LongPtr
    hStdInput                       As LongPtr
    hStdOutput                      As LongPtr
    hStdError                       As LongPtr
End Type
 
Public Type WINDOWPLACEMENT
    Length                          As Long
    Flags                           As Long
    showCmd                         As Long
    ptMinPosition                   As POINTAPI
    ptMaxPosition                   As POINTAPI
    rcNormalPosition                As RECT
End Type
 
Public Type SYSHEAPINFO
    dwSize                          As Long
    wUserFreePercent                As Integer
    wGDIFreePercent                 As Integer
    hUserSegment                    As Integer
    hGDISegment                     As Integer
End Type
 
Public Type OSVERSIONINFO
    dwOSVersionInfoSize             As Long
    dwMajorVersion                  As Long
    dwMinorVersion                  As Long
    dwBuildNumber                   As Long
    dwPlatformId                    As Long
    szCSDVersion                    As String * 128    '  Maintenance string for PSS usage
End Type
 
Public Type OSVERSIONINFOEX
    dwOSVersionInfoSize             As Long
    dwMajorVersion                  As Long
    dwMinorVersion                  As Long
    dwBuildNumber                   As Long
    dwPlatformId                    As Long
    szCSDVersion                    As String * 128    '  Maintenance string for PSS usage
    wServicePackMajor               As Integer
    wServicePackMinor               As Integer
    wSuiteMask                      As Integer
    wProductType                    As Byte
    wReserved                       As Byte
End Type
 
Public Type PICTDESC
    cbSizeOfStruct                  As Long
    PicType                         As Long
    hImage                          As Long
    xExt                            As Long
    yExt                            As Long
End Type
 
 
'Only GDI+1.1:
 
Public Type SharpenParameters
    Radius                          As Single
    Amount                          As Single
End Type
 
Public Type TSize
    x                               As Double
    y                               As Double
End Type
 
Public Type SECURITY_ATTRIBUTES
    nLength                         As Long
    lpSecurityDescriptor            As LongPtr
    bInheritHandle                  As Long
End Type
 
'
'   Structure contains version information about a file.
'       (This information is language and code page independent.)
 
Public Type VS_FIXEDFILEINFO
    dwSignature                     As Long    'Contains the value 0xFEEFO4BD (szKey)
    dwStrucVersion                  As Long    'Specifies the binary version number of this structure.
    dwFileVersionMS                 As Long    'most significant 32 bits of the file's binary version number.
    dwFileVersionLS                 As Long    'least significant 32 bits of the file's binary version number.
    dwProductVersionLS              As Long    'most sig. 32 bits of binary version of product this file was distributed with.
    dwFileFlagsMask                 As Long    'least sig. 32 bits of binary version of product this file was distributed with.
    dwProductVersionMS              As Long    'Contains a bitmask that specifies the valid bits in dwFileFlags.
    dwFileFlags                     As Long    'Contains a bitmask that specifies the Boolean attributes of the file.
    dwFileOS                        As Long    'operating system for which this file was designed.
    dwFileType                      As Long    'general type of file.
    dwFileSubtype                   As Long    'function of the file.
    dwFileDateMS                    As Long    'most sig. 32 bits of the file's 64-bit binary creation date and time stamp.
    dwFileDateLS                    As Long    'least sig. 32 bits of the file's 64-bit binary creation date and time stamp.
End Type
 
 
Public Type typUUID                    'GUID
    Data1                           As Long
    Data2                           As Integer
    Data3                           As Integer
    Data4(7)                        As Byte
End Type
 
' Note that although Variants now have
' a VT_GUID type, this type is unsupported in VBA,
' so we must define our own here that will have the same
' binary layout as all GUIDs are expected by COM to
' have.
'
 
Public Type GUID
    Data1                           As Long
    Data2                           As Integer
    Data3                           As Integer
    Data4(7)                        As Byte    ' 0 to 7 (8 Bytes)
End Type
 
Public Type EncoderParameter
    UUID                            As GUID
    NumberOfValues                  As Long
 
Type                            As Long
    Value                           As Long
End Type
 
Public Type EncoderParameters
    Count                           As Long
    Parameter                       As EncoderParameter
End Type
 
 
Public Type WSADATA
    wVersion                        As Integer
    wHighVersion                    As Integer
    szDescription(0 To MAX_WSADescription) As Byte
    szSystemStatus(0 To MAX_WSASYSStatus) As Byte
    wMaxSockets                     As Integer
    wMaxUDPDG                       As Integer
    dwVendorInfo                    As Long
End Type
 
Public Type SystemTime
    wYear                           As Integer
    wMonth                          As Integer
    wDayOfWeek                      As Integer
    wDay                            As Integer
    wHour                           As Integer
    wMinute                         As Integer
    wSecond                         As Integer
    wMilliseconds                   As Integer
End Type
 
Public Type TIME_ZONE_INFORMATION
    bias                            As Long
    StandardName(0 To 31)           As Integer
    StandardDate                    As SystemTime
    StandardBias                    As Long
    DaylightName(0 To 31)           As Integer
    DaylightDate                    As SystemTime
    DaylightBias                    As Long
End Type
 
Public Type typTIME_ZONE_INFORMATION
    bias                            As Long
    StandardName(0 To 63)           As Byte
    StandardDate                    As SystemTime
    StandardBias                    As Long
    DaylightName(0 To 63)           As Byte
    DaylightDate                    As SystemTime
    DaylightBias                    As Long
End Type
 
Public Type WIN32_FIND_DATA
    dwFileAttributes                As Long
    ftCreationTime                  As FILETIME
    ftLastAccessTime                As FILETIME
    ftLastWriteTime                 As FILETIME
    nFileSizeHigh                   As Long
    nFileSizeLow                    As Long
    dwReserved0                     As Long
    dwReserved1                     As Long
    cFileName(0 To MAX_PATH - 1)    As Byte
    cAlternate(0 To 13)             As Byte
End Type
 
Public Enum ERegistryClassConstants
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum
 
'//////////////////////////////////////////////////////////////////////
'                                                                     //
'                Registry API Constants                                //
'                                                                     //
' //////////////////////////////////////////////////////////////////////
 
' Reg Create Type Values...
Public Const REG_OPTION_RESERVED = 0        ' Parameter is reserved
Public Const REG_OPTION_NON_VOLATILE = 0    ' Key is preserved when system is rebooted
Public Const REG_OPTION_VOLATILE = 1        ' Key is not preserved when system is rebooted
Public Const REG_OPTION_CREATE_LINK = 2     ' Created key is a symbolic link
Public Const REG_OPTION_BACKUP_RESTORE = 4  ' open for backup or restore
 
' Reg Data Types...
Public Const REG_NONE = 0                   ' No value type
Public Const REG_INVALID            As Long = -1&
Public Const REG_SZ = 1                     ' Unicode nul terminated string
Public Const REG_EXPAND_SZ = 2              ' Unicode nul terminated string
Public Const REG_BINARY = 3                 ' Free form binary
Public Const REG_DWORD = 4                  ' 32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = 4    ' 32-bit number (same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN = 5       ' 32-bit number
Public Const REG_LINK = 6                   ' Symbolic Link (unicode)
Public Const REG_MULTI_SZ = 7               ' Multiple Unicode strings
Public Const REG_RESOURCE_LIST = 8          ' Resource list in the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9    ' Resource list in the hardware description
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Public Const REG_CREATED_NEW_KEY = &H1      ' New Registry Key created
Public Const REG_OPENED_EXISTING_KEY = &H2  ' Existing Key opened
Public Const REG_WHOLE_HIVE_VOLATILE = &H1  ' Restore whole hive volatile
Public Const REG_REFRESH_HIVE = &H2         ' Unwind changes to last flush
Public Const REG_NOTIFY_CHANGE_NAME = &H1   ' Create or delete (child)
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4    ' Time stamp
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8
Public Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Public Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
 
#If True Then                               '   Protect Enums from case changes in the IDE
Public Enum ERegistryValueTypes
    'Predefined Value Types
    eREG_NONE = REG_NONE                    'No value type
    eReg_SZ = REG_SZ                        'Unicode nul terminated string
    eREG_EXPAND_SZ = REG_EXPAND_SZ          'Unicode nul terminated string w/enviornment var
    eREG_BINARY = REG_BINARY                'Free form binary
    eREG_DWORD = REG_DWORD                  '32-bit number
    eREG_DWORD_LITTLE_ENDIAN = REG_DWORD_LITTLE_ENDIAN  '32-bit number (same as REG_DWORD)
    eREG_DWORD_BIG_ENDIAN = REG_DWORD_BIG_ENDIAN        '32-bit number
    eREG_LINK = REG_LINK                    'Symbolic Link (unicode)
    eREG_MULTI_SZ = REG_MULTI_SZ            'Multiple Unicode strings
    eREG_RESOURCE_LIST = REG_RESOURCE_LIST  'Resource list in the resource map
    eREG_FULL_RESOURCE_DESCRIPTOR = REG_FULL_RESOURCE_DESCRIPTOR    'Resource list in the hardware description
    eREG_RESOURCE_REQUIREMENTS_LIST = REG_RESOURCE_REQUIREMENTS_LIST
    eREG_INVALID = REG_INVALID
End Enum
#End If
 
Public Type ACL
    AclRevision                     As Byte
    Sbz1                            As Byte
    AclSize                         As Integer
    AceCount                        As Integer
    Sbz2                            As Integer
End Type
 
' typedef ACL *PACL;
 
'  end_ntddk
 
'   The structure of an ACE is a common ace header followed by ace type
'   specific data.  Pictorally the structure of the common ace header is
'   as follows:
 
'   AceType denotes the type of the ace, there are some predefined ace
'   types
'
'   AceSize is the size, in bytes, of ace.
'
'   AceFlags are the Ace flags for audit and inheritance, defined Integerly.
 
Public Type ACE_HEADER
    AceType                         As Byte
    AceFlags                        As Byte
    AceSize                         As Integer
End Type
 
 
 
'
'   We'll define the structure of the predefined ACE types.  Pictorally
'   the structure of the predefined ACE's is as follows:
 
'   Mask is the access mask associated with the ACE.  This is either the
'   access allowed, access denied, audit, or alarm mask.
'
'   Sid is the Sid associated with the ACE.
'
'   The following are the four predefined ACE types.
'   Examine the AceType field in the Header to determine
'   which structure is appropriate to use for casting.
 
 
Public Type ACCESS_ALLOWED_ACE
    Header                          As ACE_HEADER
    mask                            As Long
    SidStart                        As Long
End Type
 
Public Type ACCESS_DENIED_ACE
    Header                          As ACE_HEADER
    mask                            As Long
    SidStart                        As Long
End Type
 
 
Public Type SYSTEM_AUDIT_ACE
    Header                          As ACE_HEADER
    mask                            As Long
    SidStart                        As Long
End Type
 
Public Type SYSTEM_ALARM_ACE
    Header                          As ACE_HEADER
    mask                            As Long
    SidStart                        As Long
End Type
 
'   The following declarations are used for setting and querying information
'   about and ACL.  First are the various information classes available to
'   the user.
'
 
Public Const AclRevisionInformation = 1
Public Const AclSizeInformation = 2
'
'   This record is returned/sent if the user is requesting/setting the
'   AclRevisionInformation
'
 
Public Type ACL_REVISION_INFORMATION
    AclRevision                     As Long
End Type
 
'
'   This record is returned if the user is requesting AclSizeInformation
'
 
Public Type ACL_SIZE_INFORMATION
    AceCount                        As Long
    AclBytesInUse                   As Long
    AclBytesFree                    As Long
End Type
' // Begin SHGetFileInfo
 
'  * The SHGetFileInfo API provides an easy way to get attributes
'  * for a file given a pathname.
'  *
'  *   PARAMETERS
'  *
'  *     pszPath              file name to get info about
'  *     dwFileAttributes     file attribs, only used with SHGFI_USEFILEATTRIBUTES
'  *     psfi                 place to return file info
'  *     cbFileInfo           size of structure
'  *     uFlags               flags
'  *
'  *   RETURN
'  *     TRUE if things worked
'  */
 
Public Type SHFILEINFO
    hIcon                           As LongPtr    '  out: icon
    iIcon                           As Long    '  out: icon index
    dwAttributes                    As Long    '  out: SFGAO_ flags
    szDisplayName(0 To MAX_PATH - 1) As Byte    '  out: display name (or path)
    szTypeName(0 To 79)             As Byte    '  out: type name
End Type
Public Type SHFILEOPSTRUCT
    hwnd                            As LongPtr
    wFunc                           As Long
    pFrom                           As String
    pTo                             As String
    fFlags                          As Integer
    fAnyOperationsAborted           As Long
    hNameMappings                   As LongPtr
    lpszProgressTitle               As String    '  only used if FOF_SIMPLEPROGRESS
End Type
 
' //////////////////////////////////////////////////////////////////////
'                                                                     //
'                              SECURITY_DESCRIPTOR                    //
'                                                                     //
' //////////////////////////////////////////////////////////////////////
'
'   Define the Security Descriptor and related data types.
'   This is an opaque data structure.
'
 
'  begin_ntddk begin_ntifs
'
'  Current security descriptor revision value
'
 
Public Const SECURITY_DESCRIPTOR_REVISION = (1)
Public Const SECURITY_DESCRIPTOR_REVISION1 = (1)
 
'  end_ntddk
 
'
'  Minimum length, in bytes, needed to build a security descriptor
'  (NOTE: This must manually be kept consistent with the)
'  (sizeof(SECURITY_DESCRIPTOR)                         )
'
 
Public Const SECURITY_DESCRIPTOR_MIN_LENGTH = (20)
 
 
 
Public Const SE_OWNER_DEFAULTED = &H1
Public Const SE_GROUP_DEFAULTED = &H2
Public Const SE_DACL_PRESENT = &H4
Public Const SE_DACL_DEFAULTED = &H8
Public Const SE_SACL_PRESENT = &H10
Public Const SE_SACL_DEFAULTED = &H20
Public Const SE_SELF_RELATIVE = &H8000
 
'
'   Where:
'
'       SE_OWNER_DEFAULTED - This boolean flag, when set, indicates that the
'           SID pointed to by the Owner field was provided by a
'           defaulting mechanism rather than explicitly provided by the
'           original provider of the security descriptor.  This may
'           affect the treatment of the SID with respect to inheritence
'           of an owner.
'
'       SE_GROUP_DEFAULTED - This boolean flag, when set, indicates that the
'           SID in the Group field was provided by a defaulting mechanism
'           rather than explicitly provided by the original provider of
'           the security descriptor.  This may affect the treatment of
'           the SID with respect to inheritence of a primary group.
'
'       SE_DACL_PRESENT - This boolean flag, when set, indicates that the
'           security descriptor contains a discretionary ACL.  If this
'           flag is set and the Dacl field of the SECURITY_DESCRIPTOR is
'           null, then a null ACL is explicitly being specified.
'
'       SE_DACL_DEFAULTED - This boolean flag, when set, indicates that the
'           ACL pointed to by the Dacl field was provided by a defaulting
'           mechanism rather than explicitly provided by the original
'           provider of the security descriptor.  This may affect the
'           treatment of the ACL with respect to inheritence of an ACL.
'           This flag is ignored if the DaclPresent flag is not set.
'
'       SE_SACL_PRESENT - This boolean flag, when set,  indicates that the
'           security descriptor contains a system ACL pointed to by the
'           Sacl field.  If this flag is set and the Sacl field of the
'           SECURITY_DESCRIPTOR is null, then an empty (but present)
'           ACL is being specified.
'
'       SE_SACL_DEFAULTED - This boolean flag, when set, indicates that the
'           ACL pointed to by the Sacl field was provided by a defaulting
'           mechanism rather than explicitly provided by the original
'           provider of the security descriptor.  This may affect the
'           treatment of the ACL with respect to inheritence of an ACL.
'           This flag is ignored if the SaclPresent flag is not set.
'
'       SE_SELF_RELATIVE - This boolean flag, when set, indicates that the
'           security descriptor is in self-relative form.  In this form,
'           all fields of the security descriptor are contiguous in memory
'           and all pointer fields are expressed as offsets from the
'           beginning of the security descriptor.  This form is useful
'           for treating security descriptors as opaque data structures
'           for transmission in communication protocol or for storage on
'           secondary media.
'
'
'
'  In general, this data structure should be treated opaquely to ensure future
'  compatibility.
'
'
 
Public Type SECURITY_DESCRIPTOR
    Revision                        As Byte
    Sbz1                            As Byte
    Control                         As Integer
    Owner                           As LongPtr
    Group                           As LongPtr
    Sacl                            As ACL
    Dacl                            As ACL
End Type
 
 
'  Where:
'
'      Revision - Contains the revision level of the security
'          descriptor.  This allows this structure to be passed between
'          systems or stored on disk even though it is expected to
'          change in the future.
'
'      Control - A set of flags which qualify the meaning of the
'          security descriptor or individual fields of the security
'          descriptor.
'
'      Owner - is a pointer to an SID representing an object's owner.
'          If this field is null, then no owner SID is present in the
'          security descriptor.  If the security descriptor is in
'          self-relative form, then this field contains an offset to
'          the SID, rather than a pointer.
'
'      Group - is a pointer to an SID representing an object's primary
'          group.  If this field is null, then no primary group SID is
'          present in the security descriptor.  If the security descriptor
'          is in self-relative form, then this field contains an offset to
'          the SID, rather than a pointer.
'
'      Sacl - is a pointer to a system ACL.  This field value is only
'          valid if the DaclPresent control flag is set.  If the
'          SaclPresent flag is set and this field is null, then a null
'          ACL  is specified.  If the security descriptor is in
'          self-relative form, then this field contains an offset to
'          the ACL, rather than a pointer.
'
'      Dacl - is a pointer to a discretionary ACL.  This field value is
'          only valid if the DaclPresent control flag is set.  If the
'          DaclPresent flag is set and this field is null, then a null
'          ACL (unconditionally granting access) is specified.  If the
'          security descriptor is in self-relative form, then this field
'          contains an offset to the ACL, rather than a pointer.
'
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Enumerations
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
#If True Then                          '   Protect Enums from case changes in the IDE
Public Enum EShellShowConstants
    essSW_Hide = 0
    essSW_MAXIMIZE = 3
    essSW_MINIMIZE = 6
    essSW_SHOWMAXIMIZED = 3
    essSW_SHOWMINIMIZED = 2
    essSW_SHOWNORMAL = 1
    essSW_SHOWNOACTIVATE = 4
    essSW_SHOWNA = 8
    essSW_SHOWMINNOACTIVE = 7
    essSW_SHOWDEFAULT = 10
    essSW_RESTORE = 9
    essSW_SHOW = 5
End Enum
 
Public Enum ShellAndWaitResult
    Success = 0
    Failure = 1
    TimeOut = 2
    InvalidParameter = 3
    SysWaitAbandoned = 4
    UserWaitAbandoned = 5
    UserBreak = 6
End Enum
 
Public Enum ActionOnBreak
    IgnoreBreak = 0
    AbandonWait = 1
    PromptUser = 2
End Enum
 
Public Enum PicFileType
    pictypeBMP = 1
    pictypeGIF = 2
    pictypePNG = 3
    pictypeJPG = 4
End Enum
 
'
'   RGB Color Constants RGB(R,G,B) = Long(&HBBGGRR)
'
Public Enum eColorPalette
    Aqua = &HFFFF00
    Black = &H0
    Blue = &HFF0000
    Gray = &HC0C0C0
    Green = &HFF00
    Manila = &HA0FFFF
    PaleAqua = &HFFFFA0
    Red = &HFF
    White = &HFFFFFF
    Yellow = &HC0C0
End Enum
#End If
'
'   API declarations.
 
 
'*******************************************************************
'End user functions
'*******************************************************************
#Else
'   Use _WindowsAPI
#End If

WindowsAPI7B

_WindowsApi7B.bas
'
'   [_WindowsAPI7B]
'
Option Compare Database
Option Explicit
#If VBA7 Then
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - AdvAPI 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare PtrSafe Function GetUserNameW Lib "advapi32.dll" (lpBuffer As Byte, nSize As Long) As Long
Public Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Public Declare PtrSafe Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As LongPtr, phkResult As LongPtr) As Long
Public Declare PtrSafe Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As Long
Public Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As LongPtr, lpdwDisposition As Long) As Long
Public Declare PtrSafe Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String) As Long
Public Declare PtrSafe Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As LongPtr, ByVal lpValueName As String) As Long
Public Declare PtrSafe Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare PtrSafe Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As LongPtr, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare PtrSafe Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare PtrSafe Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As Long, lpData As Long, lpcbData As Long) As Long
Public Declare PtrSafe Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
Public Declare PtrSafe Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Public Declare PtrSafe Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Public Declare PtrSafe Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Public Declare PtrSafe Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
 
'   From API Documentation:
'      Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, lpType As Long, lpData As Byte, lpcbData As Long) As Long
'   Corrected below:
Public Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, ByVal lpType As Long, ByVal lpData As Long, ByVal lpcbData As Long) As Long
'
'   Calls from above are made TypeSafe within the registry class
'
Public Declare PtrSafe Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
Public Declare PtrSafe Function RegGetKeySecurity Lib "advapi32.dll" (ByVal hKey As LongPtr, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR, lpcbSecurityDescriptor As Long) As Long
Public Declare PtrSafe Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal lpFile As String) As Long
Public Declare PtrSafe Function RegNotifyChangeKeyValue Lib "advapi32.dll" (ByVal hKey As LongPtr, ByVal bWatchSubtree As Long, ByVal dwNotifyFilter As Long, ByVal hEvent As LongPtr, ByVal fAsynchronus As Long) As Long
Public Declare PtrSafe Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, phkResult As LongPtr) As Long
Public Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
Public Declare PtrSafe Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As LongPtr, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As LongPtr, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Public Declare PtrSafe Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Public Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, lpType As Long, lpData As Any, lpcbData As Long) As Long    ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare PtrSafe Function RegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long
Public Declare PtrSafe Function RegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As LongPtr, ByVal lpFile As String, ByVal dwFlags As Long) As Long
Public Declare PtrSafe Function RegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As LongPtr, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare PtrSafe Function RegSetKeySecurity Lib "advapi32.dll" (ByVal hKey As LongPtr, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
Public Declare PtrSafe Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long    ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare PtrSafe Function RegUnLoadKey Lib "advapi32.dll" Alias "RegUnLoadKeyA" (ByVal hKey As LongPtr, ByVal lpSubKey As String) As Long
Public Declare PtrSafe Function InitiateSystemShutdown Lib "advapi32.dll" Alias "InitiateSystemShutdownA" (ByVal lpMachineName As String, ByVal lpMessage As String, ByVal dwTimeout As Long, ByVal bForceAppsClosed As Long, ByVal bRebootAfterShutdown As Long) As Long
Public Declare PtrSafe Function AbortSystemShutdown Lib "advapi32.dll" Alias "AbortSystemShutdownA" (ByVal lpMachineName As String) As Long
 
Public Declare PtrSafe Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (ByVal lpSystemName As String, ByVal lpAccountName As String, ByVal Sid As LongPtr, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Integer) As Long
Public Declare PtrSafe Function InitializeSecurityDescriptor Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal dwRevision As Long) As Long
Public Declare PtrSafe Function GetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, lpbDaclPresent As Long, pDacl As ACL, lpbDaclDefaulted As Long) As Long
Public Declare PtrSafe Function GetFileSecurityN Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, ByVal pSecurityDescriptor As Long, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Public Declare PtrSafe Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Public Declare PtrSafe Function GetAclInformation Lib "advapi32.dll" (pAcl As ACL, pAclInformation As Any, ByVal nAclInformationLength As Long, ByVal dwAclInformationClass As Integer) As Long
Public Declare PtrSafe Function EqualSid Lib "advapi32.dll" (pSid1 As Any, pSid2 As Any) As Long
Public Declare PtrSafe Function GetLengthSid Lib "advapi32.dll" (pSid As Any) As Long
Public Declare PtrSafe Function InitializeAcl Lib "advapi32.dll" (pAcl As ACL, ByVal nAclLength As Long, ByVal dwAclRevision As Long) As Long
Public Declare PtrSafe Function GetAce Lib "advapi32.dll" (pAcl As ACL, ByVal dwAceIndex As Long, pAce As Any) As Long
Public Declare PtrSafe Function AddAce Lib "advapi32.dll" (pAcl As ACL, ByVal dwAceRevision As Long, ByVal dwStartingAceIndex As Long, pAceList As Any, ByVal nAceListLength As Long) As Long
Public Declare PtrSafe Function AddAccessAllowedAce Lib "advapi32.dll" (pAcl As ACL, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Any) As Long
Public Declare PtrSafe Function AddAccessDeniedAce Lib "advapi32.dll" (pAcl As Byte, ByVal dwAceRevision As Long, ByVal AccessMask As Long, pSid As Byte) As Long
Public Declare PtrSafe Function SetSecurityDescriptorDacl Lib "advapi32.dll" (pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal bDaclPresent As Long, pDacl As ACL, ByVal bDaclDefaulted As Long) As Long
Public Declare PtrSafe Function SetFileSecurity Lib "advapi32.dll" Alias "SetFileSecurityA" (ByVal lpFileName As String, ByVal SecurityInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long
 
 
 
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Toolhelp.dll
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function SystemHeapInfo Lib "ToolHelp.dll" (shi As SYSHEAPINFO) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Ole Accessibility / Automation / Programmability
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByRef riid As typUUID, ByRef ppvObject As Object) As LongPtr
' Public Declare Function LoadTypeLibEx Lib "oleaut32.dll" (ByVal szFile As Long, ByVal regkind As Long, pptlib As ITypeLib) As Long
Public Declare PtrSafe Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PICTDESC, riid As GUID, ByVal fPictureOwnsHandle As LongPtr, ipic As IPicture) As LongPtr
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - msvbvm60
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As LongPtr
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - GDI 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As LongPtr
Public Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Public Declare PtrSafe Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As LongPtr
Public Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
Public Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Public Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function PatBlt Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Public Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - GDI+
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
'   This requires a lot of work - stopped at GdipCreateBitmapFromHICON
'
Public Declare PtrSafe Function GdipBitmapApplyEffect Lib "gdiplus.dll" (ByVal Image As Long, ByVal Effect As Long, ByVal roi As Long, ByVal useAuxData As Long, ByVal auxData As Long, ByVal auxDataSize As Long) As Long
Public Declare PtrSafe Function GdipCreateBitmapFromFile Lib "gdiplus.dll" (ByVal Filename As LongPtr, bitmap As LongPtr) As LongPtr
Public Declare PtrSafe Function GdipCreateBitmapFromHBITMAP Lib "gdiplus.dll" (ByVal hbm As LongPtr, ByVal hPal As LongPtr, bitmap As LongPtr) As LongPtr
Public Declare PtrSafe Function GdipCreateBitmapFromHICON Lib "gdiplus" (ByVal hIcon As LongPtr, bitmap As LongPtr) As LongPtr
Public Declare PtrSafe Function GdipCreateEffect Lib "gdiplus.dll" (ByVal cid1 As LongPtr, ByVal cid2 As LongPtr, ByVal cid3 As LongPtr, ByVal cid4 As LongPtr, Effect As Long) As LongPtr
Public Declare PtrSafe Function GdipCreateFromHDC Lib "gdiplus.dll" (ByVal hdc As LongPtr, GpGraphics As Long) As LongPtr
Public Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "gdiplus.dll" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As Long
Public Declare PtrSafe Function GdipCreateHICONFromBitmap Lib "gdiplus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr) As Long
Public Declare PtrSafe Function GdipDeleteEffect Lib "gdiplus.dll" (ByVal Effect As Long) As Long
Public Declare PtrSafe Function GdipDeleteGraphics Lib "gdiplus.dll" (ByVal graphics As Long) As Long
Public Declare PtrSafe Function GdipDisposeImage Lib "gdiplus.dll" (ByVal Image As Long) As Long
Public Declare PtrSafe Function GdipDrawImageRect Lib "gdiplus.dll" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
Public Declare PtrSafe Function GdipGetImageHeight Lib "gdiplus.dll" (ByVal Image As LongPtr, Height As Long) As Long
Public Declare PtrSafe Function GdipGetImageThumbnail Lib "gdiplus.dll" (ByVal Image As LongPtr, ByVal thumbWidth As Long, ByVal thumbHeight As Long, thumbImage As LongPtr, Optional ByVal callback As LongPtr = 0, Optional ByVal callbackData As LongPtr = 0) As LongPtr
Public Declare Function GdipGetImageWidth Lib "gdiplus.dll" (ByVal Image As Long, Width As Long) As Long
Public Declare Function GdipLoadImageFromStream Lib "gdiplus.dll" (ByVal stream As IUnknown, Image As Long) As Long
Public Declare Function GdipSaveImageToFile Lib "gdiplus.dll" (ByVal Image As Long, ByVal Filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function GdipSaveImageToStream Lib "gdiplus.dll" (ByVal Image As Long, ByVal stream As IUnknown, clsidEncoder As GUID, encoderParams As Any) As Long
Public Declare Function GdipSetEffectParameters Lib "gdiplus.dll" (ByVal Effect As Long, Params As Any, ByVal Size As Long) As Long
Public Declare Function GdiplusShutdown Lib "gdiplus.dll" (ByVal token As Long) As Long
Public Declare Function GdiplusStartup Lib "gdiplus.dll" (token As Long, inputbuf As GDIPStartupInput, Optional ByVal outputbuf As Long = 0) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - WinSock 32
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function gethostbyaddr Lib "ws2_32.dll" (addr As LongPtr, ByVal addrLen As LongPtr, ByVal addrType As Long) As Long
Public Declare PtrSafe Function gethostname Lib "ws2_32.dll" (ByVal szHost As String, ByVal dwHostLen As Long) As Long
Public Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Public Declare PtrSafe Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" (ByVal hInternet As LongPtr, ByVal dwOption As Long, lpBuffer As INTERNET_CONNECTED_INFO, lpdwBufferLength As Long) As Boolean
Public Declare PtrSafe Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" (ByVal hInternet As LongPtr, ByVal dwOption As Long, ByRef lpBuffer As Any, ByVal dwBufferLength As Long) As Long
Public Declare PtrSafe Function gethostbyname Lib "ws2_32.dll" (ByVal szHost As String) As Long
Public Declare PtrSafe Function WSACleanup Lib "ws2_32.dll" () As Long
Public Declare PtrSafe Function WSAGetLastError Lib "ws2_32.dll" () As Long
Public Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
 
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - ICMP
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
'Close an Internet Control Message Protocol (ICMP) handle that IcmpCreateFile opens.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpclosehandle.asp
Public Declare Function IcmpCloseHandle Lib "ICMP" (ByVal IcmpHandle As Long) As Long
'Create a handle on which Internet Control Message Protocol (ICMP) requests can be issued.
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_icmpcreatefile.asp
Public Declare Function IcmpCreateFile Lib "ICMP" () As Long
Public Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - OLE32.DLL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
' Some useful functions for GUID work, borrowed from COM
'
' NOTE: StringFromGUID2 is identical in what it does to the other ole32.dll
' functions StringFromIID and StringFromCLSID. Therefore, they are not
' defined here
 
Public Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal lpszProgID As Long, pclsid As GUID) As Long
Public Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Any, pclsid As GUID) As Long
Public Declare Function CoCreateGuid Lib "ole32.dll" (rclsid As GUID) As Long
Public Declare Function CoCreateInstance Lib "ole32.dll" (rclsid As GUID, pUnkOuter As Any, ByVal dwClsContext As Long, riid As GUID, ppvObj As IUnknown) As Long
Public Declare Function CoInitialize Lib "ole32.dll" () As Long
Public Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any) As Long
Public Declare Function GetHGlobalFromStream Lib "ole32.dll" (ByVal pstm As Any, ByRef phglobal As Long) As Long
Public Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef lpiid As typUUID) As Long
Public Declare Function IsEqualGUID Lib "ole32.dll" (rguid1 As GUID, rguid2 As GUID) As Long
Public Declare Function StringFromGUID2 Lib "ole32.dll" (rclsid As GUID, ByVal lpsz As Long, ByVal cbMax As Long) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - psapi.dll
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function GetProcessImageFileName Lib "psapi.dll" Alias "GetProcessImageFileNameA" _
       (ByVal hProcess As LongPtr, _
        ByVal lpImageFileName As String, _
        ByVal nSize As Long) As Long
 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'   Imports - Shell32.dll
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
Public Declare PtrSafe Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As LongPtr
Public Declare PtrSafe Function SHGetNewLinkInfo Lib "shell32.dll" Alias "SHGetNewLinkInfoA" (ByVal pszLinkto As String, ByVal pszDir As String, ByVal pszName As String, pfMustCopy As Long, ByVal uFlags As Long) As Long
Public Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Declare PtrSafe Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As LongPtr, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long    'Gets the path of the specified system folder
Public Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Long    'Resolves the value returned by SHGetSpecialFolderLocation into a valid path
 
'Get Special Folder
 
Public Type SHITEMID
 
    Cb                              As Long
    abID                            As Byte
 
End Type
 
Public Type ITEMIDLIST
 
    mkid                            As SHITEMID
 
End Type
 
 
Public Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As LongPtr
 
 
#End If
vba/windows_apis.txt · Last modified: 2022/02/21 09:29 by site_admin