Memory to array :
Rem Project: mem_to_array_stucture1
Rem Created: Wednesday, January 18, 2023
Rem ***** Main Source File *****
sync on : sync rate 30 : sync
#constant MAX_STRING 256
type struct
b as byte
f as float
s as string
endtype
recnuminfile = 2 ` - number of records in file to read in
dim ary(recnuminfile-1) as struct
for i =0 to recnuminfile-1 : for l = 0 to MAX_STRING -1 : ary(i).s = ary(i).s + "@" : next l : next i
pary = get arrayptr(ary())
`pMEM=MakeMemoryFromFile("byte_data1.dat")
pMEM=MakeMemoryFromFile("byte_data2.dat")
`pMEM=MakeMemoryFromFile("struct2.dat")
print "pMEM: ";pMEM; " size: ";memory size(pMEM)
remstart
if file exist("memdump.txt")=1 then delete file "memdump.txt"
open to write 1,"memdump.txt"
for adr = pMEM to pMEM + memory size(pMEM) - 1
byt = peek byte(adr)
write string 1,str$(adr)+" -> "+str$(byt)
next adr
close file 1
remend
MakeArrayFromMemory(pary,pMEM)
for i = 0 to 1
print ary(i).b; " , ";ary(i).f;" , ";ary(i).s
next i
sync
wait key
SAFE_DELETE(pMEM)
undim ary()
message "finished correctly."
end
function SAFE_DELETE(ptr as DWORD )
free ptr
ptr = 0
endfunction
function MakeArrayFromMemory(arrayptr as dword ,memoryptr as dword )
itemnum=0
p=0
pStart = memoryptr
for index=0 to get arrayptr count(arrayptr)
for item = 1 to get arrayptr field count (arrayptr)
inc itemnum
aryityp$=FindStructItemType(arrayptr ,index, item)
aryiptr = FindStructItem(arrayptr ,index, item)
if aryityp$="Byte"
poke byte aryiptr,peek byte(pStart)
inc pStart
endif
if aryityp$="Word"
poke word aryiptr,peek word(pStart)
inc pStart,2
endif
if aryityp$="Integer"
poke integer aryiptr,peek integer(pStart)
inc pStart,4
endif
if aryityp$="Float"
poke float aryiptr,peek float(pStart)
inc pStart,4
endif
if aryityp$="Dword"
poke dword aryiptr,peek dword(pStart)
inc pStart,4
endif
if aryityp$="String"
oldpStart=pStart
pSlen = MemStrLen(pStart , 0 )
inc pStart, pSlen + 1
poke string *aryiptr,peek string(oldpStart)
endif
if aryityp$="Double float"
poke double float aryiptr,peek double float(pStart)
inc pStart, 8
endif
if aryityp$="Double integer"
poke double integer aryiptr,peek double integer(pStart)
inc pStart, 8
endif
next item
next index
endfunction
function MakeMemoryFromFile(src$)
fsz = file size(src$)
mptr = alloc(fsz)
fid = reserve free file()
adr as dword
byt as byte
open to read fid,src$
for adr = mptr to mptr + fsz - 1
read byte fid,byt
poke byte adr,byt
next adr
close file fid
release reserved file fid
msz = memory size(mptr)
crlf = MemCountCRLF(mptr,msz)
rm = crlf mod 2
`print "rm: ";rm
if rm > 0
cr = MemCountCR(mptr,msz)
lf = MemCountLF(mptr,msz)
endif
`print "crlf: ";crlf; " cr: ";cr;" lf: ";lf
if crlf > 0
newmemsz = msz - crlf
endif
byt as byte
nbyt as byte
newmptr = alloc(newmemsz)
nptr as DWORD
nptr = newmptr
mstart = mptr
mend = mptr + msz - 1
for adr = mptr to mptr + msz - 1
byt = peek byte (adr)
bpos = adr - mptr
nbpos = nptr - newmptr
if byt = 13
lastbyt = byt
poke byte nptr,0
inc adr
else
if byt = 10 and lastbyt = 13
inc adr
else
lastbyt = 0
poke byte nptr,byt
endif
endif
nbyt = peek byte(nptr)
inc nptr
next adr
for adr = newmptr to newmptr + newmemsz - 1
byt = peek byte(adr)
bpos = adr - newmptr
next adr
SAFE_DELETE(mptr)
endfunction newmptr
function MemCountCRLF(ptr,psz)
byt as byte
cr = 0 : lf = 0
for adr = ptr to ptr + psz -1
byt = peek byte(adr)
if byt = 13
inc cr
endif
if byt = 10
inc lf
endif
next adr
if cr = lf
cnt = cr
else
cnt = cr+lf
endif
endfunction cnt
function MemCountCR(ptr,psz)
byt as byte
cr = 0
for adr = ptr to ptr + psz -1
byt = peek byte(adr)
if byt = 13
inc cr
endif
next adr
cnt = cr
endfunction cnt
function MemCountLF(ptr,psz)
byt as byte
lf = 0
for adr = ptr to ptr + psz -1
byt = peek byte(adr)
if byt = 10
inc lf
endif
next adr
cnt = lf
endfunction cnt
function MemStrLen(ptr as DWORD , marker as BYTE )
if ptr =0 then exitfunction 0
pStrLen as integer
pStrLen = -1
byt as byte
byt = peek byte(ptr)
p = -1
while byt <> marker
inc pStrLen
inc p
byt = peek byte(ptr+p)
endwhile
endfunction pStrLen
function GetFieldType$(fmt$,field)
// vtype : 4=byte, 6=dword, 1=float, 2=string, no value type=0
// i as integer // L
// f as float // F
// raw_name as string // S
// isdup as boolean // B
// b as byte // Y
// w as word // W
// dw as dword // D
// df as double float // O
// di as double integer // R
ft$=mid$(fmt$,field)
select ft$
case "L"
ret$="Integer"
endcase
case "F"
ret$="Float"
endcase
case "S"
ret$="String"
endcase
case "B"
ret$="Boolean"
endcase
case "Y"
ret$="Byte"
endcase
case "W"
ret$="Word"
endcase
case "D"
ret$="Dword"
endcase
case "O"
ret$="Double float"
endcase
case "R"
ret$="Double integer"
endcase
endselect
endfunction ret$
`notes : will only work if no other link array used to same ptr
function FindStructItem(ptr as DWORD ,index, item)
found = 0
ac = get arrayptr count(ptr)
write string 1,"ptr: "+str$(ptr)
avalfc = get arrayptr field count(ptr)
for i = 0 to ac
for ii = 1 to avalfc
if i = index and ii = item
off=get arrayptr field offset(ptr,ii)
rptr = get arrayptr item ptr(ptr,i)+off
found = 1
exit
endif
next ii
if found = 1 then exit
next i
endfunction rptr
`notes : will only work if no other link array used to same ptr
function FindStructItemType(ptr as DWORD ,index, item)
found = 0
ac = get arrayptr count(ptr)
avalfc = get arrayptr field count(ptr)
fmt$ = get arrayptr format(ptr)
for i = 0 to ac
for ii = 1 to avalfc
ftyp = get arrayptr field type(ptr,ii)
if i = index and ii = item
ftyp$ = GetFieldType$(fmt$,ii)
found = 1
exit
endif
next ii
if found = 1 then exit
next i
endfunction ftyp$
Pro Programmer / Data Scientist, languages: SAS, C++, SQL, PL-SQL, DBPro, Purebasic, JavaScript, others
