ScriptBasic Extension Modules written in Oxygen

[Charles Pegge]

Further Developments: to the test module:  projects/scriptbasic/mdlt

Parameters can be both passed and returned (pseudo-Byref). It is written entirely in Basic, Assembler  was not required in  this update.

The demo requires a full installation of ScriptBasic. The compiled module must be copied into then modules directory.

Test Script (ScriptBasic)

Code: [Select]


  declare sub trial alias "trial" lib "mdlt"

  a=12345+0.67
  b="HELLO"
  c=8
  d=9

  print "Sent params:    " & b & "  " & a  & "  " & c & "  " & d & "\n"
  print trial(a,b,c,d)
  print "Altered params: " & b & "  " & a  & "  " & c & "  " & d & "\n"
  line input w
Source code for MDLT (OxygenBasic)

Code: [Select]


  'extension module for ScriptBasic

  '23:02 11/05/2011
  '17:25 15/05/2012
  '
  'Charles Pegge


  '#file "mdlt.dll"
  '
  $ dll
  $ Filename "mdlt.dll"
  include  "..\..\inc\RTL32.inc"


  function GetStringParam(sys pst,pm) as string
  '============================================
  sys c,p
  c=*(pst+0xf4)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  zstring pz at *p
  return pz
  end function


  function PutStringParam(sys pst,pm,string s)
  '===========================================
  sys c,p
  c=*(pst+0xf4)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  zstring pz at *p
  pz=s
  end function


  function GetLongParam(sys pst,pm) as long
  '========================================
  sys c,p
  c=*(pst+0xf8)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  return *p
  end function


  function PutLongParam(sys pst,pm, sys v)
  '=======================================
  sys c,p
  c=*(pst+0xf8)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  *p=v
  end function


  function GetDoubleParam(sys pst,pm) as double
  '============================================
  sys c,p
  c=*(pst+0xfc)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  double pd at p
  return pd
  end function


  function PutDoubleParam(sys pst,pm,double d)
  '===========================================
  sys c,p
  c=*(pst+0xfc)
  p=*pst
  p=call c p, pm, *(p+0x8c)
  double pd at p
  pd=d
  end function


  sub ReturnString(sys pst,pRetVal,string s)
  '=========================================
  sys c,p,ls
  ls=len(s)
  c=*(pst+0x0c)
  p=*pst
  p=call c *(p+0x94),ls , *(p+0x8c)
  *pRetVal=p
  copy *p,strptr s,ls
  end sub


  sub ReturnLong(sys pst,pRetVal,Long v)
  '=====================================
  sys c,p
  c=*(pst+0x10)
  p=*pst
  p=call c *(p+0x94), *(p+0x8c)
  *pRetVal=p
  long pv at p
  pv=v
  '
  'mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push [eax+0x94] : call [ecx+0x10]
  'mov ecx,pReturnValue : mov [ecx],eax : mov edx,v : mov [eax],edx
  ''
  end sub


  sub ReturnDouble(sys pst,pRetVal,double d)
  '=========================================
  sys c,p
  c=*(pst+0x18)
  p=*pst
  p=call c *(p+0x94), *(p+0x8c)
  *pRetVal=p
  double pd at p
  pd=d
  end sub


  function GetParamPtr(sys pParams, pn) as sys
  '===========================================
  return *(*pParams+pn*4-4) 'pointer to parameter
  end function
 



  function versmodu cdecl (sys Version, pszVariation, ppModuleInternal) as sys export
  '==================================================================================
  'print "Version: " hex version
  return Version
  end function


  function bootmodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
  '===========================================================================================
  'print "Boot!"
  end function



  function finimodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
  '===========================================================================================
  'print "Finish!"
  end function


  function trial cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
  '========================================================================================
  sys    w,pm,pn
  string cr=chr(13)+chr(10)
  '
  sys    v
  string pr
  double d
  '
  if pParameters then
    '
    'HOW MANY ARGUMENTS GIVEN
    '------------------------
    '
    w=*(pParameters+8) >> 2
    '
    'print "No of Arguments given: " w
    '
    'PARAM pn
    '--------
    '
    'pParameters->Value.aValue[(X)-1]
    '
    for pn=1 to w
      '
      'index base 1
      '
      pm=GetParamPtr(pparameters,pn)
      pr+= "As String:  " GetStringParam(pst,pm) + cr +
           "As Long:    " GetLongParam(pst,pm)   + cr +
           "As Double:  " GetDoubleParam(pst,pm) + cr +
      cr
    next
    '
    pm=GetParamPtr(pParameters,1)
    PutDoubleParam(pst,pm,1111.11)
    pm=GetParamPtr(pParameters,2)
    PutStringParam(pst,pm,"hello")
    pm=GetParamPtr(pParameters,3)
    PutLongParam(pst,pm,3)
    pm=GetParamPtr(pParameters,4)
    PutLongParam(pst,pm,4)
    '
  else
    'noparams
  end if
  '
  'ReturnLong(pst,pReturnValue,1234.5)
  'ReturnDouble(pst,pReturnValue,1.234.5)
  ReturnString(pst,pReturnValue,"From Oxygen:"+cr+cr+pr)
  '
  end function


This is included in the latest Oxygen-in-progress.

Charles

[JRS]

WOW!

Thanks Charles for the SB update. I will be sure to give it a try.

  '23:02 11/05/2011
  '17:25 15/05/2012

Feels like I just got a Birthday present. 

[JRS]

Charles,

I thought a SQLite3 extension module using O2 would be a good example. The problem is that I need to return an SB array and an associative array for FetchArray() and FetchHash() in a BYREF argument. Check out the MySQL extension module for a working example written in C.

If we can get the SQLite3 extension module working, IUP would be the next logical step.

John

[Charles Pegge]

This is all I know about sqLite so far.

Oxygen

Code: OxygenBasic

1.  
2.   extern lib "sqlite3.dll"
3.  
4.   sys   sqlite3_open (char*name,sys*db)
5.   sys   sqlite3_exec (sys db,char* s, sys p1, sys p2, sys*dberr)
6.   sys   sqlite3_prepare_v2 (sys db, char*s, sys p1, sys*stmt, sys p2)
7.   sys   sqlite3_step (sys n)
8.   char* sqlite3_column_text (sys row, sys col)
9.   sys   sqlite3_close (sys db)
10.   '
11.  end extern
12.   '
13.  sys SQLITE_ROW = 100
14.   sys hdb
15.   sys dberr
16.   sys stmt
17.   '
18.  char *  errmsg
19.   string  cr=chr(13)+chr(10)
20.   string  pr="DataBase Listing:" cr
21.   '
22.  sqlite3_open "testsql",hdb
23.   '
24.  sqlite3_exec hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr
25.   sqlite3_exec hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr
26.  sqlite3_exec hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr
27.  sqlite3_exec hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr
28.  '
29.  result = sqlite3_prepare_v2 hdb, "SELECT * FROM demo;" cr, -1, stmt, 0
30.   '
31.  if dberr then @errmsg=dberr : print errmsg
32.   '
33.  while sqlite3_step(stmt) = SQLITE_ROW
34.     pr+=sqlite3_column_text(stmt, 0) " - " sqlite3_column_text(stmt, 1) cr
35.   wend
36.   '
37.  sqlite3_close hdb
38.  
39.   print pr
40.  

Charles

[Charles Pegge]

Here is a ScriptBasic module built around this example:

ScriptBasic Test

Code: [Select]


  declare sub SQLite3_Demo        alias "sqlite3_demo"        lib "sqlite3_mdl"
  declare sub SQLite3_ErrMsg      alias "sqlite3_errmsg"      lib "sqlite3_mdl"
  declare sub SQLite3_Open        alias "sqlite3_open"        lib "sqlite3_mdl"
  declare sub SQLite3_Close       alias "sqlite3_close"       lib "sqlite3_mdl"
  declare sub SQLite3_Exec        alias "sqlite3_exec"        lib "sqlite3_mdl"
  declare sub SQLite3_Prepare_v2  alias "sqlite3_prepare_v2"  lib "sqlite3_mdl"
  declare sub SQLite3_Step        alias "sqlite3_step"        lib "sqlite3_mdl"
  declare sub SQLite3_Column_Text alias "sqlite3_column_text" lib "sqlite3_mdl"

  SQLITE_ROW = 100

  'print SQLite3_Demo()

  hdb=0
  dberr=0
  stmt=0
  pr="DataBase Listing:\n"
  result=0
  '
  sqlite3_open("testsql",hdb)
  '
  sqlite3_exec (hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr)
  sqlite3_exec (hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr)
  sqlite3_exec (hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr)
  sqlite3_exec (hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr)
  '
  result = sqlite3_prepare_v2 (hdb, "SELECT * FROM demo;", -1, stmt, 0)
  '
  if dberr then
    print SQLite3_ErrMsg(dberr) & "\n"
  endif
  '
  while (sqlite3_step(stmt) = SQLITE_ROW)
    pr=pr & sqlite3_column_text(stmt, 0) & " - " & sqlite3_column_text(stmt, 1) & "\n"
  wend
  '
  sqlite3_close(hdb)

  print pr
  line input w

sqlite3_mdl

Code: OxygenBasic

1.  
2.   'extension module for ScriptBasic
3.  
4.   '04:43 18/05/2012
5.  '
6.  'Charles Pegge
7.  
8.  
9.   '#file "sqlite3_mdl.dll"
10.  '
11.  $ dll
12.   $ Filename "sqlite3_mdl.dll"
13.   include  "..\..\inc\RTL32.inc"
14.  
15.  
16.   function GetStringParam(sys pst,pm) as string
17.   '============================================
18.  sys c,p
19.   c=*(pst+0xf4)
20.   p=*pst
21.   p=call c p, pm, *(p+0x8c)
22.   zstring pz at *p
23.   return pz
24.   end function
25.  
26.  
27.   function PutStringParam(sys pst,pm,string s)
28.   '===========================================
29.  sys c,p
30.   c=*(pst+0xf4)
31.   p=*pst
32.   p=call c p, pm, *(p+0x8c)
33.   zstring pz at *p
34.   pz=s
35.   end function
36.  
37.  
38.   function GetLongParam(sys pst,pm) as long
39.   '========================================
40.  sys c,p
41.   c=*(pst+0xf8)
42.   p=*pst
43.   p=call c p, pm, *(p+0x8c)
44.   return *p
45.   end function
46.  
47.  
48.   function PutLongParam(sys pst,pm, sys v)
49.   '=======================================
50.  sys c,p
51.   c=*(pst+0xf8)
52.   p=*pst
53.   p=call c p, pm, *(p+0x8c)
54.   *p=v
55.   end function
56.  
57.  
58.   function GetDoubleParam(sys pst,pm) as double
59.   '============================================
60.  sys c,p
61.   c=*(pst+0xfc)
62.   p=*pst
63.   p=call c p, pm, *(p+0x8c)
64.   double pd at p
65.   return pd
66.   end function
67.  
68.  
69.   function PutDoubleParam(sys pst,pm,double d)
70.   '===========================================
71.  sys c,p
72.   c=*(pst+0xfc)
73.   p=*pst
74.   p=call c p, pm, *(p+0x8c)
75.   double pd at p
76.   pd=d
77.   end function
78.  
79.  
80.   sub ReturnString(sys pst,pRetVal,string s)
81.   '=========================================
82.  sys c,p,ls
83.   ls=len(s)
84.   c=*(pst+0x0c)
85.   p=*pst
86.   p=call c *(p+0x94),ls , *(p+0x8c)
87.   *pRetVal=p
88.   copy *p,strptr s,ls
89.   end sub
90.  
91.  
92.   sub ReturnLong(sys pst,pRetVal,Long v)
93.   '=====================================
94.  sys c,p
95.   c=*(pst+0x10)
96.   p=*pst
97.   p=call c *(p+0x94), *(p+0x8c)
98.   *pRetVal=p
99.   long pv at p
100.   pv=v
101.   '
102.  'mov ecx,pst : mov eax,[ecx] : push [eax+0x8c] : push [eax+0x94] : call [ecx+0x10]
103.  'mov ecx,pReturnValue : mov [ecx],eax : mov edx,v : mov [eax],edx
104.  ''
105.  end sub
106.  
107.  
108.   sub ReturnDouble(sys pst,pRetVal,double d)
109.   '=========================================
110.  sys c,p
111.   c=*(pst+0x18)
112.   p=*pst
113.   p=call c *(p+0x94), *(p+0x8c)
114.   *pRetVal=p
115.   double pd at p
116.   pd=d
117.   end sub
118.  
119.  
120.   function GetParamPtr(sys pParams, pn) as sys
121.   '===========================================
122.  return *(*pParams+pn*4-4) 'pointer to parameter
123.  end function
124.  
125.  
126.  
127.  
128.   function versmodu cdecl (sys Version, pszVariation, ppModuleInternal) as sys export
129.   '==================================================================================
130.  'print "Version: " hex version
131.  return Version
132.   end function
133.  
134.  
135.   function bootmodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
136.   '===========================================================================================
137.  'print "Boot!"
138.  end function
139.  
140.  
141.  
142.   function finimodu cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
143.   '===========================================================================================
144.  'print "Finish!"
145.  end function
146.  
147.  
148.   function trial cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys export
149.   '========================================================================================
150.  sys    w,pm,pn
151.   string cr=chr(13)+chr(10)
152.   '
153.  sys    v
154.   string pr
155.   double d
156.   '
157.  if pParameters then
158.     '
159.    'HOW MANY ARGUMENTS GIVEN
160.    '------------------------
161.    '
162.    w=*(pParameters+8) >> 2
163.     '
164.    'print "No of Arguments given: " w
165.    '
166.    'PARAM pn
167.    '--------
168.    '
169.    'pParameters->Value.aValue[(X)-1]
170.    '
171.    for pn=1 to w
172.       '
173.      'index base 1
174.      '
175.      pm=GetParamPtr(pparameters,pn)
176.       pr+= "As String:  " GetStringParam(pst,pm) + cr +
177.            "As Long:    " GetLongParam(pst,pm)   + cr +
178.            "As Double:  " GetDoubleParam(pst,pm) + cr +
179.       cr
180.     next
181.     '
182.    pm=GetParamPtr(pParameters,1)
183.     PutDoubleParam(pst,pm,1111.11)
184.     pm=GetParamPtr(pParameters,2)
185.     PutStringParam(pst,pm,"hello")
186.     pm=GetParamPtr(pParameters,3)
187.     PutLongParam(pst,pm,3)
188.     pm=GetParamPtr(pParameters,4)
189.     PutLongParam(pst,pm,4)
190.     '
191.  else
192.     'noparams
193.  end if
194.   '
195.  'ReturnLong(pst,pReturnValue,1234.5)
196.  'ReturnDouble(pst,pReturnValue,1.234.5)
197.  ReturnString(pst,pReturnValue,"From Oxygen:"+cr+cr+pr)
198.   '
199.  end function
200.  
201.  
202.   '============
203.  
204.  
205.   'needs SQLite3.dll
206.  '
207.  'SQLITE_API int sqlite3_open(
208.  '  const char *filename,   /* Database filename (UTF-8) */
209.  '  sqlite3 **ppDb          /* OUT: SQLite db handle */
210.  ');
211.  '
212.  '
213.  'SQLITE_API int sqlite3_exec(
214.  'sqlite3*,                                  /* An open database */
215.  'const char *sql,                           /* SQL to be evaluated */
216.  'int (*callback)(void*,int,char**,char**),  /* Callback function */
217.  'void *,                                    /* 1st argument to callback */
218.  'char **errmsg                              /* Error msg written here */
219.  ');
220.  '
221.  '
222.  'SQLITE_API int sqlite3_prepare_v2(
223.  '  sqlite3 *db,            /* Database handle */
224.  '  const char *zSql,       /* SQL statement, UTF-8 encoded */
225.  '  int nByte,              /* Maximum length of zSql in bytes. */
226.  '  sqlite3_stmt **ppStmt,  /* OUT: Statement handle */
227.  '  const char **pzTail     /* OUT: Pointer to unused portion of zSql */
228.  ');
229.  '
230.  '
231.  'SQLITE_API int sqlite3_step(sqlite3_stmt*);
232.  '
233.  '
234.  'SQLITE_API const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol);
235.  '
236.  '
237.  'SQLITE_API int sqlite3_close(sqlite3 *);
238.  '
239.  '
240.  
241.   extern lib "sqlite3.dll"
242.  
243.   sys   sqlite3_open (char*name,sys*db)
244.   sys   sqlite3_exec (sys db,char* s, sys p1, sys p2, sys*dberr)
245.   sys   sqlite3_prepare_v2 (sys db, char*s, sys p1, sys*stmt, sys p2)
246.   sys   sqlite3_step (sys n)
247.   char* sqlite3_column_text (sys row, sys col)
248.   sys   sqlite3_close (sys db)
249.   '
250.  end extern
251.   '
252.  % SQLITE_ROW = 100
253.  
254.  
255.   function sqlite3_demo cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
256.   '================================================================================================
257.  sys hdb
258.   sys dberr
259.   sys stmt
260.   '
261.  char *  errmsg
262.   string  cr=chr(13)+chr(10)
263.   string  pr="DataBase Listing:" cr
264.   '
265.  sqlite3_open "testsql",hdb
266.   '
267.  sqlite3_exec hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr
268.   sqlite3_exec hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr
269.  sqlite3_exec hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr
270.  sqlite3_exec hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr
271.  '
272.  result = sqlite3_prepare_v2 hdb, "SELECT * FROM demo;" cr, -1, stmt, 0
273.   '
274.  if dberr then @errmsg=dberr : print errmsg
275.   '
276.  while sqlite3_step(stmt) = SQLITE_ROW
277.     pr+=sqlite3_column_text(stmt, 0) " - " sqlite3_column_text(stmt, 1) cr
278.   wend
279.   '
280.  sqlite3_close hdb
281.  
282.   ReturnString(pst,pReturnValue,pr)
283.  
284.   end function
285.  
286.  
287.  
288.   function sqlite3_errmsg cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
289.   '==================================================================================================
290.  sys    dberror
291.   char   errmsg at dberror
292.   sys np,pm
293.   '
294.  if pParameters then
295.     np=*(pParameters+8) >> 2
296.     pm=GetParamPtr(pparameters,1)
297.     dberror=GetLongParam(pst,pm)
298.   else
299.     'noparams
300.  end if
301.   '
302.  ReturnString(pst,pReturnValue,errmsg)
303.   '
304.  end function
305.  
306.  
307.   function sqlite3_open cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
308.   '================================================================================================
309.  string namedb
310.   sys    hdb,rtn
311.   sys np,pm
312.   '
313.  if pParameters then
314.     np=*(pParameters+8) >> 2
315.     pm=GetParamPtr(pparameters,1)
316.     namedb=GetStringParam(pst,pm)
317.     rtn=sqlite3_open namedb,hdb
318.     pm=GetParamPtr(pParameters,2)
319.     PutLongParam(pst,pm,hdb)
320.   else
321.     'noparams
322.  end if
323.   '
324.  ReturnLong(pst,pReturnValue,rtn)
325.   '
326.  end function
327.  
328.  
329.   function sqlite3_close cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
330.   '================================================================================================
331.  sys    hdb,rtn
332.   sys np,pm
333.   '
334.  if pParameters then
335.     np=*(pParameters+8) >> 2
336.     pm=GetParamPtr(pparameters,1)
337.     hdb=GetLongParam(pst,pm)
338.     rtn=sqlite3_close hdb
339.   else
340.     'noparams
341.  end if
342.   '
343.  ReturnLong(pst,pReturnValue,rtn)
344.   '
345.  end function
346.  
347.  
348.   function sqlite3_exec cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
349.   '================================================================================================
350.  sys    hdb,rtn
351.   string instruct
352.   sys    dberr
353.   sys np,pm
354.   '
355.  if pParameters then
356.     np=*(pParameters+8) >> 2
357.     pm=GetParamPtr(pparameters,1)
358.     hdb=GetLongParam(pst,pm)
359.     pm=GetParamPtr(pparameters,2)
360.     instruct=GetStringParam(pst,pm)
361.     rtn=sqlite3_exec hdb, instruct, 0, 0, dberr
362.     pm=GetParamPtr(pParameters,5)
363.     PutLongParam(pst,pm,dberr)  
364.   else
365.     'noparams
366.  end if
367.   '
368.  ReturnLong(pst,pReturnValue,rtn)
369.   '
370.  end function
371.  
372.  
373.  
374.   function sqlite3_prepare_v2 cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
375.   '======================================================================================================
376.  sys    hdb
377.   string instruct
378.   sys    statement
379.   sys    result
380.   sys np,pm
381.   '
382.  if pParameters then
383.     np=*(pParameters+8) >> 2
384.     pm=GetParamPtr(pparameters,1)
385.     hdb=GetLongParam(pst,pm)
386.     pm=GetParamPtr(pparameters,2)
387.     instruct=GetStringParam(pst,pm)
388.     result = sqlite3_prepare_v2 hdb, instruct, -1, statement, 0
389.     pm=GetParamPtr(pparameters,4)
390.     PutLongParam(pst,pm,statement)
391.   else
392.     'noparams
393.  end if
394.   '
395.  ReturnLong(pst,pReturnValue,result)
396.   '
397.  end function
398.  
399.  
400.  
401.   function sqlite3_step cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
402.   '================================================================================================
403.  sys    statement
404.   sys    result
405.   sys np,pm
406.   '
407.  if pParameters then
408.     np=*(pParameters+8) >> 2
409.     pm=GetParamPtr(pparameters,1)
410.     statement=GetLongParam(pst,pm)
411.     result=sqlite3_step(statement)
412.   else
413.     'noparams
414.  end if
415.   '
416.  ReturnLong(pst,pReturnValue,result)
417.   '
418.  end function
419.  
420.  
421.   function sqlite3_column_text cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
422.   '=======================================================================================================
423.  sys    statement
424.   string text
425.   sys    field
426.   sys np,pm
427.   '
428.  if pParameters then
429.     np=*(pParameters+8) >> 2
430.     pm=GetParamPtr(pparameters,1)
431.     statement=GetLongParam(pst,pm)
432.     pm=GetParamPtr(pparameters,2)
433.     field=GetLongParam(pst,pm)
434.     text=sqlite3_column_text(statement, field)
435.   else
436.     'noparams
437.  end if
438.   '
439.  ReturnString(pst,pReturnValue,text)
440.   '
441.  end function
442.  
443.  
444.  

Charles

DLL attached:

[JRS]

This is a very exciting development. Users of ScriptBasic can now use OxygenBasic to create DLL based extension modules. This was traditionally reserved for C programmers due to the heavy use of macros in the SB extension module API.

I'm going to give this a try in my XP VirtualBox. (Wine next ...)

Thank You !!!

[JRS]

Charles,

I really need support for SB arrays in the extension module interface. I also need to be able to pass these arrays back to SB in one of the functions augments. Please look at FetchHash() and FetchArray() in the MySQL extension module and maybe those array support macros could be made into O2 functions.

John

[JRS]

I tried your SQLite3 extension module with SB3 (MinGW32 compiled version) and it worked fine.


C:\scriptbasic\test>scriba sqlite3test.sb
DataBase Listing:
123 - Hello
234 - cruel
345 - world


C:\scriptbasic\test>

[Charles Pegge]

Good news, John. I'll investigate arrays now.

[JRS]

Thanks!

Could you also look at ReturnPTR as I use that for IUP to pass the control ID.

This is not the same as ReturnLong. (SB long integer)

[Charles Pegge]

Hi John,
I need to know how you populate a mortal array with values. What macros do you use? I'm stuck here.

PS: Thanks for your IUP code. The macro I am looking for is:

ARRAYVALUE(*Lval,i)

Code: [Select]

 for (i = 0; i < n; i++) {
    ARRAYVALUE(*Lval,i) = besNEWSTRING(strlen(names[i]));
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,i)), names[i], strlen(names[i]));
    }

PS: Good. I've cracked it for single dimensional arrays

You can return the whole array to scriptbasic as a return value

Code: [Select]


  T=trial(a,b,x,y)
  't[1]=123
  print T[0] & T[1] & T[2] & T[3] & T[4]

my mdlt code (Oxygen)

Code: [Select]

 p=CreateArray(pst,pReturnValue,0,16)
  for i=0 to 16
    ReturnString(pst,@a,"Val:"+str(i*10+1))
    q=*p+i*4
    *q=a
  next
  *pReturnValue=p


[JRS]

Charles,

Here is the INFO IUP function I created to return IUP system status constants in a SB associative array.

Code: [Select]

besFUNCTION(PuiInfo)
  VARIABLE Argument;
  unsigned long __refcount_;
  LEFTVALUE Lval;
  char buffer[1024];
  int i;
  const char *glbvar[] = {
  "SYSTEMLANGUAGE",
  "DRIVER",
  "SYSTEM",
  "SYSTEMLOCALE",
  "COMPUTERNAME",
  "USERNAME",
  "MONITORSINFO",
  "SCREENSIZE",
  "SCREENDEPTH",
  "VIRTUALSCREEN",
  "DLGFGCOLOR",
  "DLGBGCOLOR",
  "DEFAULTFONT",
  "DEFAULTFONTSIZE",
  "TXTFGCOLOR",
  "TXTBGCOLOR"
  };
 
  besRETURNVALUE = NULL;

  Argument = besARGUMENT(1);
  besLEFTVALUE(Argument,Lval);
  besRELEASE(*Lval);
  *Lval = NULL;

  *Lval = besNEWARRAY(0,ELEMENTS(glbvar)*2-1);
  if( *Lval == NULL )return COMMAND_ERROR_MEMORY_LOW;

  for (i =0; i < ELEMENTS(glbvar);i++) {
    ARRAYVALUE(*Lval,2*i) = besNEWSTRING(strlen(glbvar[i]));
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,2*i)),glbvar[i],strlen(glbvar[i]));
    memset(buffer,0,1024);
    strcpy(buffer, IupGetGlobal(glbvar[i]));
    ARRAYVALUE(*Lval,2*i+1) = besNEWSTRING(strlen(buffer));
    memcpy(STRINGVALUE(ARRAYVALUE(*Lval,2*i+1)),buffer,strlen(buffer));
  }

  besALLOC_RETURN_LONG;
  LONGVALUE(besRETURNVALUE) = -1;
besEND

Here is an example of it working.

[JRS]

You can return the whole array to scriptbasic as a return value.

That is a new feature for SB. The only way to return arrays (element or associative) before was in an BYREF argument.

Nice!

[Charles Pegge]

Demo Returning Array of data:

ScriptBasic

Code: [Select]

 declare sub SQLite3_Demo        alias "sqlite3_demo"        lib "sqlite3_mdl"
  declare sub SQLite3_Table       alias "sqlite3_table"       lib "sqlite3_mdl"
  declare sub SQLite3_ErrMsg      alias "sqlite3_errmsg"      lib "sqlite3_mdl"
  declare sub SQLite3_Open        alias "sqlite3_open"        lib "sqlite3_mdl"
  declare sub SQLite3_Close       alias "sqlite3_close"       lib "sqlite3_mdl"
  declare sub SQLite3_Exec        alias "sqlite3_exec"        lib "sqlite3_mdl"
  declare sub SQLite3_Prepare_v2  alias "sqlite3_prepare_v2"  lib "sqlite3_mdl"
  declare sub SQLite3_Step        alias "sqlite3_step"        lib "sqlite3_mdl"
  declare sub SQLite3_Column_Text alias "sqlite3_column_text" lib "sqlite3_mdl"

  SQLITE_ROW = 100
  '
  '
  T=SQLite3_Table()
  e=ubound(t)
  print e & "\n\n"
  for i=0 to e step 2
  print T[i] & " - " & T[i+1] & "\n"
  next
  '
  '
  line input w
Oxygen

Code: [Select]


  function sqlite3_table cdecl (sys pSt, ppModuleInternal, pParameters, pReturnValue) as sys, export
  '=================================================================================================
  indexbase 1
  sys     b,e,i
  sys     hdb
  sys     dberr
  sys     stmt
  sys     result
  string  s[4000]
  '
  char *  errmsg
  string  cr=chr(13)+chr(10)
  string  pr="DataBase Listing:" cr
  '
  sqlite3_open "testsql",hdb
  '
  sqlite3_exec hdb, "CREATE TABLE demo(someval INTEGER,  sometxt TEXT);", 0, 0, dberr
  sqlite3_exec hdb, "INSERT INTO demo VALUES (123, 'Hello');", 0, 0, dberr
  sqlite3_exec hdb, "INSERT INTO demo VALUES (234, 'cruel');", 0, 0, dberr
  sqlite3_exec hdb, "INSERT INTO demo VALUES (345, 'world');", 0, 0, dberr
  '
  result = sqlite3_prepare_v2 hdb, "SELECT * FROM demo;" cr, -1, stmt, 0
  '
  if dberr then @errmsg=dberr : print errmsg
  '
  '
  'COLLECT ALL DATA
  '
  i=0
  while sqlite3_step(stmt) = SQLITE_ROW
    i++ : s[i]=sqlite3_column_text(stmt, 0)
    i++ : s[i]=sqlite3_column_text(stmt, 1)
    if i>=4000 then exit do
  wend
  '
  sqlite3_close hdb
  '
  '
  'RETURNING ARRAY OF VALUES
  '=========================
  '
  b=0   'CHOOSE LBOUND
  e=i-1 'CHOOSE UBOUND
  '
  'pm=GetParamPtr(pParameters,3)
  'PutLongParam(pst,pm,b) 'PASS BACK LBOUND
  'pm=GetParamPtr(pParameters,4)
  'PutLongParam(pst,pm,e) 'PASS BACK UBOUND
  '
  if e<b then exit function
  '
  p=CreateArray(pst,b,e)
  *pReturnValue=p
  '
  '
  'FILL ARRAY
  '
  for i= 0 to e
    a=ReturnString pst, s[i+1]
    q=*p+i*4
    *q=a
  next
  '
  end function

Charles

PS:
What is besRETURN_PTR used for?
The name of this macro does not seem to match its procedure, not intuitively anyway.

[JRS]

That is so cool!

Sorry, that's besRETURN_POINTER().

Code: [Select]

/*
Ihandle *IupSetAttributes(Ihandle *ih, const char *str);  <iup.h>

Defines a set of attributes for an interface element.
*/
besFUNCTION(PuiSetAttributes)
  Ihandle *ih, *sameih;
  const char *attstr;

  besARGUMENTS("pz")
    &ih, &attstr
  besARGEND

  sameih = IupSetAttributes(ih, attstr);
  besRETURN_POINTER(sameih);
besEND