Tweet
I do an enormous amount of work with MySql and other databases in powerbasic. I have libraries I have created in Powerbasic and they are fast. But they have a one limit they only allow one connection to the server at a time. With mysql it is because of problems passing the T_MySql Ptr between functions.
I have spent the last 18 months working with VB.net 2005 on a major project and I had to create a set of application API Classes for the project. That got me thinking Powerbasic has Objects why not try and use it solve my Multiple connection problem with Mysql as Trial and I can learn the Powerbasic objects in the process.
It has taken two weeks of sleepless nights but I have a prototype that I have beatin into submission and it works. I am putting up as a working example of a Class for other programmers like me as there is a distinct lake there in.
Ok Now don't shoot the programmer, This is my first class in powerbasic and I have still goto come to grips with it.
I have spent the last 18 months working with VB.net 2005 on a major project and I had to create a set of application API Classes for the project. That got me thinking Powerbasic has Objects why not try and use it solve my Multiple connection problem with Mysql as Trial and I can learn the Powerbasic objects in the process.
It has taken two weeks of sleepless nights but I have a prototype that I have beatin into submission and it works. I am putting up as a working example of a Class for other programmers like me as there is a distinct lake there in.
Ok Now don't shoot the programmer, This is my first class in powerbasic and I have still goto come to grips with it.
Code:
'==============================================================================
' MySql Class Version 1.01 Ported by Martin Draper 2009 for PBCC50
'
' Originally Ported to PowerBASIC by Florent Heyworth - 17-Sep-2001 (incomplete)
' Copyright (C) 2000 MySQL AB & MySQL Finland AB & TCX DataKonsult AB
'
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Library General Public
' License as published by the Free Software Foundation; either
' version 2 of the License, or (at your option) any later version.
'
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
' Library General Public License for more details.
'
' You should have received a copy of the GNU Library General Public
' License along with this library; if not, write to the Free
' Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
' MA 02111-1307, USA */
'
'--------------------------------------------------------------------------
' Changes 10/09/2009 New version built as a class
' The only major problem with previous mysql libraries was that only
' allowed one connection to the server at a time and a lot of things
' this was acceptable But with Mailserver prototype when the system
' design was expanded to handle multiple threads the Mysql library
' threw errors left right and center.
'
' This version was created to develope a mysql library that can handle
' multiple sql connection simultaneously
'--------------------------------------------------------------------------
'
#COMPILE EXE
#DIM ALL
'
'mysql_option enum
'
%MYSQL_OPT_CONNECT_TIMEOUT = 0
%MYSQL_OPT_COMPRESS = 1
%MYSQL_OPT_NAMED_PIPE = 2
%MYSQL_INIT_COMMAND = 3
%MYSQL_READ_DEFAULT_FILE = 4
%MYSQL_READ_DEFAULT_GROUP = 5
%MYSQL_SET_CHARSET_DIR = 6
%MYSQL_SET_CHARSET_NAME = 7
'
'mysql_status enum
'
%MYSQL_STATUS_READY = 0
%MYSQL_STATUS_GET_RESULT = 1
%MYSQL_STATUS_USE_RESULT = 2
%MYSQL_ERRMSG_SIZE = 200
%CLIENT_LONG_PASSWORD = 1 'new more secure passwords
%CLIENT_FOUND_ROWS = 2 'Found instead of affected rows
%CLIENT_LONG_FLAG = 4 'Get all column flags
%CLIENT_CONNECT_WITH_DB = 8 'One can specify db on connect
%CLIENT_NO_SCHEMA = 16 'Don't allow database.table.column
%CLIENT_COMPRESS = 32 'Can use compression protocol
%CLIENT_ODBC = 64 'Odbc client
%CLIENT_LOCAL_FILES = 128 'Can use LOAD DATA LOCAL
%CLIENT_IGNORE_SPACE = 256 'Ignore spaces before '('
%CLIENT_CHANGE_USER = 512 'Support the mysql_change_user()
%CLIENT_INTERACTIVE = 1024 'This is an interactive client
%CLIENT_SSL = 2048 'Switch to SSL after handshake
%CLIENT_IGNORE_SIGPIPE = 4096 'IGNORE sigpipes
%CLIENT_TRANSACTIONS = 8196 'Client knows about transactions
'
'enum field types
'
%FIELD_TYPE_DECIMAL = 0
%FIELD_TYPE_TINY = 1
%FIELD_TYPE_SHORT = 2
%FIELD_TYPE_LONG = 3
%FIELD_TYPE_FLOAT = 4
%FIELD_TYPE_DOUBLE = 5
%FIELD_TYPE_NULL = 6
%FIELD_TYPE_TIMESTAMP = 7
%FIELD_TYPE_LONGLONG = 8
%FIELD_TYPE_INT24 = 9
%FIELD_TYPE_DATE = 10
%FIELD_TYPE_TIME = 11
%FIELD_TYPE_DATETIME = 12
%FIELD_TYPE_YEAR = 13
%FIELD_TYPE_NEWDATE = 14
%FIELD_TYPE_ENUM =247
%FIELD_TYPE_SET =248
%FIELD_TYPE_TINY_BLOB =249
%FIELD_TYPE_MEDIUM_BLOB =250
%FIELD_TYPE_LONG_BLOB =251
%FIELD_TYPE_BLOB =252
%FIELD_TYPE_VAR_STRING =253
%FIELD_TYPE_STRING =254
TYPE T_USED_MEM '/* struct for once_alloc */
ptNext AS T_USED_MEM PTR '/* Next block in use */
dwLeft AS DWORD '/* memory left in block */
dwSize AS DWORD '/* size of block */
END TYPE
TYPE T_MEM_ROOT
ptFree AS T_USED_MEM PTR
ptUsed AS T_USED_MEM PTR
ptPreAlloc AS T_USED_MEM PTR
dwMinMalloc AS DWORD
dwBlockSize AS DWORD
END TYPE
TYPE T_MYSQL_OPTIONS
dwConnectTimeout AS DWORD
dwClientFlag AS DWORD
bFlagCompress AS BYTE
bFlagNamedPipe AS BYTE
pszHost AS ASCIIZ PTR
pszInitCommand AS ASCIIZ PTR
pszUser AS ASCIIZ PTR
pszPassword AS ASCIIZ PTR
pszUnixSocket AS ASCIIZ PTR
pszDb AS ASCIIZ PTR
pszMyConfFile AS ASCIIZ PTR
pszMyConfGroup AS ASCIIZ PTR
pszCharsetDir AS ASCIIZ PTR
pszCharsetName AS ASCIIZ PTR
bFlagUseSSL AS BYTE '/* if to use SSL or not */
pszSSLKey AS ASCIIZ PTR '/* PEM key file */
pszSSLCert AS ASCIIZ PTR '/* PEM cert file */
pszSSLCa AS ASCIIZ PTR '/* PEM CA file */
pszSSLCaPath AS ASCIIZ PTR '/* PEM directory of CA-s? */
END TYPE
TYPE T_NET
dwVio AS DWORD
lSock AS LONG
lFcntl AS LONG
pbBuf AS BYTE PTR
pbBufEnd AS BYTE PTR
pbWritePos AS BYTE PTR
pbReadPos AS BYTE PTR
szLastError AS ASCIIZ * %MYSQL_ERRMSG_SIZE
lLastErrNo AS LONG
lMaxPacket AS LONG
lTimeOut AS LONG
lPktNr AS LONG
bError AS BYTE
bFlagReturnErrNo AS BYTE
bFlagCompress AS BYTE
bFlagNoSendOk AS BYTE
lRemainInBuf AS LONG
lBufLength AS LONG
lWhereb AS LONG
plReturnStatus AS LONG PTR
bReadingOrWriting AS BYTE
bSaveChar AS BYTE
END TYPE
TYPE T_MYSQL_FIELD
pszName AS ASCIIZ PTR '/* Name of column */
pszTable AS ASCIIZ PTR '/* Table of column if column was a field */
pszDef AS ASCIIZ PTR '/* Default value (set by mysql_list_fields) */
lFieldType AS LONG '/* Type of field. Se mysql_com.h for types */
dwLength AS DWORD '/* Width of column */
dwMaxLength AS DWORD '/* Max width of selected set */
dwFlags AS DWORD '/* Div flags */
dwDecimals AS DWORD '/* Number of decimals in field */
END TYPE
TYPE T_CHARSET_INFO
dwNumber AS DWORD
pszName AS ASCIIZ PTR
pbCType AS BYTE PTR
pbToLower AS BYTE PTR
pbToUpper AS BYTE PTR
pbSortOrder AS BYTE PTR
dwStrxFrmMultiply AS DWORD
pFuncStrColl AS DWORD
pFuncStrxFrm AS DWORD
pFuncStrnnColl AS DWORD
pFuncStrnxFrm AS DWORD
pbFuncLikeRange AS DWORD
dwMbMaxLen AS DWORD
pFuncIsMbChar AS DWORD
pbFuncIsMbHead AS DWORD
pMbCharLen AS DWORD
END TYPE
TYPE T_MYSQL
tNet AS T_NET
pszGptr AS ASCIIZ PTR
pszHost AS ASCIIZ PTR
pszUser AS ASCIIZ PTR
pszPassword AS ASCIIZ PTR
pszUnixSocket AS ASCIIZ PTR
pszServerVersion AS ASCIIZ PTR
pszHostInfo AS ASCIIZ PTR
dwPort AS DWORD
dwClientFlag AS DWORD
dwServerCapabilities AS DWORD
dwProtocolVersion AS DWORD
dwFieldCount AS DWORD
dwServerStatus AS DWORD
dwThreadId AS DWORD
qAffectedRows AS QUAD
qInsertId AS QUAD
qExtraInfo AS QUAD
ptFields AS T_MYSQL_FIELD PTR
tFieldAlloc AS T_MEM_ROOT
bFlagFreeMe AS BYTE
bFlagReconnect AS BYTE
tOptions AS T_MYSQL_OPTIONS
szScramble AS ASCIIZ * 9
ptCharset AS T_CHARSET_INFO PTR
dwServerLanguage AS DWORD
END TYPE
TYPE T_MYSQL_ROWS
ptNext AS DWORD 'list of rows
pszData AS ASCIIZ PTR
END TYPE
TYPE T_MYSQL_DATA
qRows AS QUAD
dwFields AS DWORD
ptData AS T_MYSQL_ROWS PTR
tAlloc AS T_MEM_ROOT
END TYPE
TYPE T_MYSQL_RES
qRowCount AS QUAD
dwFieldCount AS DWORD
dwCurrentField AS DWORD
ptFields AS T_MYSQL_FIELD PTR
ptData AS T_MYSQL_DATA PTR
ptDataCursor AS T_MYSQL_ROWS PTR
ptFieldAlloc AS T_MEM_ROOT '/* If unbuffered read */
pszRow AS ASCIIZ PTR '/* array of strings */
pszCurrentRow AS ASCIIZ PTR '/* column lengths of current row *
pdwLength AS DWORD PTR '/* for unbuffered reads */
tHandle AS T_MYSQL PTR '/* Used my mysql_fetch_row */
bEof AS BYTE
END TYPE
'
GLOBAL ServerAddress AS ASCIIZ * 32
GLOBAL DatabaseName AS ASCIIZ * 32
GLOBAL DatabaseUser AS ASCIIZ * 32
GLOBAL DatabasePwd AS ASCIIZ * 32
#IF NOT %DEF(%NULL)
%NULL = 0
#ENDIF
DECLARE FUNCTION mysql_init LIB "libmySQL.DLL" ALIAS "mysql_init" (BYVAL ptMYSQL AS T_MYSQL PTR ) AS LONG
DECLARE FUNCTION mysql_errno LIB "libmySQL.DLL" ALIAS "mysql_errno" (BYVAL ptMYSQL AS T_MYSQL PTR) AS LONG
DECLARE FUNCTION mysql_error LIB "libmySQL.DLL" ALIAS "mysql_error" (BYVAL ptMYSQL AS T_MYSQL PTR) AS LONG
DECLARE FUNCTION mysql_real_connect LIB "libmySQL.DLL" ALIAS "mysql_real_connect" _
( BYVAL ptMYSQL AS T_MYSQL PTR, szHostName AS ASCIIZ, szUserName AS ASCIIZ, szPassword AS ASCIIZ, szDbName AS ASCIIZ, BYVAL lPortNum AS LONG,_
szSocketName AS ASCIIZ, BYVAL lFlags AS LONG) AS LONG
DECLARE FUNCTION mysql_query LIB "libmySQL.DLL" ALIAS "mysql_query" (BYVAL ptMYSQL AS T_MYSQL PTR, sQueryString AS ASCIIZ) AS LONG
DECLARE FUNCTION mysql_store_result LIB "libmySQL.DLL" ALIAS "mysql_store_result" (BYVAL ptMYSQL AS T_MYSQL PTR) AS LONG
DECLARE FUNCTION mysql_num_rows LIB "libmySQL.DLL" ALIAS "mysql_num_rows" (BYVAL ptResult AS T_MYSQL_RES PTR ) AS LONG
DECLARE FUNCTION mysql_num_fields LIB "libmySQL.DLL" ALIAS "mysql_num_fields" (BYVAL ptResult AS T_MYSQL_RES PTR) AS LONG
DECLARE FUNCTION mysql_fetch_row LIB "libmySQL.DLL" ALIAS "mysql_fetch_row" (BYVAL ptResult AS T_MYSQL_RES PTR ) AS LONG
DECLARE FUNCTION mysql_field_count LIB "libmySQL.DLL" ALIAS "mysql_field_count" (BYVAL ptMYSQL AS T_MYSQL PTR) AS LONG
DECLARE SUB mysql_close LIB "libmySQL.DLL" ALIAS "mysql_close" (BYVAL ptMYSQL AS T_MYSQL PTR)
CLASS MySql
INSTANCE Connection AS LONG
INTERFACE MySqlConnection
INHERIT IUNKNOWN ' inherit the base class
'Method mySqlErrNo_Str(byval tSqlStruct as T_MYSQL PTR) AS STRING
'Method = FORMAT$(mysql_errno( BYVAL tSqlStruct ))
'END Method
METHOD GetSQLConfig(ConfigFile AS STRING) AS INTEGER
'
LOCAL FileHandle AS LONG
' set the default db is non is specificed
IF ConfigFile = "" THEN ConfigFile = "DBConfig.cfg"
' add the extension if non exists
IF RIGHT$(ConfigFile,4) <> ".cfg" THEN ConfigFile = ConfigFile + ".cfg"
' read the database setup from the config file
FileHandle = FREEFILE
OPEN ConfigFile FOR INPUT AS FileHandle
INPUT #FileHandle, ServerAddress,DatabaseName,DatabaseUser,DatabasePwd
CLOSE FileHandle
'
END METHOD
METHOD SqlConnect AS LONG
LOCAL Filehandle AS LONG
LOCAL tSqlStruct AS T_MYSQL PTR
LOCAL ErrorCode AS STRING
LOCAL tSqlhandle AS T_MYSQL PTR
'
ErrorCode = ""
'
' initialise the structures for the mysql queru and result
'
tSqlStruct = mysql_init( BYVAL %NULL )
IF tSqlStruct = %NULL THEN
'ErrorCode = mySqlErrNo_Str(tSqlStruct)
FileHandle = FREEFILE
OPEN "ErrorFile" FOR APPEND AS Filehandle
PRINT #Filehandle, DATE$ +" " + TIME$ + ", " + "Initialization Failed " + ErrorCode
CLOSE Filehandle
'Method = 0
'EXIT FUNCTION
END IF
' connect to the mysql server using ipaddress username and password
PRINT TRIM$(ServerAddress),TRIM$(DatabaseUser),TRIM$(DatabasePwd), TRIM$(DatabaseName)
tSqlhandle = mysql_real_connect( BYVAL tSqlStruct, TRIM$(ServerAddress),_
TRIM$(DatabaseUser),TRIM$(DatabasePwd), TRIM$(DatabaseName), 3306, BYVAL %NULL, 0 )
IF tSqlhandle = %NULL THEN
'FUNCTION = 0
'ErrorCode = mySqlErrNo_Str()
tSqlStruct = %Null
FileHandle = FREEFILE
OPEN "ErrorFile" FOR APPEND AS Filehandle
PRINT #Filehandle, DATE$ +" " + TIME$ + ", " + "Connect " +TRIM$(ServerAddress) + _
TRIM$(DatabaseUser) + TRIM$(DatabasePwd) + TRIM$(DatabaseName) + " failed " +ErrorCode
CLOSE Filehandle
CALL mysql_close( BYVAL tSqlStruct )
'EXIT FUNCTION
END IF
METHOD = tSqlStruct
END METHOD
METHOD SQLQuery(BYVAL tSqlStruct AS T_MYSQL PTR, Query AS ASCIIZ) AS LONG
LOCAL FileHandle AS LONG
LOCAL ErrorCode AS STRING
LOCAL ResultPt AS T_MYSQL_RES PTR
LOCAL RowCount AS LONG
LOCAL FieldCount AS LONG
ErrorCode = ""
' send the query to the mysql server
IF mysql_query( BYVAL tSqlStruct,Query) THEN
'ErrorCode = mySqlErrNo_Str()
FileHandle = FREEFILE
OPEN "ErrorFile" FOR APPEND AS FileHandle
PRINT #FileHandle, DATE$ +" " + TIME$ + ", " + "mysql_query(" + Query + ") failed " + ErrorCode
CLOSE FileHandle
'FUNCTION = 0
EXIT METHOD
END IF
' call store result prior to retrieving the rows the decode the FieldCount and RowCount
ResultPt = mysql_store_result( BYVAL tSqlStruct )
' if there is a result then get the details of the result
'IF ResultPt > 0 THEN
' RowCount = mysql_num_rows(ResultPt)
' print RowCount;"++++++++++++++++++"
' FieldCount = mysql_num_fields(ResultPt)
' PRINT FieldCount;"++++++++++++++++++"
'END IF
'
METHOD = ResultPt
END METHOD
METHOD Rowcount( BYVAL ResultPt AS T_MYSQL_RES PTR) AS LONG
' get the number of rows in the query
IF ResultPt > 0 THEN
METHOD = mysql_num_rows(ResultPt)
ELSE
METHOD = 0
END IF
END METHOD
METHOD Fieldcount(BYVAL ResultPt AS T_MYSQL_RES PTR) AS LONG
' Get the number field isn the query
IF ResultPt > 0 THEN
METHOD = mysql_num_fields(ResultPt)
ELSE
METHOD = 0
END IF
END METHOD
METHOD GetRecord(BYVAL ResultPt AS T_MYSQL_RES PTR, Dataset AS VARIANT) AS LONG
'
LOCAL Index AS LONG
LOCAL pRow AS ASCIIZ PTR
LOCAL DBField() AS STRING
LOCAL ArrayFields AS INTEGER
' Get the array size
ArrayFields = mysql_num_fields(ResultPt)
DIM DBField(ArrayFields)
' Get the record from the results table and put then into the fields
pRow = mysql_fetch_row( BYVAL ResultPt )
' Get the fields within each row of the table
IF pRow THEN
FOR Index = 0 TO mysql_num_fields(ResultPt) -1
DBField(Index +1) = @@pRow
'print DbField (Index +1)
' increment the table pointer to the next record
! add pRow, 4
NEXT Index
LET Dataset = DBField()
END IF
END METHOD
METHOD SqlClose(BYVAL tSqlStruct AS T_MYSQL PTR) AS INTEGER
PRINT "----";tSqlStruct
mysql_close BYVAL tSqlStruct
END METHOD
END INTERFACE
END CLASS
FUNCTION PBMAIN () AS LONG
DIM Connection AS MysqlConnection
DIM SqlConnection AS LONG
DIM ResultHandle AS LONG
DIM DbField() AS STRING
DIM Index AS LONG
DIM Index2 AS LONG
DIM Dataset AS VARIANT
DIM RowCount AS LONG
DIM FieldCount AS LONG
Connection = CLASS "MySql"
' get the configuration for sql server
Connection.GetSqlConfig("")
'create a connection to the server
SqlConnection = Connection.SqlConnect
' change to the mail database
Connection.SqlQuery (SqlConnection,"Use Pbmail")
' query the black hole list
ResultHandle = Connection.SqlQuery (SqlConnection,"Select * from BHL")
' get the size if the result
RowCount = Connection.RowCount(ResultHandle)
FieldCount = Connection.FieldCount(ResultHandle)
' get the record from the table
DIM DbField(FieldCount)
FOR Index = 1 TO Connection.RowCount(ResultHandle)
Connection.GetRecord(ResultHandle, Dataset)
LET dbfield() = dataset
FOR Index2 = 1 TO FieldCount
PRINT DBField(Index2)
NEXT Index2
NEXT Index
' close the connection
Connection.SqlClose(SqlConnection)
PRINT SqlConnection
END FUNCTION
Comment