Hace mucho tiempo que no toqueteaba a mi querido VB6 :P Así que aquí estoy con otra primicia chicoooos!!! :laugh: :laugh:
Este modulito que os presento permite trabajar con la memoria sin el uso de ningún API!!!!
Eso sí! Tenéis que desactivar la comprobación de límites de matrices :P Os pongo una foto:
(http://i44.tinypic.com/nbouww.png)
Además solo funciona compilado, como muchos otros hacks el IDE no permite tocar demasiado :-\ :xD
Y como todos estáis deseando aquí viene el sencillo pero eficaz código :)
'---------------------------------------------------------------------------------------
' Module : mMemory
' Author : Karcrack
' Date : 20/09/2011
' Purpose : Work with memory withouth using any API
' History : 20/09/2011 First cut .....................................................
'---------------------------------------------------------------------------------------
Option Explicit
Private bvHack(0) As Byte
Private lHackDelta As Long
Private bInitialized As Boolean
Public Function Initialize() As Boolean
On Error GoTo Error_Handle
bvHack(-1) = bvHack(-1) 'Error check
lHackDelta = VarPtr(bvHack(0))
Initialize = True
bInitialized = Initialize
Exit Function
Error_Handle:
If Err.Number = 9 Then Debug.Print "Remember to tick 'Remove array boundary check' and compile before using"
End
End Function
Public Function GetByte(ByVal lPtr As Long) As Byte
If bInitialized Then GetByte = bvHack(lPtr - lHackDelta)
End Function
Public Function GetWord(ByVal lPtr As Long) As Integer
If bInitialized Then GetWord = MakeWord(GetByte(lPtr + &H0), GetByte(lPtr + &H1))
End Function
Public Function GetDWord(ByVal lPtr As Long) As Long
If bInitialized Then GetDWord = MakeDWord(GetWord(lPtr + &H0), GetWord(lPtr + &H2))
End Function
Public Sub PutByte(ByVal lPtr As Long, ByVal bByte As Byte)
If bInitialized Then bvHack(lPtr - lHackDelta) = bByte
End Sub
Public Sub PutWord(ByVal lPtr As Long, ByVal iWord As Integer)
If bInitialized Then Call PutByte(lPtr + &H0, iWord And &HFF): Call PutByte(lPtr + &H1, (iWord And &HFF00&) \ &H100)
End Sub
Public Sub PutDWord(ByVal lPtr As Long, ByVal lDWord As Long)
If bInitialized Then Call PutWord(lPtr + &H0, IIf(lDWord And &H8000&, lDWord Or &HFFFF0000, lDWord And &HFFFF&)): Call PutWord(lPtr + &H2, (lDWord And &HFFFF0000) \ &H10000)
End Sub
Private Function MakeWord(ByVal loByte As Byte, ByVal hiByte As Byte) As Integer '[http://www.xbeat.net/vbspeed/c_MakeWord.htm#MakeWord02]
If hiByte And &H80 Then
MakeWord = ((hiByte * &H100&) Or loByte) Or &HFFFF0000
Else
MakeWord = (hiByte * &H100) Or loByte
End If
End Function
Private Function MakeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long '[http://www.xbeat.net/vbspeed/c_MakeDWord.htm#MakeDWord05]
MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&)
End Function
Si saco un poco de tiempo libre hago una clase chuli piruli con este mismo sistema :)
Happy codin' ::)