[Win32forth-cvs] win32forth/demos/COM D3Dtest.f,NONE,1.1 EX_ADO.F,NONE,1.1 EX_D3D.F,NONE,1.1 EX_DDRAW.F,NONE,1.1 EX_SAPI.F,NONE,1.1

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/demos/COM
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15255/demos/COM

Added Files:
	D3Dtest.f EX_ADO.F EX_D3D.F EX_DDRAW.F EX_SAPI.F 
Log Message:
Uploaded Tom's COM support.

--- NEW FILE: EX_ADO.F ---
\ Example of using ADO 
\ Thomas Dixon

\ This is a very simple sql utility

needs fcom

2 7 typelib {EF53050B-882E-4776-B643-EDA472E8E3F2} \ inlude ADO type library

_RecordSet ComIFace rec

create DSN 1024 allot                            \ DSN holder
create querybuf 1024 allot                       \ holds the query buffer
create cCol 32 allot     u" ," cCol uniplace     \ Column Delimeter
create NL 32 allot crlf$ count >unicode NL uniplace \ New Record Delimeter
create nullch 32 allot  u" " nullch uniplace     \ Null Character Replacement
create sqlbuf 0 , 0 ,                            \ holds the returned buffer

: DSN! ( str len -- ) 0 CoInitialize drop      \ store the connection string (ODBC)
  rec @ 0= if
    rec _RecordSet 1 0 RecordSet CoCreateInstance 
     abort" Unable to Create ADO Recordset!"
  then asc>uni 2dup DSN uniplace drop free drop ;

: SQLEXEC ( options locktype cursortype -- ) 
  0 DSN unicount drop 0 8 0 querybuf unicount drop 0 8 
  rec open abort" Unable to Execute SQL Query!" ;

: records>str ( -- str len ) \ converts recordset to string
  sqlbuf @ ?dup if free drop then 0 sqlbuf !
  sqlbuf nullch unicount drop NL unicount drop ccol unicount drop -1 2
  rec GetString abort" Unable to convert data to String!" 
  sqlbuf @ dup zunicount uni>asc 2dup sqlbuf cell+ ! sqlbuf !
  rot CoTaskMemFree drop ;

: SQL ( str len -- str len )     \ executes a query
  asc>uni 2dup querybuf uniplace drop free drop 
  adOptionUnspecified adLockUnspecified adOpenDynamic  
  SQLEXEC records>str ;


((
\ Here is a simple example I use on my System
\ (Assumes 'DBTest' is a dsn on the machine with a table called 'test')

s" DSN=DBTest" dsn!                                 \ Load the DSN
s" Select * FROM test" SQL cr type                  \ Execute a query
rec close drop                                      \ cleanup

))