Making pointer of a long variable for another variable

[Merri]

My brains are having issues, so here we go:

• I have a Long variable that I want to contain a pointer value.
• I want to change the value of this variable to be pointer value to anywhere in the memory.
• The value of another Long variable should change to be the contents of the pointer.

I just can't get my head to do it... very simple, just a change to one pointer value in memory, but how to do that?

[penagate]

I am not sure what you are trying to do. It sounds like just a simple dereference. But if that's all it is I don't suppose you would be posting here.

Pseudocode example maybe?

[ccoder]

I think I understand what you are asking. Something like the following?

'Drop this code in a new project form to test
 
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" _
                Alias "RtlMoveMemory" (xDest As Any, _
                                       xSource As Any, _
                                       ByVal nbytes As Long)
 
Private Sub Form_Load()
  Dim sPtr    As Long
  Dim memByte As Byte
  Dim testStr As String
  Dim indx    As Integer
  
  testStr = "test"
  sPtr = StrPtr(testStr)
  For indx = 0 To LenB(testStr) - 1
      CopyMemory memByte, ByVal sPtr, 1
      Debug.Print memByte
      sPtr = sPtr + 1
  Next indx
  
End Sub

Once the long contains the address of the string, this code moves and displays each byte of the string one byte at a time.

The original value stored in the pointer by the StrPtr call is incremented by 1 for each pass through the loop. CopyMemory uses the address stored in the pointer (ByVal sPtr) to reference the sending field.

I'm not quite sure I understand what you mean by

The value of another Long variable should change to be the contents of the pointer

I think you meant to say "should change to be the contents at the value of the pointer". Also, the change in the other variable will not be automatic.

Can you provide more detail as to what you are trying to do? I've written a lot of C, PL/I and Pascal and am quite used to working with pointers.

Addendum:
You may find something helpful here.

[Logophobic]

I'm barely familiar with anything C, but I think Merri is implying indirection, such that the 'other' long variable would always return the value pointed to by the pointer variable. I have no idea how this might be done in VB.

[Joacim Andersson]

As ccoder already have mentioned you would need to use the CopyMemory API for that since VB doesn't have built in features for working with pointers.

[bushmobile]

I'm a bit confused - are you reading 4 bytes from a memory address? If so, you can use the GetMem function:

Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)

there are also 1, 2 & 8 byte versions

[Agilaz]

you might be interested in this website.

a little example using GetMem4

Private Declare Sub GetMem4 Lib "msvbvm60.dll" (Ptr As Any, RetVal As Long)
 
Public Sub PtrTest()
    Dim lngArr(1) As Long
    Dim lngPtr As Long, lngVal As Long
    
    lngArr(0) = 5
    lngArr(1) = 1000
    
    lngPtr = VarPtr(lngArr(0))
    
    GetMem4 ByVal lngPtr, lngVal
    Debug.Print lngVal  ' ouput is 5
    
    lngPtr = lngPtr + 4
    
    GetMem4 ByVal lngPtr, lngVal
    Debug.Print lngVal  ' output is 1000
    
End Sub

[Logophobic]

GetMem... hm, that is most definitely indirection, and certainly worth knowing.

[Joacim Andersson]

I don't really see the advantage of calling the undocumented GetMemN/PytMemN functions instead of using CopyMemory since they internally calls CopyMemory (or RtlMoveMemory if you wish) anyway.

[Agilaz]

GetMem doesn't call CopyMemory. it doesn't call ANY other APis and should be much faster than CopyMemory. look at the link i posted above.

[Joacim Andersson]

Well, I don't see how they would be faster... The assembly code show what happens when you call them, and that is the same thing you would get with CopyMemory. The only difference is that with CopyMemory you can specify the number of bytes to copy as an argument instead of having 4 different function calls. I don't see how you can tell from that assembly code that the functions isn't simply wrappers for CopyMemory. Even though they might not call CopyMemory the result is the same as if you did. How does that make them faster?

If you want to use them then please go ahead and do so. The first time I noticed these functions a few years back I personally voted not to use them simply because they are undocumented and does the exact same thing as CopyMemory does.

[Merri]

The problem is that I can't my head over to how to find the pointer to a Long variable; I can access the value alright, I know where that resides, but I want to be able to change this place by changing another Long variable. It seems it would be easiest to make a SAFEARRAY, although I'd have just one item in it.

What I'm trying to do is to have a fast bitwise access over a Single variable, but I don't want to use CopyMemory within the actual function because that is slow. I also need to have the result as a Single, so I'd have to use two CopyMemory calls, but doing these is by order of magnitude slower than the actual simple bitwise math that I want to do. And I'm looking for performance.

I simply want to fake a Long variable to point to the Single variable by changing the pointer value of another Long variable.

[Joacim Andersson]

Is VarPtr what you're looking for????

[Merri]

No, it only returns where the actual value is located at. Anyways, I ended up using a SAFEARRAY instead. Here is the code I've been playing with:

Option Explicit
 
Private Const SA_DIMENSIONS = 0
Private Const SA_BYTES = 1
Private Const SA_LOCKS = 2
Private Const SA_PTR = 3
Private Const SA_ELEMENTS = 4
Private Const SA_LBOUND = 5
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As Any, ByRef lpvSrc As Any, ByVal cbLen As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
 
Private SA1D(5) As Long
Private lngSQR() As Long
Private lngSQRSngPtr As Long
Private lngSQRDblPtr As Long
Private BitShiftDbl(1) As Long
 
Public Sub CleanSQR()
    CopyMemory ByVal VarPtrArray(lngSQR), 0&, 4&
End Sub
Public Sub InitSQR()
    SA1D(SA_DIMENSIONS) = 1
    SA1D(SA_BYTES) = 4
    SA1D(SA_ELEMENTS) = 2
    CopyMemory ByVal VarPtrArray(lngSQR), VarPtr(SA1D(0)), 4&
    BitShiftDbl(1) = &H80000000
End Sub
Public Function BabylonianSqr(ByVal Value As Single) As Single
    Dim sngPrev As Single, sngCur As Single
    sngCur = Value
    Do Until sngPrev = sngCur
        sngPrev = sngCur
        sngCur = 0.5 * (sngPrev + (Value / sngPrev))
    Loop
    BabylonianSqr = sngCur
End Function
Public Function SngSqr(ByVal Value As Single) As Single
    If lngSQRSngPtr <> 0 Then
        SA1D(SA_PTR) = lngSQRSngPtr
        lngSQR(0) = (lngSQR(0) \ 2) + &H1FC00000
        SngSqr = Value
    Else
        lngSQRSngPtr = VarPtr(Value)
        SA1D(SA_PTR) = lngSQRSngPtr
        lngSQR(0) = (lngSQR(0) \ 2) + &H1FC00000
        SngSqr = Value
    End If
End Function
Public Function DblSqr(ByVal Value As Double) As Double
    If lngSQRDblPtr <> 0 Then
        SA1D(SA_PTR) = lngSQRDblPtr
        If lngSQR(0) >= 0 Then
            lngSQR(0) = lngSQR(0) \ 2 Or BitShiftDbl(lngSQR(1) And &H1)
        Else
            lngSQR(0) = lngSQR(0) \ 2 Or BitShiftDbl(lngSQR(1) And &H1) Or &H40000000
        End If
        lngSQR(1) = (lngSQR(1) \ 2) + &H1FF80000
        DblSqr = Value
    Else
        lngSQRDblPtr = VarPtr(Value)
        SA1D(SA_PTR) = lngSQRDblPtr
        If lngSQR(0) >= 0 Then
            lngSQR(0) = lngSQR(0) \ 2 Or BitShiftDbl(lngSQR(1) And &H1)
        Else
            lngSQR(0) = lngSQR(0) \ 2 Or BitShiftDbl(lngSQR(1) And &H1) Or &H40000000
        End If
        lngSQR(1) = (lngSQR(1) \ 2) + &H1FF80000
        DblSqr = Value
    End If
End Function

SngSqr is 1.7 times faster than the native Sqr The purpose of the function isn't to give a perfect result, instead work faster and give something that is close enough (good enough for games, for example). At maximum the result is 6% off of the correct value.


Edit
Code updated to handle negative numbers correctly.

Edit #2
Removed negative number check; slowed down the code too much. However, currently SngSqr is two times faster than Sqr

[ccoder]

I thought I should add one more point to this thread.

True pointers are typed so that the compiler knows how to handle the data that they reference. The pointers created using StrPtr, VarPtr and ObjPtr are not. They simply point to an address in memory.

To illustrate this point I modified the code that I posted earlier. The test string is now in a UDT and has a fixed length. I chose this method because CopyMemory will convert the string to ANSI during the copy process making it easier to see what I am attempting to explain. Also, the UDT contains the actual contents of the string whereas it would contain the BSTR (a long) of a regular string and we won't see any conversion take place.

Here is the code

'Drop this code in a new project form to test
 
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" _
                Alias "RtlMoveMemory" (xDest As Any, _
                                       xSource As Any, _
                                       ByVal nbytes As Long)
Private Type dclTestUDT
        flag    As Integer
        testStr As String * 5
End Type
Private Sub Form_Load()
  Dim testUDT   As dclTestUDT
  Dim vPtr      As Long
  Dim memByte() As Byte
  Dim indx      As Integer
  Dim arryLen   As Integer
  
  arryLen = Len(testUDT)
  ReDim memByte(arryLen - 1)
  
  testUDT.flag = 101
  testUDT.testStr = "test1"
  
  Debug.Print "Test 1 - UDT copied to byte array"
  CopyMemory memByte(0), testUDT, arryLen
  Debug.Print "memByte contains: ";
  For indx = 0 To arryLen - 1
      Debug.Print memByte(indx);
  Next indx
  Debug.Print
  
  testUDT.flag = 202
  testUDT.testStr = "test2"
  vPtr = VarPtr(testUDT)
  
  Debug.Print "Test 2 - UDT copied to byte array via pointer"
  CopyMemory memByte(0), ByVal vPtr, arryLen
  Debug.Print "memByte contains: ";
  For indx = 0 To arryLen - 1
      Debug.Print memByte(indx);
  Next indx
 
End Sub

The runtime output is

Test 1 - UDT copied to byte array
memByte contains:  101  0  116  101  115  116  49 
Test 2 - UDT copied to byte array via pointer
memByte contains:  202  0  116  0  101  0  115

As you can see, CopyMemory 'understands' the data that is being moved when the copying the UDT and converted the UTF string to an ANSI string, but when referencing the UDT with the typeless pointer, it simply copied 7 contiguous bytes of memory.

[Merri]

That is only a normal VB behavior with API; it is VB that understands it, not CopyMemory. VB sees that you're passing UDT that contains strings, so it makes a new copy of the whole UDT and converts the string parts into ANSI for "backwards compatibility". So you're copying a copy of the UDT with CopyMemory, not the actual UDT, and the pointer passed for CopyMemory is the pointer of the copy of the UDT. In the other hand the result of VarPtr, Long, is seen by VB as just that, a Long variable, and no conversion takes place because it avoids the "intelligency" of VB.

None of this really helps with the actual issue: there just is no way to avoid the use of a SAFEARRAY in this case. I'd mostly like to avoid SAFEARRAY because it is a slow structure (data is found behind a pointer in header of a pointer of the variable). I just can't make two plain variables be pointed to the same location in memory.

[Logophobic]

Is this all you need?

Private x As Long
 
Private Sub Command1_Click()
  Call MySub(x)
End Sub
 
Private Sub MySub(ByRef y As Long)
  x = 3
  y = 4
  MsgBox "x = " & x
End Sub

Nevermind... I realize you need them to be of different types.

[Joacim Andersson]

I'd mostly like to avoid SAFEARRAY because it is a slow structure

All arrays in VB are implemented as SAFEARRAYs.

[Merri]

That's why I didn't want to use an array in the first place because a Long variable is the same size as a Single; I only need a normal variable. But the only current (known) way to go is to use a SAFEARRAY. Of course, the only reason I'm even bothering on it is the possible speed gain, because a real simple function such as SngSqr would really gain of anything that is faster and a normal variable is faster than an array variable.

I just got the crasiest idea. Variant. It is slow, but you can fake it to be another kind of variable simply by changing a number. Hmm... nope, it'd require more initialization and coercion so there would be no speed gain.

[Agilaz]

Merri i think i've found a solution. it's not exactly what you want but i think it's pretty close and fast.

ok, let's take the SngSqr function as an example:

Public Function SngSqr(ByVal Value As Single) As Single

this is what you have to call.

Public Function SngSqr(ByVal Value As Long) As Single

this is what you would like to call but you can't because VB would convert Value from single to long, right?

i found a way to replace this sub...

Public Sub SngSqr(value As Single, sngResult As Single)
    Dim sngVal As Single
    sngVal = value
 
    If lngSQRSngPtr <> 0 Then
        SA1D(SA_PTR) = lngSQRSngPtr
        lngSQR(0) = (lngSQR(0) \ 2) + &H1FC00000
        sngResult = sngVal
    Else
        lngSQRSngPtr = VarPtr(sngVal)
        SA1D(SA_PTR) = lngSQRSngPtr
        lngSQR(0) = (lngSQR(0) \ 2) + &H1FC00000
        sngResult = sngVal
    End If
End Sub

with this one

Public Sub SngSqrNEW(lngValue As Long, lngResult As Long)
 
    lngResult = (lngValue \ 2) + &H1FC00000
    
End Sub

without any data conversion. needless to say that the second one is faster

it works by simply replacing both subs at runtime. ok, it's a dirty hack but i think you'll like it

i attached a small demo project to show how it works.

but this method has a few drawbacks as well. it currently only works with Subs, not with functions and it doesn't work in the IDE. you have to compile the code. and if you do something wrong your app will crash.

i will do some more testing and try to make it work with functions and probably in the IDE too.

[ccoder]

That is only a normal VB behavior with API; it is VB that understands it, not CopyMemory. VB sees that you're passing UDT that contains strings, so it makes a new copy of the whole UDT and converts the string parts into ANSI for "backwards compatibility".

I wasn't aware of this until I was Googling for some solutions to your problem. I saw something about VB doing the conversion on UDTs passed to .dlls but hadn't put 2 and 2 together until your post. Since the parameters are the same and in the same order, I always assumed CopyMemory was like C's memcpy function: memcpy(obuff, (char *)start_ptr, ssize);

This explains why I sometimes see comments about CopyMemory being slow although it appears that VB has a lot to do with that.

[Merri]

CopyMemory and all API function calls are slowish; the perfect example for this could be SetPixel and GetPixel. What these functions do? Set a single pixel or read one. How long it takes to handle a few thousand pixels with these functions? About a second. For comparison, you can handle the entire screen well enough within a second if you have access to it as an array (and the program is compiled).

The more an API function can do at once, the more value you get for calling it: once the API function is rolling what it does, it is fast. In the case of SetPixel and GetPixel most of the time is spent with everything else but the most important thing. A lot of "useless" calls are done. This holds true for all API functions.

I don't use CopyMemory to move stuff within an array, even if the task is as big as moving all items left or right by one step or more. This because CopyMemory is hardly any faster than compiled VB6 code with all optimizations turned on; and with small amount of items CopyMemory is slower.

For a practical example, if I used CopyMemory within the SngSqr function, the function would be much slower.


Agilaz: the code is interesting. I'm 99% sure the crashes under IDE are caused by the fact you don't restore the original state at any point. This simply corrupts memory and we have a lovely crash. Although, it might be within IDE/p-code the functions are also located differently.

For some reason I don't today have much interest into coding, guess I slept badly.

[Merri]

I made an easy-to-use revision of Agilaz code, I got it kind of working (it doesn't crash IDE), but SngSqr returns wrong results at the moment. I had to go to work so I couldn't read the whole code and fix it, I guess I have a minor error somewhere (pass wrong memory address or similar). However, the good thing is that I have no crash under IDE

[Agilaz]

i only get crash in the IDE when i use the ReplaceSubByCopy method. ReplaceSubByJmp doesn't crash it but it seems to have no effect at all.

one of the problems seems to be that "AddressOf somesub" doesn't return a pointer to the real sub. instead it returns a pointer to a small sub which is calling somesub. so the real address of somesub must be somewhere in this caller sub. unfortunately i don't have time to analyze it at the moment (have to go to work).

[Merri]

My current code:

Option Explicit
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As Any, ByRef lpvSrc As Any, ByVal cbLen As Long)
 
Private Type FUNCTION_COPY
    OldMemory() As Byte
    Address As Long
    Removed As Boolean
End Type
 
Private FunctionCopy() As FUNCTION_COPY
 
Public Function AddFunction(ByVal hWnd As Long, ByVal DestAddressOf As Long, ByVal SrcAddressOf As Long, ByVal SrcAfterAddressOf As Long) As Long
    Dim lngNewIndex As Long, blnArrayInit As Boolean
    Dim lngProcessID As Long, lngProcessHandle As Long, lngWritten As Long
    
    GetWindowThreadProcessId hWnd, lngProcessID
    lngProcessHandle = OpenProcess(&H1F0FFF, 0&, lngProcessID)
    If lngProcessHandle = 0 Then AddFunction = -1: Exit Function
    
    blnArrayInit = Not ((Not FunctionCopy) = -1&)
    On Error Resume Next: Debug.Assert CLng(0.1): On Error GoTo 0
    If blnArrayInit Then lngNewIndex = UBound(FunctionCopy) + 1
    ReDim Preserve FunctionCopy(lngNewIndex)
    With FunctionCopy(lngNewIndex)
        .Address = DestAddressOf
        ReDim .OldMemory(Abs(SrcAfterAddressOf - SrcAddressOf) - 1)
        ReadProcessMemory lngProcessHandle, ByVal .Address, ByVal VarPtr(.OldMemory(0)), UBound(.OldMemory) + 1, lngWritten
        WriteProcessMemory lngProcessHandle, ByVal .Address, ByVal SrcAddressOf, ByVal UBound(.OldMemory) + 1, lngWritten
        CloseHandle lngProcessHandle
    End With
    AddFunction = lngNewIndex
End Function
Public Function RemoveFunction(ByVal hWnd As Long, ByVal Index As Long) As Boolean
    Dim blnArrayInit As Boolean, lngA As Long
    Dim lngProcessID As Long, lngProcessHandle As Long, lngWritten As Long
    blnArrayInit = Not ((Not FunctionCopy) = -1&)
    If Not blnArrayInit Then Exit Function
    If Index < 0 Or Index > UBound(FunctionCopy) Then Exit Function
    If FunctionCopy(Index).Removed Then Exit Function
    
    GetWindowThreadProcessId hWnd, lngProcessID
    lngProcessHandle = OpenProcess(&H1F0FFF, 0&, lngProcessID)
    If lngProcessHandle = 0 Then Exit Function
    
    With FunctionCopy(Index)
        WriteProcessMemory lngProcessHandle, ByVal .Address, ByVal VarPtr(.OldMemory(0)), ByVal UBound(.OldMemory) + 1, lngWritten
        CloseHandle lngProcessHandle
        Erase .OldMemory
        .Removed = True
    End With
    
    For lngA = 0 To UBound(FunctionCopy)
        If Not FunctionCopy(lngA).Removed Then Exit For
    Next lngA
    If lngA > UBound(FunctionCopy) Then Erase FunctionCopy
    
    RemoveFunction = True
End Function

Option Explicit
 
Public Sub SngSqr(ByVal sngValue As Single, ByRef sngResult As Single)
    If sngValue > 0 Then sngResult = (sngValue / 2) + &H1FC00000
End Sub
Public Sub SngSqrREAL(ByVal lngValue As Long, ByRef lngResult As Long)
    If lngValue > 0 Then lngResult = (lngValue \ 2) + &H1FC00000
End Sub
Public Sub SngSqrEND()
    
End Sub

Private Sub Command1_Click()
    Dim sngTest As Single, sngResult As Single
    
    AddFunction Me.hWnd, AddressOf SngSqr, AddressOf SngSqrREAL, AddressOf SngSqrEND
    
    SngSqr 0, sngResult
    MsgBox sngResult
    
    RemoveFunction Me.hWnd, 0
End Sub

It is safe under IDE, because it restores the original state. I believe if you under IDE go replacing the data within the pointers AddressOf returns, you're making whatever there is in the IDE mode corrupt and that's when you go crash boom bang.

So, time to analyze what there is in the AddressOf the IDE returns...

[Agilaz]

this is the code at the address returned by AddressOf SngSqr...

:00000000 A1400BAB00              mov eax, dword ptr [00AB0B40]
:00000005 0BC0                    or eax, eax
:00000007 7413                    je 0000001C
:00000009 B8E016A90F              mov eax, 0FA916E0
:0000000E FFD0                    call eax
:00000010 83F802                  cmp eax, 00000002
:00000013 7407                    je 0000001C
:00000015 B89A2C1E00              mov eax, 001E2C9A
:0000001A FFE0                    jmp eax
:0000001C 33C0                    xor eax, eax
:0000001E C20800                  ret 0008

replacing this code doesn't seem to have any effect. the IDE still executes the original code instead of the new one. maybe this code is only ment to be called from outside when you pass a function pointer to an API for for a callback procedure but not if you call a function or sub inside the program itself.

so we have to find the address of the real SngSqr sub.
if we look at the assembly code then we see that the caller function calls something at address 0FA916E0 and/or jumps to address 001E2C9A. one of those addresses could be the location of the real sub. or they are just other IDE related functions that call the real sub.

oh well, looks like a lot of disassembling/debugging work is waiting

[Agilaz]

i've got it

the pointer to the real function is here:

:00000015 B89A2C1E00              mov eax, 001E2C9A

and here's my new code.
works in the complied version and in the IDE (stable). no need to restore the old sub and pretty easy to use. the subs replace themself the first time they are called, but you can do it explicitly too. the subs can be in any order anywhere in the module.

hmm...this technique can probably be used to run precompiled assembly code stored in a byte array without using CallWindowProc

so far everything seems to work stable but of course it needs more testing.

Option Explicit
 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As Any, ByRef lpvSrc As Any, ByVal cbLen As Long)
 
 
Private Sub CopyProcMemory(lngPtrDes As Long, lngPtrSrc As Long, lngLen As Long)
    Dim pid As Long, phandle As Long, bwritten As Long
     
    pid = GetCurrentProcessId
    phandle = OpenProcess(&H1F0FFF, False, pid)
    If phandle = 0 Then
        MsgBox "Ooops!"
        Exit Sub
    End If
    Call WriteProcessMemory(phandle, ByVal lngPtrDes, ByVal lngPtrSrc, ByVal lngLen, bwritten)
    CloseHandle phandle
    
End Sub
 
 
Public Sub ReplaceSubByJmp(lngFPtrOrg As Long, lngFPtrNew As Long)
    Dim bytArr(4) As Byte, lngOffset As Long
    Dim IsIDE As Boolean
    
    ' are we running in IDE mode?
    On Error Resume Next
    Debug.Print 1 / 0
    IsIDE = Err.Number
    On Error GoTo 0
    
    If IsIDE Then
        CopyMemory lngFPtrOrg, ByVal lngFPtrOrg + &H16, ByVal 4
        CopyMemory lngFPtrNew, ByVal lngFPtrNew + &H16, ByVal 4
    End If
                   
    lngOffset = lngFPtrNew - lngFPtrOrg - 5
    
    bytArr(0) = &HE9 ' Assembly code for JMP (FAR)
    
    'add the offset to the new sub to the array
    CopyMemory bytArr(1), lngOffset, ByVal 4
    
    CopyProcMemory lngFPtrOrg, VarPtr(bytArr(0)), 6
 
End Sub

Option Explicit
 
Private Type DoubleLong
    lng1 As Long
    lng2 As Long
End Type
 
Public Sub SngSqrNEW(lngValue As Long, lngResult As Long)
 
    lngResult = (lngValue \ 2) + &H1FC00000
    
End Sub
 
Public Function BabylonianSqr(ByVal value As Single) As Single
    Dim sngPrev As Single, sngCur As Single
    
    sngCur = value
    Do Until sngPrev = sngCur
        sngPrev = sngCur
        sngCur = 0.5 * (sngPrev + (value / sngPrev))
    Loop
    BabylonianSqr = sngCur
End Function
 
 
Public Sub SngSqr(value As Single, sngResult As Single)
 
    ReplaceSubByJmp AddressOf SngSqr, AddressOf SngSqrNEW
    SngSqr value, sngResult
    
    MsgBox "replaced SngSqr!"
End Sub
 
Public Sub DblSqr(dblValue As Double, dblResult As Double)
 
    ReplaceSubByJmp AddressOf DblSqr, AddressOf DblSqrNEW
    DblSqr dblValue, dblResult
 
End Sub
 
Public Sub DblSqrNEW(dblValue As DoubleLong, dblResult As DoubleLong)
    Dim BitShiftDbl(1) As Long
    BitShiftDbl(1) = &H80000000
    
    If dblValue.lng1 >= 0 Then
        dblResult.lng1 = dblValue.lng1 \ 2 Or BitShiftDbl(dblValue.lng2 And &H1)
    Else
        dblResult.lng1 = dblValue.lng1 \ 2 Or BitShiftDbl(dblValue.lng2 And &H1) Or &H40000000
    End If
    dblResult.lng2 = (dblValue.lng2 \ 2) + &H1FF80000
End Sub

Option Explicit
 
Private Sub Command1_Click()
    Dim sngVal As Single
 
    SngSqr 20, sngVal
    MsgBox sngVal
End Sub
 
Private Sub Command2_Click()
    Dim dblVal As Double
    
    DblSqr 20, dblVal
    MsgBox dblVal
End Sub

[Merri]

There is one problem that I noticed earlier on but I thought you'd catch it sooner or later:

CopyProcMemory lngFPtrOrg, VarPtr(bytArr(0)), 6

The byte array has five bytes, yet the code is copying six. Is the sixth byte meant to be a zero? Now it might not always be.


Time for testing once I get home. One of the most interesting features with this code is that Variants could be used much much faster... I guess I'll try benchmarking IfVar function (a replacement of IIf).

[Merri]

Good news! It is working for functions as well!

Bad news: it seems to cause a bit problems, it makes variables a bit flawed, although this problem can be worked around. I believe use of CVar or CLng or whatever is appropriate for the datatype in case will resolve the problem.

Another problem is that if I pass a constant in (and maybe invalid datatype) then the code will crash.


Attached is a benchmarking test for DblSqr and IfVar. If you start simplifying the code that does benchmarking of IfVar, you'll soon notice some very odd things happening when you use the varResult variable...

The thread is almost resolved, I guess the only thing remaining is the need to take a look into what is the problem with the function return variable.

[Agilaz]

errrm, that's a bug.

of course it has to be

CopyProcMemory lngFPtrOrg, VarPtr(bytArr(0)), 5

thanks for finding that one

[Agilaz]

getting functions to work will always be tricky because functions return different datatypes in differtent ways.

i'll analyze that in more details as soon as i have time to.

[Agilaz]

Bad news: it seems to cause a bit problems, it makes variables a bit flawed, although this problem can be worked around. I believe use of CVar or CLng or whatever is appropriate for the datatype in case will resolve the problem.

i know what the problem with the IfVar function is.

varResult = IfVar(True, varTest1, varTest2)

this doesn't 'copy' varTest1 to varResult. instead you make varResult point to the same data as varTest1. that's fine until you assign a new value to varResult or varTest1. if you change the value of varTest1 for example

varTest1 = "blabla"

then VB will free memory where the old data was located and allocates new memory for the new value. but varResult still points to the memory location of the old data. so varResult points to unallocated memory or memory allocated for another purpose.

the solution is to 'clean' varResult. you should know that from your safearray trick

Public Sub CleanVariant(varVar As Variant)
    ReplaceSub AddressOf CleanVariant, AddressOf CleanVariantREAL
    CleanVariant varVar
End Sub
Public Sub CleanVariantREAL(varVar As Long128)
    varVar.LowLow = 0
    varVar.UpLow = 0
End Sub
 
Public Function ifVarTest()
    Dim varVal1 As Variant, varVal2 As Variant, varResult As Variant
    
    varVal1 = "hello"
    varVal2 = "world"
    
    'CleanVariant varResult
    varResult = IfVar(True, varVal1, varVal2)
    
    'CleanVariant varResult
    varResult = IfVar(True, varVal1, varVal2)
    
    'CleanVariant varResult
    varVal1 = "oooooooooooooooooops"
    
    Debug.Print varResult
    'CleanVariant varResult
End Function

ifVarTest will crash. uncomment the CleanVariant calls and it will work.

so far the only real limitation i've found for replacing functions is that you can't replace a function that returns a floating point variable with a function that returns a non floating point variable.

here is another code snipplet that might be useful

Public Function lptr2Long(ByVal lPtr As Long) As Long
    ReplaceSubByJmp AddressOf modSQRT.lptr2Long, AddressOf modSQRT.lptr2LongREAL
    lptr2Long = lptr2Long(lPtr)
End Function
Public Function lptr2LongREAL(lPtr As Long) As Long
    lptr2LongREAL = lPtr
End Function
Public Sub lpttest()
    Dim lngVal As Long, lngPtr As Long
    
    lngVal = 30
    lngPtr = VarPtr(lngVal)
    Debug.Print lptr2Long(lngPtr)
End Sub

[Agilaz]

here's a new project. it supports SHORT and FAR jumps. SORT jumps are a bit faster

the project also incudes an example how to use this technique to load DLLs and call APIs at runtime. this method is faster than VBs standard API call method as it doesn't have VBs overhead. the only drawback: there is no automatic UNICODE -> ANSI conversion if you pass strings to an API. errm...and err.LastDllError will most likely not work.

and last but not least it shows how to use this techniqe to run a compiled assembly function stored in a file. it's probably better to store it as a resource but i was to lazy to implement that :P

[Merri]

the only drawback: there is no automatic UNICODE -> ANSI conversion if you pass strings to an API.

I consider this a major advantage over the native method of calling API. Finally I can use the wide version API calls easily without StrPtr

Guess I'll be updating my Unicode user controls sooner or later.