[futurebasic] Resource<->Arrays.incl

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : August 2001 : Group Archive : Group : All Groups

From: Jay Reeve <jktr@...>
Date: Sun, 19 Aug 01 23:42:52 -0500
Hello Alain et al,

Here, as promised, is a beta version of an incl with generic fn's to 
convert Dynamic arrays and Containers to resources and read them back 
into arrays and containers. Everything seems to work fine, EXCEPT that if 
you run the demo more than once, it adds additional resources and doesn't 
replace the earlier version, which is the one that gets loaded.

I don't know how important this is--I suppose it should replace the 
earlier one. Can you help with that, Alain? PgReplaceRes handles this 
situation okay, but we can't use it because it copies the handle, causing 
double memory usage. Still, we can probably borrow its methodology for 
recognizing and handling the replacement.

I will work on some additional documentation, to show how to use these. 
Please let me know of any other issues.

 0"0
 =J= a  y
  "
=======================

#if 0
'~';
Resource<->Arrays.incl
by Alain Pastor & Jay reeve
August 19, 2001
'~';
#endif'~';
goto "End Resource<->Arrays.incl"
'~';
local fn DynaToRsrc(@HndlPtr as ptr,fileName$,RsrcName$) 
dim as short  oldRef,resRef
dim as long   hSize
dim as FSSpec fSpec

if HndlPtr.0& = _nil then stop "No handle in FN DynaToRsrc":Exit fn
hSize = fn gethandlesize(HndlPtr.0&)
CALL sethandlesize(HndlPtr.0&,hSize + 8)
blockmove(HndlPtr+_AutoXREFCurr,[HndlPtr.0&]+hSize,8) //Save header info
fSpec.name    = fileName$
fSpec.vRefNum = system(_aplVol)
fSpec.parID   = 0

oldRef = fn CurResFile
resRef = fn FSpOpenResFile(fSpec,_fsRdWrPerm)
long if resRef < 0
FSpCreateResFile(fSpec,_"RSED",_"rsrc",_nil)
long if fn ResError = _noErr
resRef = fn FSpOpenResFile(fSpec,_fsRdWrPerm)
if resRef < 0 then stop "Can't open Rsrc file in FN DynaToRsrc" : exit fn
xelse
stop "Unable to create resFile in FN DynaToRsrc" : exit fn
end if
end if

UseResFile(resRef)
AddResource(HndlPtr.0&,_"DYNA",128,RsrcName$)
long if fn ResError = _noErr
SetResAttrs(HndlPtr.0&,_resPurgeable%)
ChangedResource(HndlPtr.0&)
WriteResource(HndlPtr.0&)
UpdateResFile(resRef)
DetachResource(HndlPtr.0&)
end if
UseResFile(oldRef)
if oldRef != resRef then CloseResFile(resRef)
end fn
'~';
local fn RsrcToDyna(@HndlPtr as ptr,FileName$,RsrcName$) 
dim as short  oldRef,resRef
dim as long   hSize
dim as FSSpec fSpec

fSpec.name    = FileName
fSpec.vRefNum = system(_aplVol)
fSpec.parID   = 0
oldRef = fn CurResFile
resRef = fn FSpOpenResFile(fSpec,_fsRdWrPerm)
long if resRef < 0
print "Unable to open resfile" : exit fn
end if
UseResFile(resRef)
HndlPtr.0& = fn GetnamedResource(_"DYNA",RsrcName)
long if HndlPtr.AutoXREFHndl&
detachresource(HndlPtr.AutoXREFHndl&)
hSize = fn GetHandleSize(HndlPtr.AutoXREFHndl&) - 8
HndlPtr.AutoXREFCurr&;8 = [HndlPtr.AutoXREFHndl&] + hSize //Set header 
info
CALL sethandlesize(HndlPtr.AutoXREFHndl&,hSize) //Remove header from 
handle
end if
UseResFile(oldRef)
if oldRef != resRef then CloseResFile(resRef)
end fn
'~';
local fn CtnrToRsrc(@HndlPtr as ptr,fileName$,RsrcName$) 
dim as short  oldRef,resRef
dim as FSSpec fSpec

HndlPtr.0& = HndlPtr.0&
if HndlPtr.0& = 0 then stop "No handle in FN CtnrToRsrc":Exit fn
fSpec.name    = fileName$
fSpec.vRefNum = system(_aplVol)
fSpec.parID   = 0

oldRef = fn CurResFile
resRef = fn FSpOpenResFile(fSpec,_fsRdWrPerm)
long if resRef < 0
FSpCreateResFile(fSpec,_"RSED",_"rsrc",_nil)
long if fn ResError = _noErr
resRef = fn FSpOpenResFile(fSpec,_fsRdWrPerm)
if resRef < 0 then stop "Can't open Rsrc file in FN DynaToRsrc" : exit fn
xelse
stop "Unable to create resFile in FN DynaToRsrc" : exit fn
end if
end if

UseResFile(resRef)
AddResource(HndlPtr.0&,_"CTNR",128,RsrcName$)
long if fn ResError = _noErr
SetResAttrs(HndlPtr.0&,_resPurgeable%)
ChangedResource(HndlPtr.0&)
WriteResource(HndlPtr.0&)
UpdateResFile(resRef)
DetachResource(HndlPtr.0&)
end if
UseResFile(oldRef)
if oldRef != resRef then CloseResFile(resRef)
end fn
'~';
local fn RsrcToCtnr(@HndlPtr as ptr,FileName$,RsrcName$) 
dim as short  oldRef,resRef
dim as FSSpec fSpec

fSpec.name    = FileName$
fSpec.vRefNum = system(_aplVol)
fSpec.parID   = 0
oldRef = fn CurResFile
resRef = fn FSpOpenResFile(fSpec,_fsRdWrPerm)
long if resRef < 0
print "Unable to open resfile" : exit fn
end if
UseResFile(resRef)
HndlPtr.0& = fn GetnamedResource(_"CTNR",RsrcName)
long if HndlPtr.0&
detachresource(HndlPtr.0&)
end if
UseResFile(oldRef)
if oldRef != resRef then CloseResFile(resRef)
end fn
'~';
"End Resource<->Arrays.incl"
// DEMO ROUTINE
'~';
begin globals
dynamic gStringArray(_maxLong) as Str15
dim C$$
dim gResFileName$
end globals

local fn fillArray
dim i as long
for i = 0 to 25
gStringArray(i) = string$(rnd(15),chr$(65 + i))
next
//compress dynamic gStringArray&
end fn

local fn showArray
dim i as long
print 
for i = 0 to 25
print gStringArray(i)
next
end fn
// MAIN
gResFileName = "Test dynamic.rsrc"

// Dynamic test
fn fillArray
fn showArray
fn DynaToRsrc(gStringArray,gResFileName,"test1") 
kill dynamic gStringArray
fn RsrcToDyna(gStringArray,gResFileName,"test1") 
fn showArray

// Container test
While len(C) < 256
C += str$(rnd(_maxInt))
wend

print :print C
fn CtnrToRsrc(C,gResFileName,"test2") 
C = ""
fn RsrcToCtnr(C,gResFileName,"test2") 
print :print C

do
until fn button