#include once "windows.bi"
#include once "win/ole2.bi"
#include once "scriba.bi"
dim as long pProgram,iError,cArgs
dim as long f1,f2,v
dim as long n,m
dim as SbData ReturnData,ArgData(3)
dim as sbdata ptr pdat
dim as long qdat
function newmem CDECL (ByVal le As Long) As bstr Export
function=SysAllocStringByteLen (0,le)
end function
sub freemem CDECL (ByVal p As bstr) Export
SysFreeString p
end sub
SetConsoleTitle "FreeBasic ScriptBasic Embedding Test"
'
'LOADING AND RUNNING A PROGRAM
'-----------------------------
'
pProgram=scriba_new (cast(long,@newmem), cast(long,@freemem))
'scriba_LoadConfiguration(pProgram,"c:\scriptbasic\bin\scriba.conf")
scriba_SetFileName(pProgram,"E03.bas")
iError=scriba_LoadSourceProgram(pProgram)
if iError then goto ending
iError=scriba_Run(pProgram,"Hello")
if iError then goto ending
'
'ACCESSING GLOBAL DATA
'---------------------
'
v=scriba_LookupVariableByName(pProgram,"main::a")
scriba_GetVariable(pProgram,v,qdat)
pdat=cast(sbdata ptr,qdat)
m=pdat->lng+100
scriba_SetVariable(pProgram,v,2,m,0,"",0)
'scriba_GetVariable(pProgram,v,*pdat)
'
'CALLING SIMPLE SUBROUTINE
'-------------------------
'
f1=scriba_LookupFunctionByName(pProgram,"main::dprint")
if f1=0 then print "Unable to locat Dprint" : goto ending
iError=scriba_Call(pProgram,f1)
if iError then goto ending
'
'
'
'CALLING FUNCTION, RETURNING DATA AND GETTING ALTERED PARAMS
'-----------------------------------------------------------
f2=scriba_LookupFunctionByName(pProgram,"main::eprint")
if f2=0 then print "Unable to locate Eprint" : goto ending
'SETUP ARGUMENTS
'---------------
'these can be used for both input and output
ArgData(0).typ=SBT_DOUBLE
ArgData(1).typ=SBT_DOUBLE
ArgData(2).typ=SBT_DOUBLE
ArgData(3).typ=SBT_DOUBLE
ArgData(0).siz=0
ArgData(1).siz=0
ArgData(2).siz=0
ArgData(3).siz=0
ArgData(0).dbl=11
ArgData(1).dbl=12
ArgData(2).dbl=13
ArgData(3).dbl=14
cArgs=4
'
iError=scriba_CallArgEx(pProgram, f2, ReturnData, cArgs, ArgData(0))
if iError then goto ending
print "Return type:",ReturnData.typ
print "Value:",
'
'READ RETURNED VALUE
'-------------------
'
select case ReturnData.typ
case SBT_UNDEF : print "Undefined"
case SBT_DOUBLE : print ReturnData.dbl
case SBT_LONG : print ReturnData.lng
case SBT_STRING : print *ReturnData.str
case SBT_ZCHAR : print *ReturnData.str
end select
'------
ending:
'======
scriba_destroy(pProgram)
if iError then print "ERROR: " + hex$(iError) ' + " " + hex$(pProgram)
'messageBox 0,"ok: "+hex$(iError)+" "+hex$(pProgram),"FreeBasic",0
sleep