Attribute VB_Name = "mod_PeekPoke"
' Copyright (C) 2004-2007 Jan Vorel
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


Option Explicit
Option Base 0

Private Declare Function lstrcpynA Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long

Public Function PeekSAnsi(ByVal ptrChar As Long, Optional ByVal MaxLength As Long = -1&) As String
  Dim xLong1 As Long
  
  'Debug.Print "peek", MaxLength
  If MaxLength = -1& Then MaxLength = &HFFFF&
  If Not ptrChar = 0& Then
    xLong1 = lstrlenA(ptrChar)
    If xLong1 > MaxLength Then xLong1 = MaxLength
    PeekSAnsi = String(xLong1 + 1&, vbNullChar)
    Call lstrcpynA(PeekSAnsi, ptrChar, xLong1 + 1&)
    PeekSAnsi = Left(PeekSAnsi, xLong1)
    'Debug.Print "peekdone"
    End If
  End Function

Public Function PeekSWide(ByVal ptrChar As Long, Optional ByVal MaxLength As Long = -1&) As String
  Dim xIntA1(0) As Integer
  
  If MaxLength = -1& Then MaxLength = &HFFFF&
  If Not ptrChar = 0& Then
    Do Until MaxLength = 0&
      Call RtlMoveMemory(xIntA1(0), ByVal ptrChar, 2&)
      If xIntA1(0) = 0 Then
        Exit Do
        Else
        PeekSWide = PeekSWide + ChrW(xIntA1(0))
        If ptrChar = &H7FFFFFFF Then
          ptrChar = &H80000001
          ElseIf ptrChar = &H7FFFFFFE Then
          ptrChar = &H80000000
          Else
          ptrChar = ptrChar + 2&
          End If
        MaxLength = MaxLength - 1&
        End If
      Loop
    End If
  End Function

Public Function PeekS(ByVal ptrChar As Long, Optional ByVal MaxLength As Long = -1&) As String
  If IsUnicode Then
    PeekS = PeekSWide(ptrChar, MaxLength)
    Else
    PeekS = PeekSAnsi(ptrChar, MaxLength)
    End If
  End Function

Public Sub PokeS(ByVal ptrMem As Long, ByVal xChar1 As String, ByVal MaxSize As Long, Optional ByVal NullByteExtraReserved As Boolean = False)
  Dim xLong1 As Long
  'Dim xLong2 As Long
  
  xLong1 = Len(xChar1)
  MaxSize = MaxSize - 1& - CLng(NullByteExtraReserved)
  If xLong1 > MaxSize Then
    xChar1 = Left(xChar1, MaxSize)
    xLong1 = MaxSize
    Else
    xLong1 = xLong1 + 1&
    End If
  xChar1 = xChar1 & vbNullChar
  If IsUnicode Then
    Call RtlMoveMemory(ByVal ptrMem, ByVal StrPtr(xChar1), xLong1 * 2&)
    Else
    Call RtlMoveMemory(ByVal ptrMem, ByVal xChar1, xLong1)
    End If
  End Sub

Public Function LocalAllocFromString(ByVal xChar1 As String) As Long ', Optional ByVal FixedPos As Boolean = True) As Long
  Dim xLong1 As Long
  
  xChar1 = xChar1 & vbNullChar
  xLong1 = Len(xChar1) * (1& - CLng(IsUnicode))
  
  LocalAllocFromString = LocalAlloc(0&, xLong1)
  If Not LocalAllocFromString = 0& Then
    If IsUnicode Then
      Call RtlMoveMemory(ByVal LocalAllocFromString, ByVal StrPtr(xChar1), xLong1)
      Else
      Call RtlMoveMemory(ByVal LocalAllocFromString, ByVal xChar1, xLong1)
      End If
    End If
  End Function


' Works with max &h7ffffffff (unsigned / >=0)
Public Sub PokeL(ByVal ptrMem As Long, ByVal Value As Long)
  'Dim xLong1 As Long
  
  'Debug.Print "Put ", Value, ptrMem
  Call RtlMoveMemory(ByVal ptrMem, ByVal VarPtr(Value), 4&)
  'Call RtlMoveMemory(ByVal VarPtr(xLong1), ByVal ptrMem, 4&)
  'If xLong1 = Value Then
  '  Debug.Print "    ok"
  '  Else
  '  Debug.Print "    fail: ", xLong1
  '  End If
  ''Call USLongAdd(ptrMem, 4&)
  End Sub

' Works with max &h7ffffffff (unsigned / >=0)
Public Function PeekL(ByVal ptrMem As Long) As Long
  Call RtlMoveMemory(ByVal VarPtr(PeekL), ByVal ptrMem, 4&)
  End Function


' Works with max &hfffffffff for Value/ToAdd (and output Value)
Public Sub USLongAdd(ByRef Value As Long, ByRef ToAdd As Long)
  Dim xLong1 As Long
  
  xLong1 = (((Value And &HFF000000) \ &H1000000) And &HFF&) + (((ToAdd And &HFF000000) \ &H1000000) And &HFF&) '<- seperate highest 8 bits (1byte)
  Value = (Value And &HFFFFFF) + (ToAdd And &HFFFFFF) '<- add
  xLong1 = xLong1 + Value \ &H1000000 '<- add overflows to seperated higher 8 bits (1byte)
  Value = ((xLong1 And &H7F&) * &H1000000 + (Value And &HFFFFFF)) Or (&H80000000 * (xLong1 \ &H80&))
  '        re-add all but highest bit     / Values (w/o bits just filtered)
  '                                                                   Re-Adding highest bit
  'USLongAdd = Value
  End Sub

