From 5c018d0e569ecbc5693ec675fdfbe4a2cf85c7bf Mon Sep 17 00:00:00 2001 From: Sancarn Date: Thu, 22 Feb 2024 20:03:36 +0000 Subject: [PATCH] WIP file header changes and deletions --- src/WIP/JSONLogic.cls | 10 + src/WIP/Pointers/stdPointer v2.cls | 10 + src/WIP/Pointers/stdPointer.cls | 10 + src/WIP/ideas/cUniversalDLLCalls.cls | 408 ------------------ src/WIP/stdCrypto/stdCrypt.cls | 12 +- .../stdDLL/inspiration/cUniversalDLLCalls.cls | 2 +- src/WIP/{ideas => stdDLL}/stdDll.md | 0 .../FibonacciIteratorExample.cls | 10 + .../STD_Types_IniVariantEnum.bas | 2 + src/WIP/stdGithub.cls | 10 + src/WIP/stdHTTP/SS/stdHTTP.cls | 143 ------ src/WIP/stdHTTP/SS/stdHTTPWebsocket.cls | 1 - src/WIP/stdIni.cls | 1 + src/WIP/stdMath.cls | 10 + src/WIP/stdObject/stdObject.cls | 2 +- src/WIP/stdOpenCL/stdOpenCL.cls | 10 + src/WIP/stdRibbon.cls | 11 +- src/WIP/stdUIAutomationElement.cls | 252 +++++++++++ src/WIP/stdWordLibraries/stdWordDocument.cls | 10 +- 19 files changed, 357 insertions(+), 557 deletions(-) delete mode 100644 src/WIP/ideas/cUniversalDLLCalls.cls rename src/WIP/{ideas => stdDLL}/stdDll.md (100%) delete mode 100644 src/WIP/stdHTTP/SS/stdHTTP.cls delete mode 100644 src/WIP/stdHTTP/SS/stdHTTPWebsocket.cls create mode 100644 src/WIP/stdUIAutomationElement.cls diff --git a/src/WIP/JSONLogic.cls b/src/WIP/JSONLogic.cls index eded87b..6f79f73 100644 --- a/src/WIP/JSONLogic.cls +++ b/src/WIP/JSONLogic.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "JSONLogic" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + 'This is a test library for JSON Logic. 'JSON Logic is being used as a placeholder for Lambdas at the moment, until a proper lamda syntax is released. 'Lambda syntax will likely be converted to JSONLogic objects where they'll be parsed by this algorithm. diff --git a/src/WIP/Pointers/stdPointer v2.cls b/src/WIP/Pointers/stdPointer v2.cls index a9d6d89..faee8a4 100644 --- a/src/WIP/Pointers/stdPointer v2.cls +++ b/src/WIP/Pointers/stdPointer v2.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdPointer" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + 'Pre requisites: 'Revolution in pointers: diff --git a/src/WIP/Pointers/stdPointer.cls b/src/WIP/Pointers/stdPointer.cls index 35f4bdf..7c2903b 100644 --- a/src/WIP/Pointers/stdPointer.cls +++ b/src/WIP/Pointers/stdPointer.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdPointer" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + 'Pre requisites: 'Revolution in pointers: diff --git a/src/WIP/ideas/cUniversalDLLCalls.cls b/src/WIP/ideas/cUniversalDLLCalls.cls deleted file mode 100644 index 6767110..0000000 --- a/src/WIP/ideas/cUniversalDLLCalls.cls +++ /dev/null @@ -1,408 +0,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True - DataBindingBehavior = 0 'vbNone - DataSourceBehavior = 0 'vbNone - MTSTransactionMode = 0 'NotAnMTSObject -END -Attribute VB_Name = "cUniversalDLLCalls" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = True -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Option Explicit - -'Written by LaVolpe -'http://www.vbforums.com/showthread.php?781595-VB6-Call-Functions-By-Pointer-(Universall-DLL-Calls)&p=4795471&viewfull=1 - - - -' for documentation on the main API DispCallFunc... http://msdn.microsoft.com/en-us/library/windows/desktop/ms221473%28v=vs.85%29.aspx -Private Declare Function DispCallFunc Lib "oleaut32.dll" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long -Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long -Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long -Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long -Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long -Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) -Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte) -Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long) -Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal lpString As Long) As Long -Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long - -' APIs used for _CDecl callback workarounds. See ThunkFor_CDeclCallbackToVB & ThunkRelease_CDECL -Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long -Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long - -Public Enum CALLINGCONVENTION_ENUM - ' http://msdn.microsoft.com/en-us/library/system.runtime.interopservices.comtypes.callconv%28v=vs.110%29.aspx - CC_FASTCALL = 0& - CC_CDECL - CC_PASCAL - CC_MACPASCAL - CC_STDCALL ' typical windows APIs - CC_FPFASTCALL - CC_SYSCALL - CC_MPWCDECL - CC_MPWPASCAL -End Enum -Public Enum CALLRETURNTUYPE_ENUM - CR_None = vbEmpty - CR_LONG = vbLong - CR_BYTE = vbByte - CR_INTEGER = vbInteger - CR_SINGLE = vbSingle - CR_DOUBLE = vbDouble - CR_CURRENCY = vbCurrency - ' if the value you need isn't in above list, you can pass the value manually to the - ' CallFunction_DLL method below. For additional values, see: - ' http://msdn.microsoft.com/en-us/library/cc237865.aspx -End Enum -Public Enum STRINGPARAMS_ENUM - STR_NONE = 0& - STR_ANSI - STR_UNICODE -End Enum - -Private m_DLLname As String ' track last DLL loaded by this class -Private m_Mod As Long ' reference to loaded module -Private m_Release As Boolean ' whether or not we unload the module/dll - -Public Function CallFunction_DLL(ByVal LibName As String, ByVal FunctionName As String, _ - ByVal HasStringParams As STRINGPARAMS_ENUM, _ - ByVal FunctionReturnType As CALLRETURNTUYPE_ENUM, _ - ByVal CallConvention As CALLINGCONVENTION_ENUM, _ - ParamArray FunctionParameters() As Variant) As Variant - -' Used to call standard dlls, not active-x or COM objects - -' Return value. Will be a variant containing a value of FunctionReturnType -' If this method fails, the return value will always be Empty. This can be verified by checking -' the Err.LastDLLError value. It will be non-zero if the function failed else zero. -' If the method succeeds, there is no guarantee that the function you called succeeded. The -' success/failure of that function would be indicated by this method's return value. -' If calling a sub vs function & this method succeeds, the return value will be zero. -' Summarizing: if method fails to execute, Err.LastDLLError value will be non-zero -' If method executes ok, return value is from the DLL you called - -' Parameters: -' LibName. The dll name. You should always include the extension else DLL is used -' See LoadLibrary documentation for more: http://msdn.microsoft.com/en-us/library/windows/desktop/ms684175%28v=vs.85%29.aspx -' FunctionName. The DLL function to call. This is case-senstiive -' To call a function by ordinal, prefix it with a hash symbol, i.e., #124 -' HasStringParams. Provide one of the 3 available values -' STR_NONE. No parameters are strings or all strings are passed via StrPtr() -' STR_UNICODE. Any passed string values are for a Unicode function, i.e., SetWindowTextW -' STR_ANSI. Any passed string values are for an ANSI function, i.e., SetWindowTextA -' Important: If you pass one of FunctionParameters a String variable, you must include -' STR_UNICODE or STR_ANSI depending on what version function you are calling -' See the FunctionParameters section below for more -' FunctionReturnType. Describes what variant type the called function returns -' If calling a subroutine that does not return a value, use CR_None -' CallConvention. One of various DLL calling conventions -' You must know the calling convention of the function you are calling and the number -' of parameters, along with the parameter variable type -' FunctionParameters. The values and variant type for each value as required by the function -' you are calling. This is important. Passing incorrect variable types can cause crashes. -' There is no auto-conversion like VB would do for you if you were to call an API function. -' To ensure you pass the correct variable type, use VBs conversion routines: -' Passing a Long? CLng(10), CLng(x). Passing an Integer? CInt(10), CInt(x) -' Special cases: -' UDTs (structures). Pass these using VarPtr(), i.e., VarPtr(uRect) -' If UDT members contain static size strings, you should declare those string members -' as Byte arrays instead. When array is filled in by the function you called, -' you can use StrConv() to convert array to string. -' If UDT members contain dynamic size strings, you should declare those as Long. -' When the function returns, you can use built-in functions within this class to -' retrieve the string from the pointer provided to your UDT. -' Arrays. DO NOT pass the array. Pass only a pointer to the first member of the array, -' i.e., VarPtr(myArray(0)), VarPtr(myArray(0,0)), etc -' Strings for ANSI functions. -' 1) Passing by variable name or value? i.e., strContent, "Edit", etc -' The string needs to be converted to ANSI, and this class will do that for you -' if you also pass HasStringParams as STR_ANSI. Otherwise, do NOT pass strings -' for ANSI functions by variable name or value. When passed by variable name, -' the variable contents are changed to 1 byte per character. To prevent this, -' pass the variable name inside parentheses, i.e., (myVariable) -' 2) Passing by StrPtr()? i.e, StrPtr(strContent), StrPtr("Edit") -' If the function you are calling needs the string contents, then do NOT pass -' the string this way. You must first convert it to ANSI. Else, you could -' pass it as desribed in #1 above. -' Rule-of-Thumb. If string is just a buffer, pass it by StrPtr(), then on return, -' use VB's StrConv() to convert it from ANSI to unicode. Otherwise, pass the -' string by variable name or value -' Strings for Unicode functions -' 1) Passing by variable name or value? i.e., strContent, "Edit", etc -' Internally, the string must be passed to the function ByVal via StrPtr(). -' This class will do that, but it is faster (less code) if you pass all strings -' for unicode functions via StrPtr() -' 2) Passing by StrPtr()? i.e, StrPtr(strContent), StrPtr("Edit") -' Less code required, fastest method, no conversions required at all -' Rule-of-Thumb. All strings for unicode functions should be passed via StrPtr() -' Numeric values vs. variables. Be aware of the variable type of the number you pass. -' Depending on the value of the number, it may be Integer, Long, Double, etc. -' Numbers in range -32768 to 32767 are Integer, from -2147483648 to 2147483647 are Long -' Fractional/decimal numbers are Double -' If function parameter expects Long, don't pass just 5, pass 5& or CLng(5) -' Numbers as variables. Be sure the variable type matches the parameter type, i.e., -' dont pass variables declared as Variant to a function expecting Long - - '// minimal sanity check for these 4 parameters: - If LibName = vbNullString Then Exit Function - If FunctionName = vbNullString Then Exit Function - If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function ' can only be 4 bytes - If HasStringParams < STR_NONE Or HasStringParams > STR_UNICODE Then Exit Function - - Dim sText As String, lStrPtr As Long, lValue As Long - Const VT_BYREF As Long = &H4000& - - Dim hMod As Long, fPtr As Long - Dim pIndex As Long, pCount As Long - - Dim vParamPtr() As Long, vParamType() As Integer - Dim vRtn As Variant, vParams() As Variant - - '// determine if we will be loading this or already loaded - If LibName = m_DLLname Then - hMod = m_Mod ' already loaded - Else - If Not m_Mod = 0& Then ' reset m_Mod & m_Release - If m_Release = True Then FreeLibrary m_Mod - m_Mod = 0&: m_Release = False - End If - hMod = GetModuleHandle(LibName) ' loaded in process already? - If hMod = 0& Then ' if not, load it now - hMod = LoadLibrary(LibName) - If hMod = 0& Then Exit Function - m_Release = True ' need to use FreeLibrary at some point - End If - m_Mod = hMod ' cache hMod & LibName - m_DLLname = LibName - End If - fPtr = GetProcAddress(hMod, FunctionName) ' get the function pointer (Case-Sensitive) - If fPtr = 0& Then Exit Function ' abort if failure - - vParams() = FunctionParameters() ' copy passed parameters, if any - pCount = Abs(UBound(vParams) - LBound(vParams) + 1&) - If HasStringParams > STR_NONE Then ' patch to ensure Strings passed as handles - For pIndex = 0& To pCount - 1& ' for each string param, get its StrPtr - If VarType(FunctionParameters(pIndex)) = vbString Then - CopyMemory lValue, ByVal VarPtr(FunctionParameters(pIndex)), 2& - If (lValue And VT_BYREF) = 0& Then ' else variant has pointer to StrPtr - lValue = VarPtr(FunctionParameters(pIndex)) + 8& - Else - CopyMemory lValue, ByVal VarPtr(FunctionParameters(pIndex)) + 8&, 4& - End If - CopyMemory lStrPtr, ByVal lValue, 4& ' get the StrPtr - If lStrPtr > 0& Then ' if not null then - If HasStringParams = STR_ANSI Then ' convert Unicode to ANSI - sText = FunctionParameters(pIndex) ' then re-write the passd String to ANSI - FillMemory ByVal lStrPtr, LenB(sText), 0 - sText = StrConv(sText, vbFromUnicode) - CopyMemory ByVal lStrPtr, ByVal StrPtr(sText), LenB(sText) - End If - End If - vParams(pIndex) = lStrPtr ' reference the StrPtr - End If - Next - End If - ' fill in rest of APIs parameters - If pCount = 0& Then ' no return value (sub vs function) - ReDim vParamPtr(0 To 0) - ReDim vParamType(0 To 0) - Else - ReDim vParamPtr(0 To pCount - 1&) ' need matching array of parameter types - ReDim vParamType(0 To pCount - 1&) ' and pointers to the parameters - For pIndex = 0& To pCount - 1& - vParamPtr(pIndex) = VarPtr(vParams(pIndex)) - vParamType(pIndex) = VarType(vParams(pIndex)) - Next - End If - ' call the function now - lValue = DispCallFunc(0&, fPtr, CallConvention, FunctionReturnType, _ - pCount, vParamType(0), vParamPtr(0), vRtn) - - If lValue = 0& Then ' 0 = S_OK - If FunctionReturnType = CR_None Then - CallFunction_DLL = lValue - Else - CallFunction_DLL = vRtn ' return result - End If - Else - SetLastError lValue ' set error & return Empty - End If - -End Function - -Public Function CallFunction_COM(ByVal InterfacePointer As Long, ByVal VTableOffset As Long, _ - ByVal FunctionReturnType As CALLRETURNTUYPE_ENUM, _ - ByVal CallConvention As CALLINGCONVENTION_ENUM, _ - ParamArray FunctionParameters() As Variant) As Variant - -' Used to call active-x or COM objects, not standard dlls - -' Return value. Will be a variant containing a value of FunctionReturnType -' If this method fails, the return value will always be Empty. This can be verified by checking -' the Err.LastDLLError value. It will be non-zero if the function failed else zero. -' If the method succeeds, there is no guarantee that the Interface function you called succeeded. The -' success/failure of that function would be indicated by this method's return value. -' Typically, success is returned as S_OK (zero) and any other value is an error code. -' If calling a sub vs function & this method succeeds, the return value will be zero. -' Summarizing: if method fails to execute, Err.LastDLLError value will be non-zero -' If method executes ok, if the return value is zero, method succeeded else return is error code - -' Parameters: -' InterfacePointer. A pointer to an object/class, i.e., ObjPtr(IPicture) -' Passing invalid pointers likely to result in crashes -' VTableOffset. The offset from the passed InterfacePointer where the virtual function exists. -' These offsets are generally in multiples of 4. Value cannot be negative. -' For the remaining parameters, see the details withn the CallFunction_DLL method. -' They are the same with one exception: strings. Pass the string variable name or value - - '// minimal sanity check for these 4 parameters: - If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function - If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function ' can only be 4 bytes - - Dim pIndex As Long, pCount As Long - Dim vParamPtr() As Long, vParamType() As Integer - Dim vRtn As Variant, vParams() As Variant - - vParams() = FunctionParameters() ' copy passed parameters, if any - pCount = Abs(UBound(vParams) - LBound(vParams) + 1&) - If pCount = 0& Then ' no return value (sub vs function) - ReDim vParamPtr(0 To 0) - ReDim vParamType(0 To 0) - Else - ReDim vParamPtr(0 To pCount - 1&) ' need matching array of parameter types - ReDim vParamType(0 To pCount - 1&) ' and pointers to the parameters - For pIndex = 0& To pCount - 1& - vParamPtr(pIndex) = VarPtr(vParams(pIndex)) - vParamType(pIndex) = VarType(vParams(pIndex)) - Next - End If - ' call the function now - pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, _ - pCount, vParamType(0), vParamPtr(0), vRtn) - - If pIndex = 0& Then ' 0 = S_OK - CallFunction_COM = vRtn ' return result - Else - SetLastError pIndex ' set error & return Empty - End If - -End Function - -Public Function PointerToStringA(ByVal ANSIpointer As Long) As String - ' courtesy function provided for your use as needed - ' ANSIpointer must be a pointer to an ANSI string (1 byte per character) - Dim lSize As Long, sANSI As String - If Not ANSIpointer = 0& Then - lSize = lstrlenA(ANSIpointer) - If lSize > 0& Then - sANSI = String$(lSize \ 2& + 1&, vbNullChar) - CopyMemory ByVal StrPtr(sANSI), ByVal ANSIpointer, lSize - PointerToStringA = Left$(StrConv(sANSI, vbUnicode), lSize) - End If - End If -End Function - -Public Function PointerToStringW(ByVal UnicodePointer As Long) As String - ' courtesy function provided for your use as needed - ' UnicodePointer must be a pointer to an unicode string (2 bytes per character) - Dim lSize As Long - If Not UnicodePointer = 0& Then - lSize = lstrlenW(UnicodePointer) - If lSize > 0& Then - PointerToStringW = Space$(lSize) - CopyMemory ByVal StrPtr(PointerToStringW), ByVal UnicodePointer, lSize * 2& - End If - End If -End Function - -Public Function ThunkFor_CDeclCallbackToVB(ByVal VBcallbackPointer As Long, _ - ByVal CallbackParamCount As Long) As Long - - ' this method is a workaround for cases where you are calling a CDECL function that requests - ' a callback function address in CDECL calling convention. - ' Ex: qsort in msvcrt20.dll uses such a callback & qsort function description found here: - ' http://msdn.microsoft.com/en-us/library/zes7xw0h.aspx - - ' Important notes: - ' 1) DO NOT USE this workaround when any function accepting a callback pointer, - ' uses stdCall calling convention to that pointer. DO NOT USE this function - ' for other than CDECL functions calling back to VB - ' 2) This method's return value MUST BE RELEASED via a call to ThunkRelease_CDECL method - ' 3) The VB callback function must be a function vs. sub, even if the the callback - ' definition describes it as a sub, i.e., returns no value, void - ' 4) The thunk prevents VB's stack cleaning by copying first, then replacing it after VB returns - - ' Parameters: - ' VBcallbackPointer: the VB callback address. If function exists in a bas module, then - ' this would be the return value of your AddressOf call. If using thunks to get addresses - ' from class methods, then pass that thunk address as appropriate - ' CallbackParamCount: Number of parameters your VB method accepts. This cannot be dynamic - - ' sample call: assume that vbCallBackFunction is a Public function within a bas module - ' ------------------------------------------------------------------------------------- - ' Dim lCallback As Long, lThunkAddress As Long, lResult As Long - ' lCallback = thisClass.ThunkFor_CDeclCallbackToVB(AddressOf vbCallBackFunction, 2&, lThunkAddress) - ' ' now call your CDECL function, passing lCallback as the required callback address paramter, - ' ' in whatever param position it is required - ' lResult = thisClass.CallFunction_DLL("someCDECL.dll", "functionName", STR_NONE, CR_LONG, _ - ' CC_CDECL, params, lCallback) - ' ' destroy the thunk when no longer needed - ' Call thisClass.ThunkRelease_CDECL(lThunkAddress) - - - ' sanity checks on passed parameters - If VBcallbackPointer = 0& Or CallbackParamCount < 0& Or CallbackParamCount > 63& Then Exit Function - ' FYI: Why is 63 the max count? CallbackParamCount stored in the thunk as unsigned byte: 63*4 =252 - - Dim fPtr As Long, tCode(0 To 2) As Currency - - fPtr = VirtualAlloc(0&, 28&, &H1000&, &H40&) ' reserve memory for our virtual function - - tCode(0) = 465203369712025.6232@ ' thunk code is small, 28 bytes - tCode(1) = -140418483381718.8329@ - tCode(2) = -4672484613390.9419@ - CopyMemory ByVal fPtr, ByVal VarPtr(tCode(0)), 24& ' copy to virt memmory - CopyMemory ByVal fPtr + 24&, &HC30672, 4& ' copy final 4 bytes also - - ' thunk uses relative address to VB function address, calc relative address & patch the thunk - CopyMemory ByVal fPtr + 10&, VBcallbackPointer - fPtr - 14&, 4& - CopyMemory ByVal fPtr + 16&, CallbackParamCount * 4&, 1& ' patch thunk's param count (stack adjustment) - - ThunkFor_CDeclCallbackToVB = fPtr - - ' FYI: Thunk described below. Paul Caton's work found here: - ' http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=49776&lngWId=1 - '============================================================================== - ' ;FASM syntax - ' use32 ;32bit - ' call L1 ;Call the next instruction - ' L1: pop eax ;Pop the return address into eax (eax = L1) - ' pop dword [eax+(L3-L1)] ;Pop the calling cdecl function's return address to the save location - ' db 0E8h ;Op-code for a relative address call - ' dd 55555555h ;Address of target vb callback function, patched at run-time - ' sub esp, 55h ;Unfix the stack, our caller expects to do it, patched at runtime - ' call L2 ;Call the next instruction - ' L2: pop edx ;Pop the return address into edx (edx = L2) - ' push dword [edx+(L3-L2)];Push the saved return address, the stack is now as it was on entry to callback_wrapper - ' ret ;Return to caller - ' db 0 ;Alignment pad - ' L3: dd 0 ;Return address of the cdecl caller saved here - '============================================================================== -End Function - -Public Sub ThunkRelease_CDECL(ByVal ThunkCallBackAddress As Long) - ' Used to release memory created during a call to the ThunkFor_CDeclCallbackToVB method. - ' The parameter passed here must be the return value of the ThunkFor_CDeclCallbackToVB method - If Not ThunkCallBackAddress = 0& Then VirtualFree ThunkCallBackAddress, 0&, &H8000& -End Sub - -Private Sub Class_Terminate() - If Not m_Mod = 0& Then - If m_Release = True Then FreeLibrary m_Mod - End If -End Sub - - diff --git a/src/WIP/stdCrypto/stdCrypt.cls b/src/WIP/stdCrypto/stdCrypt.cls index 3b28a3f..4c6c8fd 100644 --- a/src/WIP/stdCrypto/stdCrypt.cls +++ b/src/WIP/stdCrypto/stdCrypt.cls @@ -1,4 +1,14 @@ - +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdCrypt" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + + 'Modified from src: https://www.vbforums.com/showthread.php?883497-Simple-Encryption Private Type Blob diff --git a/src/WIP/stdDLL/inspiration/cUniversalDLLCalls.cls b/src/WIP/stdDLL/inspiration/cUniversalDLLCalls.cls index bff45e4..0c53580 100644 --- a/src/WIP/stdDLL/inspiration/cUniversalDLLCalls.cls +++ b/src/WIP/stdDLL/inspiration/cUniversalDLLCalls.cls @@ -5,7 +5,7 @@ BEGIN DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END -Attribute VB_Name = "stdDLL" +Attribute VB_Name = "cUniversalDLLCalls" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = True diff --git a/src/WIP/ideas/stdDll.md b/src/WIP/stdDLL/stdDll.md similarity index 100% rename from src/WIP/ideas/stdDll.md rename to src/WIP/stdDLL/stdDll.md diff --git a/src/WIP/stdEnumProvider/FibonacciIteratorExample.cls b/src/WIP/stdEnumProvider/FibonacciIteratorExample.cls index ed3e358..284804b 100644 --- a/src/WIP/stdEnumProvider/FibonacciIteratorExample.cls +++ b/src/WIP/stdEnumProvider/FibonacciIteratorExample.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "FibonacciIteratorExample" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + 'Usage: ' 'Dim v as variant diff --git a/src/WIP/stdEnumProvider/STD_Types_IniVariantEnum.bas b/src/WIP/stdEnumProvider/STD_Types_IniVariantEnum.bas index 6f4d211..e19e598 100644 --- a/src/WIP/stdEnumProvider/STD_Types_IniVariantEnum.bas +++ b/src/WIP/stdEnumProvider/STD_Types_IniVariantEnum.bas @@ -1,3 +1,5 @@ +Attribute VB_Name = "STD_Types_IniVariantEnum" + ' ' MEnumerator.bas ' diff --git a/src/WIP/stdGithub.cls b/src/WIP/stdGithub.cls index 7782265..be5bc5d 100644 --- a/src/WIP/stdGithub.cls +++ b/src/WIP/stdGithub.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdGithub" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + 'Based on: https://docs.github.com/en/rest 'Core docs: https://docs.github.com/en/free-pro-team@latest/rest/reference/repos#create-or-update-file-contents diff --git a/src/WIP/stdHTTP/SS/stdHTTP.cls b/src/WIP/stdHTTP/SS/stdHTTP.cls deleted file mode 100644 index 4912d67..0000000 --- a/src/WIP/stdHTTP/SS/stdHTTP.cls +++ /dev/null @@ -1,143 +0,0 @@ -'WinHttp.WinHttpRequest.5.1 -'Microsoft.XMLHTTP -'WinHTTP - -Implements stdICallable - -Private Declare Function WinHttpCrackUrl Lib "winhttp" (ByVal pwszUrl As Long, ByVal dwUrlLength As Long, ByVal dwFlags As Long, lpUrlComponents As Any) As Long -Private Declare Function WinHttpCreateUrl Lib "winhttp" (lpUrlComponents As Any, ByVal dwFlags As Long, ByVal pwszUrl As Long, pdwUrlLength As Long) As Long - -Private Type URL_COMPONENTS - dwStructSize As Long - lpszScheme As Long - dwSchemeLength As Long - nScheme As Long - lpszHostName As Long - dwHostNameLength As Long - nPort As Long - lpszUserName As Long - dwUserNameLength As Long - lpszPassword As Long - dwPasswordLength As Long - lpszUrlPath As Long - dwUrlPathLength As Long - lpszExtraInfo As Long - dwExtraInfoLength As Long -End Type - -Private tURL as URL_COMPONENTS -Private sURL as string - -'Basic Authentication -Private pUser as string -Private pPass as string - - -'Public Function SetCredentials(sUrl As String, ByVal sUser As String, ByVal sPass As String) As String -' Dim uUrlCom As URL_COMPONENTS -' Dim sRet As String -' Dim lSize As Long -' -' With uUrlCom -' .dwStructSize = Len(uUrlCom) -' .dwSchemeLength = -1 -' .dwHostNameLength = -1 -' .dwUrlPathLength = -1 -' .dwExtraInfoLength = -1 -' End With -' Call WinHttpCrackUrl(StrPtr(sUrl), Len(sUrl), 0, uUrlCom) -' sUser = pvEscapeCredential(sUser) -' sPass = pvEscapeCredential(sPass) -' With uUrlCom -' .lpszUserName = StrPtr(sUser) -' .dwUserNameLength = Len(sUser) -' .lpszPassword = StrPtr(sPass) -' .dwPasswordLength = Len(sPass) -' End With -' sRet = String(4096, 0) -' lSize = Len(sRet) -' Call WinHttpCreateUrl(uUrlCom, 0, StrPtr(sRet), lSize) -' SetCredentials = Left$(sRet, InStr(sRet, vbNullChar)) -'End Function - - - - -Public Function Create(ByVal sMethod as string, ByVal sURL as string, ) as stdHTTP - -End Function -Public Function Run(ByVal data as string) - -End Function -Public Sub RunAsync(ByVal data as string, cb as stdICallable) - -End Sub - -Public Property Get isAutoProxyEnabled() as boolean - -End Property -Public Property Let isAutoProxyEnabled(v as boolean) - -End Property - -Public Function BindAuth(options as object) as boolean - Select case options("Type") - case "BASIC" - pUser = options("User") - pPass = options("Pass") - With tURL - .lpszUserName = StrPtr(pUser) - .dwUserNameLength = Len(pUser) - .lpszPassword = StrPtr(pPass) - .dwPasswordLength = Len(pPass) - End With - End Select -End Function - -'Gets a wrapper which applies basic authentication to the request -Public Function GetBasicAuth(ByVal sUser as string, ByVal sPass as string) as object - set GetBasicAuth = CreateObject("Scripting.Dictionary") - GetBasicAuth.item("Type") = "BASIC" - GetBasicAuth.item("User") = sUser - GetBasicAuth.item("Pass") = sPass -End Function - -'Gets a wrapper which applies OAuth authentication to the request -'might be able to use special redirect: urn:ietf:wg:oauth:2.0:oob as shown here: https://stackoverflow.com/questions/26428043/exchanging-authorization-code-for-access-token-for-google-calendar-api-with-vba -'https://help.salesforce.com/articleView?id=remoteaccess_oauth_user_agent_flow.htm&type=5 -Public Function GetOAuth2Binding(ByVal sClientID as string,ByVal sClientSecret as string,ByVal sTokenHost as string) as object - set GetBasicAuth = CreateObject("Scripting.Dictionary") - GetBasicAuth.item("Type") = "OAUTH2" - GetBasicAuth.item("ClientID") = sClientID - GetBasicAuth.item("ClientSecret") = sClientSecret - '? GetBasicAuth.item("User") = sUser - '? GetBasicAuth.item("Pass") = sPass - - 'step 1: host a server -End Function - - - - - - - - - - - - - - - - - - - -Private Function pvEscape(sText As String) As String - pvEscape = Replace(Replace(Replace(Replace(sText, _ - "%", "%" & Hex(Asc("%"))), _ - "/", "%" & Hex(Asc("/"))), _ - "@", "%" & Hex(Asc("@"))), _ - "?", "%" & Hex(Asc("?"))) -End Function \ No newline at end of file diff --git a/src/WIP/stdHTTP/SS/stdHTTPWebsocket.cls b/src/WIP/stdHTTP/SS/stdHTTPWebsocket.cls deleted file mode 100644 index 1e62206..0000000 --- a/src/WIP/stdHTTP/SS/stdHTTPWebsocket.cls +++ /dev/null @@ -1 +0,0 @@ -'Wrapper around WinHttpWebSocket API \ No newline at end of file diff --git a/src/WIP/stdIni.cls b/src/WIP/stdIni.cls index c68e675..3c02f83 100644 --- a/src/WIP/stdIni.cls +++ b/src/WIP/stdIni.cls @@ -7,6 +7,7 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False + Private IniPath As String Public Data As Object Public Comments As Object diff --git a/src/WIP/stdMath.cls b/src/WIP/stdMath.cls index 8600957..2857958 100644 --- a/src/WIP/stdMath.cls +++ b/src/WIP/stdMath.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdMath" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + Private Enum InterpolationType Linear Logarithmic diff --git a/src/WIP/stdObject/stdObject.cls b/src/WIP/stdObject/stdObject.cls index 51133af..3e90dc1 100644 --- a/src/WIP/stdObject/stdObject.cls +++ b/src/WIP/stdObject/stdObject.cls @@ -5,7 +5,7 @@ BEGIN DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END -Attribute VB_Name = "IFauxInterface" +Attribute VB_Name = "stdObject" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False diff --git a/src/WIP/stdOpenCL/stdOpenCL.cls b/src/WIP/stdOpenCL/stdOpenCL.cls index be253ff..75a97f7 100644 --- a/src/WIP/stdOpenCL/stdOpenCL.cls +++ b/src/WIP/stdOpenCL/stdOpenCL.cls @@ -1,3 +1,13 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdOpenCL" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + Private Const CL_FALSE As Long = 0 Private Const CL_TRUE As Long = 1 diff --git a/src/WIP/stdRibbon.cls b/src/WIP/stdRibbon.cls index 029b1e7..eee75d6 100644 --- a/src/WIP/stdRibbon.cls +++ b/src/WIP/stdRibbon.cls @@ -1,4 +1,13 @@ -Attribute VB_Name = "Ribbon" +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdRibbon" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + Option Explicit #If VBA7 Then Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpDest As LongPtr, ByVal lpSrc As LongPtr, ByVal cbCopy As Long) diff --git a/src/WIP/stdUIAutomationElement.cls b/src/WIP/stdUIAutomationElement.cls new file mode 100644 index 0000000..e755939 --- /dev/null +++ b/src/WIP/stdUIAutomationElement.cls @@ -0,0 +1,252 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdUIAutomationElement" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + +'@inspiration https://www.mrexcel.com/board/threads/custom-accessibility-class.1253735 + +#If VBA7 = 0 Then + Enum LongPtr + [_] + End Enum +#End If + +'@docs https://github.com/tpn/winsdk-10/blob/master/Include/10.0.14393.0/um/UIAutomationClient.idl#L2239-L2494 +Private Enum EUIAutomation + QueryInterface + AddRef + Release + CompareElements + CompareRuntimeIds + GetRootElement + ElementFromHandle + ElementFromPoint + GetFocusedElement + GetRootElementBuildCache + ElementFromHandleBuildCache + ElementFromPointBuildCache + GetFocusedElementBuildCache + CreateTreeWalker + ControlViewWalker + ContentViewWalker + RawViewWalker + RawViewCondition + ControlViewCondition + ContentViewCondition + CreateCacheRequest + CreateTrueCondition + CreateFalseCondition + CreatePropertyCondition + CreatePropertyConditionEx + CreateAndCondition + CreateAndConditionFromArray + CreateAndConditionFromNativeArray + CreateOrCondition + CreateOrConditionFromArray + CreateOrConditionFromNativeArray + CreateNotCondition + AddAutomationEventHandler + RemoveAutomationEventHandler + AddPropertyChangedEventHandlerNativeArray + AddPropertyChangedEventHandler + RemovePropertyChangedEventHandler + AddStructureChangedEventHandler + RemoveStructureChangedEventHandler + AddFocusChangedEventHandler + RemoveFocusChangedEventHandler + RemoveAllEventHandlers + IntNativeArrayToSafeArray + IntSafeArrayToNativeArray + RectToVariant + VariantToRect + SafeArrayToRectNativeArray + CreateProxyFactoryEntry + ProxyFactoryMapping + GetPropertyProgrammaticName + GetPatternProgrammaticName + PollForPotentialSupportedPatterns + PollForPotentialSupportedProperties + CheckNotSupported + ReservedNotSupportedValue + ReservedMixedAttributeValue + ElementFromIAccessible + ElementFromIAccessibleBuildCache + 'IUIAutomation2 (34723aff-0c9d-49d0-9896-7ab52df8cd8a) + AutoSetFocus_get + AutoSetFocus_let + ConnectionTimeout_get + ConnectionTimeout_let + TransactionTimeout_get + TransactionTimeout_let + 'IUIAutomation3 (73D768DA-9B51-4B89-936E-C209290973E7) + AddTextEditTextChangedEventHandler + RemoveTextEditTextChangedEventHandler + 'IUIAutomation4 (1189C02A-05F8-4319-8E21-E817E3DB2860) + AddChangesEventHandler + RemoveChangesEventHandler +End Enum +Private Enum EUIAutomationTreeWalker + QueryInterface + AddRef + Release + GetParentElement + GetFirstChildElement + GetLastChildElement + GetNextSiblingElement + GetPreviousSiblingElement + NormalizeElement + GetParentElementBuildCache + GetFirstChildElementBuildCache + GetLastChildElementBuildCache + GetNextSiblingElementBuildCache + GetPreviousSiblingElementBuildCache + NormalizeElementBuildCache + Condition +End Enum + +Private Enum EUIAutomationElement + QueryInterface + AddRef + Release + SetFocus + GetRuntimeId + FindFirst + FindAll + FindFirstBuildCache + FindAllBuildCache + BuildUpdatedCache + GetCurrentPropertyValue + GetCurrentPropertyValueEx + GetCachedPropertyValue + GetCachedPropertyValueEx + GetCurrentPatternAs + GetCachedPatternAs + GetCurrentPattern + GetCachedPattern + GetCachedParent + GetCachedChildren + CurrentProcessId + CurrentControlType + CurrentLocalizedControlType + CurrentName + CurrentAcceleratorKey + CurrentAccessKey + CurrentHasKeyboardFocus + CurrentIsKeyboardFocusable + CurrentIsEnabled + CurrentAutomationId + CurrentClassName + CurrentHelpText + CurrentCulture + CurrentIsControlElement + CurrentIsContentElement + CurrentIsPassword + CurrentNativeWindowHandle + CurrentItemType + CurrentIsOffscreen + CurrentOrientation + CurrentFrameworkId + CurrentIsRequiredForForm + CurrentItemStatus + CurrentBoundingRectangle + CurrentLabeledBy + CurrentAriaRole + CurrentAriaProperties + CurrentIsDataValidForForm + CurrentControllerFor + CurrentDescribedBy + CurrentFlowsTo + CurrentProviderDescription + CachedProcessId + CachedControlType + CachedLocalizedControlType + CachedName + CachedAcceleratorKey + CachedAccessKey + CachedHasKeyboardFocus + CachedIsKeyboardFocusable + CachedIsEnabled + CachedAutomationId + CachedClassName + CachedHelpText + CachedCulture + CachedIsControlElement + CachedIsContentElement + CachedIsPassword + CachedNativeWindowHandle + CachedItemType + CachedIsOffscreen + CachedOrientation + CachedFrameworkId + CachedIsRequiredForForm + CachedItemStatus + CachedBoundingRectangle + CachedLabeledBy + CachedAriaRole + CachedAriaProperties + CachedIsDataValidForForm + CachedControllerFor + CachedDescribedBy + CachedFlowsTo + CachedProviderDescription + GetClickablePoint + 'IUIAutomationElement2 (6749c683-f70d-4487-a698-5f79d55290d6) + CurrentOptimizeForVisualContent + CachedOptimizeForVisualContent + CurrentLiveSetting + CachedLiveSetting + CurrentFlowsFrom + CachedFlowsFrom + 'IUIAutomationElement3 (8471DF34-AEE0-4A01-A7DE-7DB9AF12C296) + ShowContextMenu + CurrentIsPeripheral + CachedIsPeripheral + 'IUIAutomationElement4 (3B6E233C-52FB-4063-A4C9-77C075C2A06B) + CurrentPositionInSet + CurrentSizeOfSet + CurrentLevel + CurrentAnnotationTypes + CurrentAnnotationObjects + CachedPositionInSet + CachedSizeOfSet + CachedLevel + CachedAnnotationTypes + CachedAnnotationObjects + 'IUIAutomationElement5 (98141C1D-0D0E-4175-BBE2-6BFF455842A7) + CurrentLandmarkType + CurrentLocalizedLandmarkType + CachedLandmarkType + CachedLocalizedLandmarkType + 'IUIAutomationElement6 (4780d450-8bca-4977-afa5-a4a517f555e3) + CurrentFullDescription + CachedFullDescription +End Enum + +'@docs https://github.com/tpn/winsdk-10/blob/master/Include/10.0.14393.0/um/UIAutomationClient.idl#L2116-L2124 +Private Enum EUIAutomationElementArray + QueryInterface + AddRef + Release + Length + GetElement +End Enum + +Private Type TThis + hElement As LongPtr +End Type +Private This as TThis + +Public Function CreateFromHwnd() As stdUIAutomationElement + Set CreateFromHwnd = New stdUIAutomationElement + +End Function + + + + +Private vTableCall \ No newline at end of file diff --git a/src/WIP/stdWordLibraries/stdWordDocument.cls b/src/WIP/stdWordLibraries/stdWordDocument.cls index f9f45c2..ccdde13 100644 --- a/src/WIP/stdWordLibraries/stdWordDocument.cls +++ b/src/WIP/stdWordLibraries/stdWordDocument.cls @@ -1,4 +1,12 @@ - +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "stdWordDocument" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False 'A really handy function to return all ranges