[Win32forth-cvs] win32forth/demos SQLite Demo.f, NONE, 1.1 WinSock Demo.f, NONE, 1.1

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

Update of /cvsroot/win32forth/win32forth/demos
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv3872/demos

Added Files:
	SQLite Demo.f WinSock Demo.f 
Log Message:
- Tom Dixon's WinSock and SQLite library's added

--- NEW FILE: WinSock Demo.f ---


\ Server Side

needs sock.f

create tbuf 256 allot

: sdump ( sock -- )
  begin
    dup sock-read? if dup tbuf 256 rot sock-read tbuf swap type then
    dup sock-closed? key? or until
  sock-close drop ;

s" www.technobox.de" 80 sock-open value sock
s" GET / HTTP/1.0" sock sock-write .
crlf$ count sock sock-write .
crlf$ count sock sock-write .

cr sock sdump

\s

0 value sock


: server-init ( -- )
  8003 sock-create dup to sock
  dup -1 = if abort" Unable to make socket!" then
  5 sock sock-listen ;


: serve ( -- )
  begin
    sock sock-accept?
      if sock sock-accept drop
         dup s" Server Hello! " rot sock-write drop
         dup get-local-time time-buf >time" rot sock-write drop
         10 ms sock-close drop
      then
  10 ms key? until ;


: server ( -- ) server-init serve ;


\ client side

: client ( hostname -- )
  8003 sock-open to sock
  begin 10 ms
    sock sock-read? dup
      if pad swap sock sock-read pad swap type else drop then
    sock sock-closed?
  until
  sock sock-close drop ;


.( Type 'server' or 's" hostname" client' to test the server or client)

--- NEW FILE: SQLite Demo.f ---
\ Benchmark for SQLite stuff
\ Thomas Dixon

anew -SQLiteDemo.f

include SQLite.f

SQLiteDB sqlite

10000 constant #records

: create-table ( -- )
  s" CREATE TABLE test (name varchar, id int, fl1 float, data blob )"
  execute: sqlite ;

: delete-table ( -- )
  s" DROP TABLE test"
  execute: sqlite ;

: row-iter ( xt -- )
  begin dup >r execute r>
  nextrow: sqlite until drop ;

\ Generating a random word
create tbuf 256 allot
create tstr 256 allot

: random-word ( -- str len )
  12 random 1 +
  dup tbuf c!
  0 do
    26 random 97 +
    tbuf i + 1 + c!
  loop tbuf count ;

\ Generating a random string
: random-str ( n -- str len )
  0 tstr c!
  0 do random-word tstr +place
       s"  " tstr +place loop
  tstr count ;


\ Fill tables with junk...

: ins-rows ( n -- )
  0 do
    s" INSERT INTO test(name, id, fl1, data) VALUES(?,?,?,?)"
    execute: sqlite
    4 random 1+ random-str 0         bindstr: sqlite
    i 1                              bindint: sqlite
    i s>f 3.14159265358979e0 f* 2  bindfloat: sqlite
    get-local-time time-buf 16 3    bindblob: sqlite
  loop ;


\ misc operations
: walk-table ( -- )
  0 ['] 1+ row-iter
  ." Ran through " . ."  rows." ;

: order-by-int ( -- )
  s" select * from test order by id desc"
  execute: sqlite ;

: order-by-float ( -- )
  s" select * from test order by fl1 desc"
  execute: sqlite ;

: order-by-string ( -- )
  s" select * from test order by name desc"
  execute: sqlite ;

: order-by-blob ( -- )
  s" select * from test order by data desc"
  execute: sqlite ;

: random-access ( n -- )
  0 do
    s" select * from test where id = ?" execute: sqlite
    #records random 0 bindint: sqlite
  loop ;

\ for debug
: qdump ( -- )
  fieldcnt: sqlite
  0 ?do
    i fieldname: sqlite type tab
  loop cr cr
  begin
    fieldcnt: sqlite
    0 ?do
        i getstr: sqlite type tab
    loop cr
    nextrow: sqlite
  until ;




: memory-db ( -- )
  s" :memory:" open: sqlite ;

: file-db ( -- )
  s" c:\mytest.db" open: sqlite ;

cr cr .( SQLITE Benchmark! )
cr cr .( Creating Database from RAM:  )
elapse memory-db
cr cr .( Creating Tables:   )
elapse create-table
cr cr #records . .( row insert:   )
elapse #records ins-rows
cr cr .( Ordering Data by Integer: )
elapse order-by-int
cr cr .( Walk Through All Records: )
elapse walk-table
cr cr .( Ordering Data by Float: )
elapse order-by-float
cr cr .( Walk Through All Records: )
elapse walk-table
cr cr .( Ordering Data by String: )
elapse order-by-string
cr cr .( Walk Through All Records: )
elapse walk-table
cr cr .( Ordering Data by Blob: )
elapse order-by-blob
cr cr .( Walk Through All Records: )
elapse walk-table
cr cr .( Random Access -100 records- :)
elapse 100 random-access
cr cr .( Deleting Tables: )
elapse delete-table