Full memory block object with default data types but also pascal and C strings. It allows for very dynamic and flexible memory access matching any data block with known fields and size. The block can be resized at any time. If larger, data are preserved and extra space is cleared. If smaller, data will be truncated.
Note that the StringValue getter requires the length of the string to be retrieved. If set to the memory block size with Offset = 0, the entire block can be read at once. If the offset is not 0 and the length exceeds the memory block, no error occurs. Instead, the remaining part of the block is read. If the CStringValue getter does not encounter a null character, the block is read until the end and a null character is added.
TODO:
1. LittleEndian property has not been implemented yet.
2. Possibility to point to existing block.
I have not fully tested the string values so any corrections/improvements are welcome.
Code: Select all
/'
---------------------------------------------------------------------
Copyright (C) 2017-2018 Munair <contact@basicstudio.org>
---------------------------------------------------------------------
This library is free software; you can redistribute it and/or modify
it under the terms of the Modified GNU Library General Public
License either version 2.0 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 Modified GNU Library General Public License for more details:
http://www.basicstudio.org/mlgpl.html
http://www.basicstudio.org/mlgpl.txt
---------------------------------------------------------------------
'/
REM bsinfo TYPE=bsSYSTEM NAME=MemoryBlock
type TMemoryBlock extends object
private:
'{OBJECTS}
'{PROPERTIES}
address_ as any ptr
lendian_ as boolean
maxaddress_ as any ptr
offset_ as uinteger
size_ as uinteger
'{METHODS}
declare function Alloc() as boolean
declare sub IncOffset(byval aSize as uinteger)
declare function IOptr as any ptr
declare sub SetMaxAddress()
'{EVENTS}
protected:
'{OBJECTS}
'{PROPERTIES}
'{METHODS}
'{EVENTS}
public:
'{OBJECTS}
'{PROPERTIES}
declare property Address() as any ptr
declare property ByteValue() as byte
declare property ByteValue(byval value as byte)
declare property BooleanValue() as boolean
declare property BooleanValue(byval value as boolean)
declare property CStringValue() as string
declare property CStringValue(byref value as string)
declare property DoubleValue() as double
declare property DoubleValue(byval value as double)
declare property IntegerValue() as integer
declare property IntegerValue(byval value as integer)
declare property LittleEndian() as boolean
declare property LittleEndian(byval value as boolean)
declare property LongValue() as long
declare property LongValue(byval value as long)
declare property LongIntValue() as longint
declare property LongIntValue(byval value as longint)
declare property Offset() as uinteger
declare property Offset(byval value as uinteger)
declare property PString() as string
declare property PStringValue() as string
declare property PStringValue(byref value as string)
declare property ShortValue() as short
declare property ShortValue(byval value as short)
declare property SingleValue() as single
declare property SingleValue(byval value as single)
declare property Size() as uinteger
declare property Size(byval value as uinteger)
declare property StringValue(byval length as uinteger) as string
declare property StringValue(value as string)
declare property UByteValue() as ubyte
declare property UByteValue(byval value as ubyte)
declare property UIntegerValue() as uinteger
declare property UIntegerValue(byval value as uinteger)
declare property ULongValue() as ulong
declare property ULongValue(byval value as ulong)
declare property ULongIntValue() as ulongint
declare property ULongIntValue(byval value as ulongint)
declare property UShortValue() as ushort
declare property UShortValue(byval value as ushort)
'{METHODS}
'{EVENTS}
'{CONSTRUCTORS}
declare constructor()
declare constructor(byval aSize as uinteger)
declare destructor()
end type
' --- TESTING ---
declare sub ShowRecord(byref mb as TMemoryBlock)
' create a 56 bytes memory block
dim mb as TMemoryBlock = TMemoryBlock(56)
' Add data to the memory block at offset 0. The pointer increments
' automatically each time data is added.
mb.CStringValue = "Jon Cavendish"
mb.UShortValue = 32
mb.CStringValue = "Clairestreet 25"
mb.CStringValue = "Bainsetown"
mb.CStringValue = "Utopia Land"
' point to first record
mb.Offset = 0
ShowRecord(mb)
' resize the block
mb.Size = 112
' point to second data segment
mb.Offset = 56
' add data
mb.CStringValue = "Mary Cavendish"
mb.UShortValue = 39
mb.CStringValue = "Oddstreet 12"
mb.CStringValue = "Mirkstown"
mb.CStringValue = "Utopia Bay"
' show second record
mb.Offset = 56
ShowRecord(mb)
sleep
end
sub ShowRecord(byref mb as TMemoryBlock)
' retrieve data
print "Name: "; mb.CStringValue
print "Age: "; mb.UShortValue
print "Address: "; mb.CStringValue
print "City: "; mb.CStringValue
print "Country: "; mb.CStringValue
print
end sub
' --- END TESTING ---
constructor TMemoryBlock()
address_ = CAllocate(1, 0)
size_ = 0
offset_ = 0
SetMaxAddress()
end constructor
constructor TMemoryBlock(byval aSize as uinteger)
address_ = CAllocate(1, aSize)
size_ = aSize
offset_ = 0
SetMaxAddress()
end constructor
destructor TMemoryBlock()
Deallocate(address_)
end destructor
property TMemoryBlock.Address() as any ptr
return address_
end property
property TMemoryBlock.ByteValue() as byte
if not Alloc then
exit property
end if
dim result as byte = peek(byte, IOptr)
IncOffset(SizeOf(byte))
return result
end property
property TMemoryBlock.ByteValue(byval value as byte)
if Alloc then
poke byte, IOptr, value
IncOffset(SizeOf(byte))
end if
end property
property TMemoryBlock.BooleanValue() as boolean
if not Alloc then
exit property
end if
dim result as boolean = peek(boolean, IOptr)
IncOffset(SizeOf(boolean))
return result
end property
property TMemoryBlock.BooleanValue(byval value as boolean)
if Alloc then
poke boolean, IOptr, value
IncOffset(SizeOf(boolean))
end if
end property
property TMemoryBlock.CStringValue() as string
if not Alloc then
exit property
end if
dim result as string
dim b as ubyte
var a = IOptr
while a <= maxaddress_
b = peek(ubyte, a)
result += chr(b)
if b = 0 then
exit while
end if
a += 1
wend
dim l as uinteger = len(result)
if l then
IncOffset(l)
' add trailing 0 if not there
if b <> 0 then
result[l - 1] = 0
end if
end if
return result
end property
property TMemoryBlock.CStringValue(byref value as string)
if not Alloc then
exit property
end if
' string length
var l = len(value)
if l = 0 then
exit property
end if
' reserve an extra byte for the null character
var nonull = (value[l - 1] <> 0)
var a = IOptr
' reserve byte for null character
if nonull then
l += 1
end if
' check address range
if a + (l - 1) > maxaddress_ then
' segmentation fault
error 12
exit property
end if
' match string length
if nonull then
l -= 1
end if
' write the string
for i as ubyte = 0 to l - 1
poke ubyte, a + i, value[i]
next
' write null character if not present
if nonull then
poke ubyte, a + l, 0
l += 1
end if
IncOffset(l)
end property
property TMemoryBlock.DoubleValue() as double
if not Alloc then
exit property
end if
dim result as double = peek(double, IOptr)
IncOffset(SizeOf(double))
return result
end property
property TMemoryBlock.DoubleValue(byval value as double)
if Alloc then
poke double, IOptr, value
IncOffset(SizeOf(double))
end if
end property
property TMemoryBlock.IntegerValue() as integer
if not Alloc then
exit property
end if
dim result as integer = peek(integer, IOptr)
IncOffset(SizeOf(integer))
return result
end property
property TMemoryBlock.IntegerValue(byval value as integer)
if Alloc then
poke integer, IOptr, value
IncOffset(SizeOf(integer))
end if
end property
property TMemoryBlock.LittleEndian() as boolean
return lendian_
end property
property TMemoryBlock.LittleEndian(byval value as boolean)
lendian_ = value
end property
property TMemoryBlock.LongValue() as long
if not Alloc then
exit property
end if
dim result as long = peek(long, IOptr)
IncOffset(SizeOf(long))
return result
end property
property TMemoryBlock.LongValue(byval value as long)
if Alloc then
poke long, IOptr, value
IncOffset(SizeOf(long))
end if
end property
property TMemoryBlock.LongIntValue() as longint
if not Alloc then
exit property
end if
dim result as longint = peek(longint, IOptr)
IncOffset(SizeOf(longint))
return result
end property
property TMemoryBlock.LongIntValue(byval value as longint)
if Alloc then
poke longint, IOptr, value
IncOffset(SizeOf(longint))
end if
end property
property TMemoryBlock.Offset() as uinteger
return offset_
end property
property TMemoryBlock.Offset(byval value as uinteger)
offset_ = value
end property
property TMemoryBlock.PString() as string
' returns pascal string
if not Alloc then
return ""
end if
' allocate maximum pascal string size
dim result as string = space(256)
' offset
var a = IOptr
' get string size
result[0] = peek(ubyte, a)
' check size
if result[0] > 256 then
' illegal function call: not a pascal string
error 1
return ""
end if
' should not exceed memory
if a + result[0] > maxaddress_ then
' segmentation fault
error 12
return ""
end if
' read bytes
for i as ubyte = 1 to result[0]
result[i] = peek(ubyte, a + i)
next
IncOffset(result[0] + 1)
' truncate result to real size
return left(result, result[0] + 1)
end property
property TMemoryBlock.PStringValue() as string
' returns the string value from a pascal string
return mid(PString, 2)
end property
property TMemoryBlock.PStringValue(byref value as string)
' write string value as a pstring if the string exceeds 255 bytes,
' it will be truncated.
if not Alloc then
exit property
end if
' string length
var l = len(value)
if l = 0 then
exit property
end if
' 255 is max for pstring
if l > 255 then
l = 255
end if
var a = IOptr
' check address range
if a + l > maxaddress_ then
' segmentation fault
error 12
exit property
end if
' store pstring length
poke ubyte, a, l
' store pstring
for i as ubyte = 1 to l
poke ubyte, a + i, value[i]
next
IncOffset(l + 1)
end property
property TMemoryBlock.SingleValue() as single
if not Alloc then
exit property
end if
dim result as single = peek(single, IOptr)
IncOffset(SizeOf(single))
return result
end property
property TMemoryBlock.SingleValue(byval value as single)
if Alloc then
poke single, IOptr, value
IncOffset(SizeOf(single))
end if
end property
property TMemoryBlock.ShortValue() as short
if not Alloc then
exit property
end if
dim result as short = peek(short, IOptr)
IncOffset(SizeOf(short))
return result
end property
property TMemoryBlock.ShortValue(byval value as short)
if Alloc then
poke short, IOptr, value
IncOffset(SizeOf(short))
end if
end property
property TMemoryBlock.Size() as uinteger
return size_
end property
property TMemoryBlock.Size(byval value as uinteger)
' resizes the memory block. If the current offset_ is not within the
' new size, it is reset to 0.
address_ = Reallocate(address_, value)
' did reallocation fail?
if address_ = 0 then
size_ = 0
offset_ = 0
maxaddress_ = 0
exit property
end if
size_ = value
SetMaxAddress()
' larger block?
if value > size_ then
' clear additional space
for i as uinteger = size_ to value - 1
poke byte, address_ + i, 0
next
end if
' set new size
size_ = value
' reset offset if necessary
if offset_ > size_ then
offset_ = 0
end if
end property
property TMemoryBlock.StringValue(byval Length as uinteger) as string
if not Alloc then
return ""
end if
' string length to read
var l = Length
var a = IOptr
' limit to address range if necessary
if a + l > maxaddress_ then
l = (maxaddress_ - a) + 1
end if
' anything to read?
if l < 1 then
exit property
end if
dim result as string = space(l)
for i as uinteger = 0 to l - 1
result[i] = peek(ubyte, a + i)
next
IncOffset(l)
return result
end property
property TMemoryBlock.StringValue(byref value as string)
' write string value
if not Alloc then
exit property
end if
' string length
var l = len(value)
' anything to write?
if l = 0 then
exit property
end if
' start address
var a = IOptr
' check address range
if a + (l - 1) > maxaddress_ then
' segmentation fault
error 12
exit property
end if
' write the string
for i as ubyte = 0 to l - 1
poke ubyte, a + i, value[i]
next
IncOffset(l)
end property
property TMemoryBlock.UByteValue() as ubyte
if not Alloc then
exit property
end if
dim result as ubyte = peek(ubyte, IOptr)
IncOffset(SizeOf(ubyte))
return result
end property
property TMemoryBlock.UByteValue(byval value as ubyte)
if Alloc then
poke ubyte, IOptr, value
IncOffset(SizeOf(ubyte))
end if
end property
property TMemoryBlock.UIntegerValue() as uinteger
if not Alloc then
exit property
end if
dim result as uinteger = peek(uinteger, IOptr)
IncOffset(SizeOf(uinteger))
return result
end property
property TMemoryBlock.UIntegerValue(byval value as uinteger)
if Alloc then
poke uinteger, IOptr, value
IncOffset(SizeOf(uinteger))
end if
end property
property TMemoryBlock.ULongValue() as ulong
if not Alloc then
exit property
end if
dim result as ulong = peek(ulong, IOptr)
IncOffset(SizeOf(ulong))
return result
end property
property TMemoryBlock.ULongValue(byval value as ulong)
if Alloc then
poke ulong, IOptr, value
IncOffset(SizeOf(ulong))
end if
end property
property TMemoryBlock.ULongIntValue() as ulongint
if not Alloc then
exit property
end if
dim result as ulongint = peek(ulongint, IOptr)
IncOffset(SizeOf(ulongint))
return result
end property
property TMemoryBlock.ULongIntValue(byval value as ulongint)
if Alloc then
poke ulongint, IOptr, value
IncOffset(SizeOf(ulongint))
end if
end property
property TMemoryBlock.UShortValue() as ushort
if not Alloc then
exit property
end if
dim result as ushort = peek(ushort, IOptr)
IncOffset(SizeOf(ushort))
return result
end property
property TMemoryBlock.UShortValue(byval value as ushort)
if Alloc then
poke ushort, IOptr, value
IncOffset(SizeOf(ushort))
end if
end property
function TMemoryBlock.Alloc() as boolean
' Raises errors when address and/or size is NULL
' Should be used to test valid access to the memory block only.
' raise error if no address
if address_ = 0 then
' null pointer access
error 7
return false
end if
' raise error if no size
if size_ = 0 then
' segmentation violation
error 12
return false
end if
return true
end function
sub TMemoryBlock.IncOffset(byval aSize as uinteger)
var a = offset_ + aSize
if address_ + a > maxaddress_ then
' segmentation fault
error 12
exit sub
end if
offset_ = a
end sub
function TMemoryBlock.IOptr() as any ptr
return address_ + offset_
end function
sub TMemoryBlock.SetMaxAddress()
if size_ then
maxaddress_ = address_ + (size_ - 1)
else
maxaddress_ = 0
end if
end sub
Update: Alloc test removed from IncOffset because it was redundant.
