\ Mysql Class by Larry Daniel October 2005
\ Class mysql is a simple interface to the mysql database. It uses the libmysql.dll that comes with the
\ free mysql database. To use this class put the libmysql.dll in the win32forth main directory with this
\ file. When you fload this file it will load the dll and give access to the database.
\
\ You must edit this file at the bottom to change your user and host to access the database.
\
\ Then fload this file like: fload mysql.f
\
\ Then use the sql command to parse and display results of your sql like: sql use mydb;
\ Notice the sql uses the semicolon to delimit the end of line. You must have a semicolon at the end
\ of your sql for it to work.
\
anew --mysql--

:class mysql <super object

dll libmysql.dll LIBMYSQL

0 value mysql_g
0 value res
0 value row
0 value field

0 proc mysql_thread_init
0 proc mysql_thread_end
1 proc mysql_init
8 proc mysql_real_connect
4 proc mysql_change_user
2 proc mysql_select_db
2 proc mysql_query
3 proc mysql_send_query
1 proc mysql_store_result
1 proc mysql_use_result
1 proc mysql_stat
1 proc mysql_close
0 proc mysql_get_client_info
1 proc mysql_get_host_info
1 proc mysql_get_server_info
1 proc mysql_num_rows
1 proc mysql_num_fields
1 proc mysql_eof
1 proc mysql_fetch_fields
2 proc mysql_fetch_field_direct
1 proc mysql_fetch_row
1 proc mysql_error

: zt ( zstring -- )
	?dup 0= if z" null" then zcount type cr ;

:m ClassInit:
	0 call mysql_init dup to mysql_g
	cr ." Initialized: " .
	;m

:m Close:
	mysql_g call mysql_close drop
	;m

:m Connect: { zuser zpass zhost }
	\ clientFlag, unixsocket, port, db, passwd,user,host
	 0 0 3306 0 zpass zuser zhost mysql_g call mysql_real_connect drop
	;m

:m Logon: { userz passz dbz -- }
	dbz passz userz mysql_g call mysql_change_user if ." Logged in " cr then
	;m

:m GetError:
	mysql_g call mysql_error zt
	;m

:m SelectDb: { dbz }
	dbz mysql_g call mysql_select_db 0<> if
		GetError: self
		abort" Error Selecting Database"
	then
	;m

:m Query: { qz }
	qz mysql_g call mysql_query drop
	mysql_g call mysql_store_result to res
	res 0= if
		GetError: self
	then
	;m

:m FetchRow: ( -- | returns a pointer to array of strings or null )
	res ?dup 0= if 0 to row else call mysql_fetch_row to row then
	;m

:m GetRowString: { index -- addr len }
	row ?dup 0= if
		pad 0
	else
		index 4 * + @ ?dup 0= if z" null" then zcount
	then
	;m

:m GetRowCount: ( -- rows )
	res ?dup 0= if 0 else call mysql_num_rows then
	;m

:m GetFieldCount: ( -- fields )
	res ?dup 0= if 0 else call mysql_num_fields then
	;m

:m DisplayFields: ( -- )
	GetFieldCount: self ?dup 0 > if
		0 do
			i res call mysql_fetch_field_direct to field
			field @ zcount type ."  "
		loop
		cr
	then
	;m

:m DumpRow: ( -- )
	GetFieldCount: self ?dup 0 > if
		0 do
			i GetRowString: self type ." ,"
		loop cr
	then
	;m

:m GetEOF: ( -- f )
	res call mysql_eof
	;m

:m DisplayRows:
	GetRowCount: self ?dup 0> if
	cr DisplayFields: self
	0 do
			FetchRow: self
			DumpRow: self
		loop
	then
	;m

:m Status:
	call mysql_get_client_info ." Client Info: " zt
	mysql_g call mysql_get_host_info ." Host Info: " zt
	mysql_g call mysql_get_server_info ." Server Info: " zt
	mysql_g call mysql_stat ." Status: " zt
	;m

;class

mysql database
\ Change your login and host here
z" root" z" " z" 10.26.17.48" Connect: database
\ z" " z" " z" 127.0.0.1" Connect: database
Status: database

: sql ( query; -- )
	ascii ; word 1+
	Query: database DisplayRows: database
	;