'
' Test RqUtils.dll     July 03nd, 2004
'
' Read RqUtilsDoc.Txt   First
'
' The Function CallAddress and CallPointer now Work. ALL OK NOW
'
$ESCAPECHARS ON
$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"
'
DECLARE FUNCTION CallAsmProc LIB "user32" ALIAS "CallWindowProcA" _
                            (Proc AS LONG, A1 AS LONG, A2 AS LONG, A3 AS LONG, _
                                                                A4 AS LONG) AS LONG
' -----------------------------------------------
' In VBPointers.Dll
' Declare Function JumpFar Lib "VBPointers.dll" Alias "JumpFar" (Pointer As Long) As Long
Declare Function JumpFar Lib "RqUtils.dll" Alias "JumpFar" (Pointer As Long) As Long
' -----------------------------------------------
' In RqUtils.dll
' CallAddress Bugs ????
Declare Function CallAddress Lib "RqUtils.dll" Alias "CallAddress" _
                                                        (AddressToCall As Long, ptrToArgumentsStructure As Long) As Long
' CallPointer Bugs ????
Declare Function CallPointer Lib "RqUtils.dll" Alias "CallPointer" _
                                                        (PointerToCall As Long, ptrToArgumentsStructure As Long) As Long
Declare Function ReadDWordAtAddress Lib "RqUtils.dll" Alias "ReadDWordAtAddress" _
                                                        (AddressToRead As Long) As Long
Declare Function ReadWordAtAddress Lib "RqUtils.dll" Alias "ReadWordAtAddress" _
                                                        (AddressToRead As Long) As Long
Declare Function ReadByteAtAddress Lib "RqUtils.dll" Alias "ReadByteAtAddress" _
                                                        (AddressToRead As Long) As Long
Declare Function ReadDWordAtPointer Lib "RqUtils.dll" Alias "ReadDWordAtPointer" _
                                                        (PointerToRead As Long) As Long
Declare Function ReadWordAtPointer Lib "RqUtils.dll" Alias "ReadWordAtPointer" _
                                                        (PointerToRead As Long) As Long
Declare Function ReadByteAtPointer Lib "RqUtils.dll" Alias "ReadByteAtPointer" _
                                                        (PointerToRead As Long) As Long
' -----------------------------------------------
' Function to Be Called by CallAddress and CallPointer
DefStr sMsgHeader = 
Sub ShowMsg (A As Long, B As Long, c As Long, D As Long)
    ShowMessage ( sMsgHeader & "\nA=" & Hex$(A)& "\nB=" & Hex$(B)& "\nC=" & Hex$(C) & "\nD=" & Hex$(D))
End Sub
' -----------------------------------------------
DefInt iAddress, iPtr, iPtr0, iPtr1, iPtr2, ptrArray
'
' The Array that will contain the passed argument (see CallAddress and CallPointer Code in dll)
Dim myArray(5) As Integer
' The pointer to the Finction to be called by CallAddress an Call Pointer
iPtr = CodePtr(ShowMsg)
' set the values of the arguments (used too to test the Reads functions of the dll)
myArray(0) = 4                      ' 4 arguments
myArray(1) = &HFFFF8000             ' Argument 1
myArray(2) = &HFFFFFF40             ' Argument 2
myArray(3) = &H12345678             ' Argument 3
myArray(4) = &H44444444             ' Argument 4
' 
ptrArray = VarPtr(myArray(0))
'
iptr0 = VarPtr(myArray(0))
iPtr1 = VarPtr(myArray(1))
iPtr2 = VarPtr(myArray(2))
'
Print "Sub showMsg  CodePtr = ";iPtr
Print "myArray(0)  ptrArray = ";ptrArray
Print
' Tests The Read at Address functions of the Dll
Print "RqUtils.dll Read DWORD at Address = ";ReadDWordAtAddress(iPtr0)
Print "RqUtils.dll Read WORD  at Address = ";ReadWordAtAddress(iPtr1)
Print "RqUtils.dll Read BYTE  at Address = ";ReadByteAtAddress(iPtr2)
' Test the read at Pointer functions of the Dll
Print "RqUtils.dll Read DWORD at Pointer = ";ReadDWordAtPointer(VarPtr(iPtr0))
Print "RqUtils.dll Read WORD  at Pointer = ";ReadWordAtPointer(VarPtr(iPtr1))
Print "RqUtils.dll Read BYTE  at Pointer = ";ReadByteAtPointer(VarPtr(iPtr2))
'
' Calls Sub ShowMsg via CallAddress in RqUtils.dll
sMsgHeader = "Sub Called with CallAddress in RqUtils.dll"
myArray(0) = 4                      ' 4 arguments to pass
myArray(1) = &HFFFF8000             ' Argument 1
myArray(2) = &HFFFFFF40             ' Argument 2
myArray(3) = &H12345678             ' Argument 3
myArray(4) = &H44444444             ' Argument 4
CallAddress(iPtr, ptrArray)
'
' Calls Sub ShowMsg via CallPointer in RqUtils.dll
sMsgHeader = "Sub Called With CallPointer in RqUtils.dll"
myArray(0) = 4                      ' 4 arguments to pass
myArray(1) = &H11111111             ' Argument 1
myArray(2) = &H22222222             ' Argument 2
myArray(3) = &H33333333             ' Argument 3
myArray(4) = &H44444444             ' Argument 4
CallPointer(VarPtr(iPtr), ptrArray)
'
' Calls Sub ShowMsg via API CallWindowProcA in user32.dll
sMsgHeader = "Sub Called With API CallWindowProcA in user32.dll"
CallAsmProc(iPtr, 111, 222, 333, 444)
'
' Calls Sub ShowMsg usual way :)
sMsgHeader = "Sub Called as usually in RQ :)"
ShowMsg(111, 222, 333, 444)
'
' -------------------------------------------------------------
' EXIT CONSOLE
' ------------
DefStr sExit
Input "\n\n                    CR to QUIT \n\n", sExit
Application.Terminate
End
'