From 9b5cef673f124e8aa74d7ca38712f6536630d2d9 Mon Sep 17 00:00:00 2001 From: Maurilio Longo Date: Sun, 28 May 2000 11:11:17 +0000 Subject: [PATCH] 20000528-13:08 GMT+2 Maurilio Longo --- harbour/ChangeLog | 14 + harbour/contrib/msql/Makefile | 17 + harbour/contrib/msql/msql.c | 177 ++++++++ harbour/contrib/msql/msql.ch | 63 +++ harbour/contrib/msql/msql.h | 195 +++++++++ harbour/contrib/msql/readme.txt | 47 ++ harbour/contrib/msql/test.prg | 110 +++++ harbour/contrib/msql/tmsql.prg | 755 ++++++++++++++++++++++++++++++++ 8 files changed, 1378 insertions(+) create mode 100644 harbour/contrib/msql/Makefile create mode 100644 harbour/contrib/msql/msql.c create mode 100644 harbour/contrib/msql/msql.ch create mode 100644 harbour/contrib/msql/msql.h create mode 100644 harbour/contrib/msql/readme.txt create mode 100644 harbour/contrib/msql/test.prg create mode 100644 harbour/contrib/msql/tmsql.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d22ac41265..e634e74bc5 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,17 @@ +20000528-13:08 GMT+2 Maurilio Longo + + + contrib/msql/ + + added subdir msql to contrib tree + + contrib/msql/readme.txt + + contrib/msql/Makefile + + contrib/msql/msql.c + + contrib/msql/msql.h + + contrib/msql/msql.ch + + contrib/msql/tmsql.prg + + contrib/msql/test.prg + + added files making up mSQL access classes. They're work in progress, but + we all believe in "release early, release often", don't we? :-) + 2000-05-28 02:15 UTC-500 Paul Tucker * makefile.bc * move eval from rtl.lib to vm.lib diff --git a/harbour/contrib/msql/Makefile b/harbour/contrib/msql/Makefile new file mode 100644 index 0000000000..2774bdfa02 --- /dev/null +++ b/harbour/contrib/msql/Makefile @@ -0,0 +1,17 @@ +CompOptions = -m -n -I../include + +objects = test.o msql.o tmsql.o + +precomp = test.c msql.c tmsql.c + +source = test.prg tmsql.prg + +test: $(objects) + gcc -O2 -o test.exe $(objects) -I..\include -L..\lib -lrtl -lvm -lgtos2 -lrdd -llang -lmacro -lpp -ldbfntx -lcommon -lrtl -lvm -llibmsql -lsocket + +$(objects): $(precomp) + gcc -O2 -c $(precomp) -I..\include + +$(precomp): $(source) + ..\bin\harbour $(CompOptions) $(source) + diff --git a/harbour/contrib/msql/msql.c b/harbour/contrib/msql/msql.c new file mode 100644 index 0000000000..2f93275608 --- /dev/null +++ b/harbour/contrib/msql/msql.c @@ -0,0 +1,177 @@ + +/* + * Harbour Project source code: + * mSQL DBMS low level (client api) interface code. + * + * Copyright 2000 Maurilio Longo + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + + +/* NOTE: we need this to prevent base types redefinition */ +#define _CLIPDEFS_H + +#include "extend.api" +#include "item.api" +#include "msql.h" + +HB_FUNC(MSQLCONNEC) // int msqlConnect(char *) +{ + _retni(msqlConnect(_parc(1))); +} + + +HB_FUNC(MSQLCLOSE) // void msqlClose(int) +{ + msqlClose(_parni(1)); + _ret(); +} + + +HB_FUNC(MSQLSELECT) // int msqlSelectDB(int, char *) +{ + _retni(msqlSelectDB(_parni(1), _parc(2))); +} + + +HB_FUNC(MSQLQUERY) // int msqlQuery(int, char *) +{ + _retni(msqlQuery(_parni(1), _parc(2))); +} + + +HB_FUNC(MSQLSTORER) // m_result *msqlStoreResult() +{ + _retnl((long) msqlStoreResult()); +} + + +HB_FUNC(MSQLFREER) // void msqlFreeResult(m_result *) +{ + msqlFreeResult((m_result *)_parnl(1)); + _ret(); +} + + +/* NOTE: need number of retrieved fields */ +HB_FUNC(MSQLFETCHR) // m_row msqlFetchRow(m_result *, int) +{ + m_result *mresult = (m_result *)_parnl(1); + int num_fields = _parnl(2); + + ITEM aRow = _itemArrayNew(num_fields); + ITEM temp; + m_row mrow; + int i; + + mrow = msqlFetchRow(mresult); + + for (i = 0; i < num_fields; i++) { + + /* if field is not empty */ + if (mrow[i] != NULL) { + temp = _itemPutC(NULL, mrow[i]); + } else { + temp = _itemPutC(NULL, ""); + } + + _itemArrayPut(aRow, i + 1, temp); + _itemRelease(temp); + } + _itemReturn(aRow); + _itemRelease(aRow); +} + + +HB_FUNC(MSQLDATASE) // void msqlDataSeek(m_result *, int) +{ + msqlDataSeek((m_result *)_parnl(1), _parni(2)); + _ret(); +} + + +HB_FUNC(MSQLNUMROW) // int msqlNumRows(m_result *) +{ + _retni(msqlNumRows(((m_result *)_parnl(1)))); +} + + +HB_FUNC(MSQLFETCHF) // m_field *msqlFetchField(m_result *) +{ + /* NOTE: m_field structure of mSQL 2.x has 5 members */ + ITEM aField = _itemArrayNew(5); + + ITEM temp; + m_field *mfield; + + mfield = msqlFetchField((m_result *)_parnl(1)); + if (!(mfield == NULL)) { + temp = _itemPutC(NULL, mfield->name); + _itemArrayPut(aField, 1, temp); + _itemRelease(temp); + temp = _itemPutC(NULL, mfield->table); + _itemArrayPut(aField, 2, temp); + _itemRelease(temp); + temp = _itemPutNL(NULL, mfield->type); + _itemArrayPut(aField, 3, temp); + _itemRelease(temp); + temp = _itemPutNL(NULL, mfield->length); + _itemArrayPut(aField, 4, temp); + _itemRelease(temp); + temp = _itemPutNL(NULL, mfield->flags); + _itemArrayPut(aField, 5, temp); + _itemRelease(temp); + } + _itemReturn(aField); + _itemRelease(aField); + +} + + +HB_FUNC(MSQLFIELDS) // void msqlFieldSeek(m_result *, int) +{ + msqlFieldSeek((m_result *)_parnl(1), _parni(2)); + _ret(); +} + + +HB_FUNC(MSQLNUMFIE) // int msqlNumFields(m_result *) +{ + _retni(msqlNumFields(((m_result *)_parnl(1)))); +} + + +HB_FUNC(MSQLLISTFI) // m_result *msqlListFields(int, char *); +{ + _retnl((long) msqlListFields(_parni(1), _parc(2))); +} + + +HB_FUNC(MSQLGETERR) // char *msqlGetErrMsg(char *); +{ + _retc(msqlGetErrMsg(NULL)); +} + diff --git a/harbour/contrib/msql/msql.ch b/harbour/contrib/msql/msql.ch new file mode 100644 index 0000000000..ebc76c0405 --- /dev/null +++ b/harbour/contrib/msql/msql.ch @@ -0,0 +1,63 @@ + +/* + * Harbour Project source code: + * mSQL DBMS defines + * These defines are clipper code level equivalent of msql.h + * + * Copyright 2000 Maurilio Longo + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + + +// mSQL fields type +#define MSQL_INT_TYPE 1 +#define MSQL_CHAR_TYPE 2 +#define MSQL_REAL_TYPE 3 +#define MSQL_IDENT_TYPE 4 +#define MSQL_NULL_TYPE 5 +#define MSQL_TEXT_TYPE 6 +#define MSQL_DATE_TYPE 7 + +// NOTE: UINT is used to map clipper logical values to mSQL tables, so 0 == .F., 1 == .T. +#define MSQL_UINT_TYPE 8 +#define MSQL_MONEY_TYPE 9 +#define MSQL_TIME_TYPE 10 +#define MSQL_LAST_REAL_TYPE 10 +#define MSQL_IDX_TYPE 253 +#define MSQL_SYSVAR_TYPE 254 +#define MSQL_ANY_TYPE 255 + + + +// mSQL field structure item number (C level structure is translated +// to a clipper array) + +#define MSQL_FS_NAME 1 +#define MSQL_FS_TABLE 2 +#define MSQL_FS_TYPE 3 +#define MSQL_FS_LENGTH 4 +#define MSQL_FS_FLAGS 5 + diff --git a/harbour/contrib/msql/msql.h b/harbour/contrib/msql/msql.h new file mode 100644 index 0000000000..7734722556 --- /dev/null +++ b/harbour/contrib/msql/msql.h @@ -0,0 +1,195 @@ +/* +** msql.h - +** +** +** Copyright (c) 1993-95 David J. Hughes +** Copyright (c) 1995-99 Hughes Technologies Pty Ltd +** +** Permission to use, copy, and distribute for non-commercial purposes, +** is hereby granted without fee, providing that the above copyright +** notice appear in all copies and that both the copyright notice and this +** permission notice appear in supporting documentation. +** +** This software is provided "as is" without any expressed or implied warranty. +** +*/ + + +#ifndef MSQL_H +#define MSQL_H + +#include +#include /* needed for time_t prototypes */ + + +#ifndef APIENTRY +# if defined(_OS_OS2) +# ifdef BCPP +# define _System _syscall +# define _Optlink +# endif +# ifdef __EMX__ +# define _System +# endif +# define APIENTRY _System +# endif /* _OS_OS2 */ +# if defined(_OS_WIN32) +# define APIENTRY __stdcall +# endif /* _OS_WIN32 */ +# if defined(_OS_UNIX) +# define APIENTRY +# endif +# if !defined(_OS_OS2) && !defined(_OS_UNIX) && !defined(_OS_WIN32) +# define APIENTRY +# endif +#endif + + +#if defined(__STDC__) || defined(__cplusplus) +# define __ANSI_PROTO(x) x +#else +# define __ANSI_PROTO(x) () +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +typedef char ** m_row; + +typedef struct field_s { + char *name, + *table; + int type, + length, + flags; + } m_field; + + +typedef struct m_seq_s { + int step, + value; + } m_seq; + + +typedef struct m_data_s { + int width; + m_row data; + struct m_data_s *next; + } m_data; + +typedef struct m_fdata_s { + m_field field; + struct m_fdata_s *next; + } m_fdata; + + +typedef struct result_s { + m_data *queryData, + *cursor; + m_fdata *fieldData, + *fieldCursor; + int numRows, + numFields; + } m_result; + + +#define msqlNumRows(res) res->numRows +#define msqlNumFields(res) res->numFields + + +#define INT_TYPE 1 +#define CHAR_TYPE 2 +#define REAL_TYPE 3 +#define IDENT_TYPE 4 +#define NULL_TYPE 5 +#define TEXT_TYPE 6 +#define DATE_TYPE 7 +#define UINT_TYPE 8 +#define MONEY_TYPE 9 +#define TIME_TYPE 10 +#define LAST_REAL_TYPE 10 +#define IDX_TYPE 253 +#define SYSVAR_TYPE 254 +#define ANY_TYPE 255 + +#define NOT_NULL_FLAG 1 +#define UNIQUE_FLAG 2 + +#define IS_UNIQUE(n) (n & UNIQUE_FLAG) +#define IS_NOT_NULL(n) (n & NOT_NULL_FLAG) + +static char msqlTypeNames[][12] = + {"???", "int", "char","real","ident","null","text","date","uint", + "money","time","???"}; + + +/* +** Pre-declarations for the API library functions +*/ + int msqlLoadConfigFile __ANSI_PROTO((char *)); + +#ifndef _MSQL_SERVER_SOURCE + +# if defined(_OS_OS2) || defined(_OS_WIN32) || defined(__EMX__) +# define msqlErrMsg msqlGetErrMsg(NULL) +# else + extern char msqlErrMsg[]; +# endif +#endif + +#if defined(_OS_OS2) || defined(_OS_WIN32) || defined(__EMX__) + char * APIENTRY msqlGetErrMsg __ANSI_PROTO((char *)); + int APIENTRY msqlUserConnect __ANSI_PROTO((char *, char *)); +#endif + int APIENTRY msqlConnect __ANSI_PROTO((char *)); + int APIENTRY msqlSelectDB __ANSI_PROTO((int, char*)); + int APIENTRY msqlQuery __ANSI_PROTO((int, char*)); + int APIENTRY msqlCreateDB __ANSI_PROTO((int, char*)); + int APIENTRY msqlDropDB __ANSI_PROTO((int, char*)); + int APIENTRY msqlShutdown __ANSI_PROTO((int)); + int APIENTRY msqlGetProtoInfo __ANSI_PROTO((void)); + int APIENTRY msqlReloadAcls __ANSI_PROTO((int)); + int APIENTRY msqlGetServerStats __ANSI_PROTO((int)); + int APIENTRY msqlCopyDB __ANSI_PROTO((int, char*, char*)); + int APIENTRY msqlMoveDB __ANSI_PROTO((int, char*, char*)); + char * APIENTRY msqlGetServerInfo __ANSI_PROTO((void)); + char * APIENTRY msqlGetHostInfo __ANSI_PROTO((void)); +/* + char * APIENTRY msqlUnixTimeToDate __ANSI_PROTO((time_t)); + char * APIENTRY msqlUnixTimeToTime __ANSI_PROTO((time_t)); +*/ + void APIENTRY msqlClose __ANSI_PROTO((int)); + void APIENTRY msqlDataSeek __ANSI_PROTO((m_result*, int)); + void APIENTRY msqlFieldSeek __ANSI_PROTO((m_result*, int)); + void APIENTRY msqlFreeResult __ANSI_PROTO((m_result*)); + m_row APIENTRY msqlFetchRow __ANSI_PROTO((m_result*)); + m_seq * APIENTRY msqlGetSequenceInfo __ANSI_PROTO((int, char*)); + m_field * APIENTRY msqlFetchField __ANSI_PROTO((m_result *)); + m_result * APIENTRY msqlListDBs __ANSI_PROTO((int)); + m_result * APIENTRY msqlListTables __ANSI_PROTO((int)); + m_result * APIENTRY msqlListFields __ANSI_PROTO((int, char*)); + m_result * APIENTRY msqlListIndex __ANSI_PROTO((int, char*, char*)); + m_result * APIENTRY msqlStoreResult __ANSI_PROTO((void)); + time_t APIENTRY msqlDateToUnixTime __ANSI_PROTO((char *)); + time_t APIENTRY msqlTimeToUnixTime __ANSI_PROTO((char *)); + +#if defined(_OS_WIN32) + char * APIENTRY msqlGetWinRegistryEntry __ANSI_PROTO((char*, char*, int)); +#endif + + +#if defined(_MSQL_SERVER_SOURCE) || defined(_MSQL_SERVER_PROTO) + /* + ** These functions are not part of the mSQL API. Any use + ** of these functions is discouraged as the interface may + ** change in future releases + */ + int APIENTRY msqlGetIntConf __ANSI_PROTO((char *, char *)); + char * APIENTRY msqlGetCharConf __ANSI_PROTO((char *, char*)); +#endif + +#ifdef __cplusplus + } +#endif +#endif /*MSQL_H*/ diff --git a/harbour/contrib/msql/readme.txt b/harbour/contrib/msql/readme.txt new file mode 100644 index 0000000000..61e41d4c9a --- /dev/null +++ b/harbour/contrib/msql/readme.txt @@ -0,0 +1,47 @@ +28/may/2000 Harbour mSQL access classes - readme file + + + +This is work in progress, so it has to be fully tested and needs a few more methods to cover mSQL 2.x possibilities. + + +This set of files gives you a mean to access an mSQL server, I've developed and tested them on a OS/2 platform, so changes to Makefile and import library for different platforms are not present. + +In its present state mSQL classes are made up of these files: + +msql.c: low level wrapper around msql client API. It requires libmsql.a (or libmsql.lib if under + windows) import library (under OS/2 you need, also, msql.dll client api library if it's + not in your LIBPATH). +msql.h: from mSQL 2.x distribution, type and defines of mSQL client api. +msql.ch: clipper level defines of mSQL types +tmsql.prg: mSQL access classes +test.prg: a little test program which wont work for you :-) since it uses a .dbf file not + provided. Use it as a small tutorial of tmsql.prg provided functions. +Makefile my makefile for OS/2 gcc, you'll surely need to change it to adapt to your needs/platform. + + +tmsql.prg defines four classes: + +TmSQLServer: manages access to a mSQL server and returns an oServer object to which you'll send all your + queries; +TmSQLQuery: a standard query to an oServer with joins. Every query has a GetRow() method + which on every call returns a TmSQLRow object which, in turn, contains requested fields. + Query objects convert mSQL answer (which is an array of strings) to clipper level types. + At present time N (with decimals), L, D, and C clipper types are supported. +TmSQLTable: It's a descendant of a TmSQLQuery and you'll receive it when your query has no joins. + It adds Update(), Append() and Delete() methods which receive a TmSQLRow object and + reflect changes to the mSQL table from which they come. + Please note that TmSQLQuery objects don't have these methods, so, if you want to change + a row received from a TmSQLQuery object you need to construct a valid SQL query and submit + it to an oServer object. +TmSQLRow: Every row returned by a SELECT is converted to a TmSQLRow object. This object handles + fields and has methods to access fields given a field name or position. + +I'm aware that this brief document doesn't explain a lot about mSQL access classes and I'm sorry for that. +I'll try to update it as work on these classes goes by and I'll like to receive feedbak and suggestions +from users (if any :-)) + +Excuse my poor english and happy selecting :-) + +Maurilio Longo - maurilio.longo@libero.it + diff --git a/harbour/contrib/msql/test.prg b/harbour/contrib/msql/test.prg new file mode 100644 index 0000000000..7ea9485752 --- /dev/null +++ b/harbour/contrib/msql/test.prg @@ -0,0 +1,110 @@ + +/* + * Harbour Project source code: + * mSQL DBMS test program + * + * Copyright 2000 Maurilio Longo + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "dbstruct.ch" + +procedure main(cArg) + + local oServer, oQuery, oQuery2, oRow, i, aStru + + SET CENTURY ON + SET EPOCH TO 1960 + + oServer := TmSQLServer():New("www.farmaconsult.it") + if oServer:NetErr() + Alert(oServer:Error()) + endif + oServer:SelectDB("mm") + + dbUseArea(.T.,, cArg, "wn", .F.) + + if !oServer:DeleteTable("test") + Alert(oServer:Error()) + endif + + aStru := dbStruct() + if oServer:CreateTable("test", aStru) + Alert("test created successfully") + else + Alert(oServer:Error()) + endif + + + oQuery:=oServer:Query("SELECT * from test where _rowid = 1") + oRow := oQuery:GetBlankRow() + + while !wn->(eof()) + + oQuery2 := oServer:Query("SELECT * from test where CODF='" + wn->CODF + "' and CODP='" + wn->CODP + "'") + + if oQuery2:LastRec() > 0 + + ? "found " + + oRow := oQuery2:GetRow() + + oRow:FieldPut(oRow:FieldPos("GIACENZA"), oRow:FieldGet(oRow:FieldPos("GIACENZA")) + wn->GIACENZA) + oRow:FieldPut(oRow:FieldPos("ACQGR"), oRow:FieldGet(oRow:FieldPos("ACQGR")) + wn->ACQGR) + oRow:FieldPut(oRow:FieldPos("ACQDI"), oRow:FieldGet(oRow:FieldPos("ACQDI")) + wn->ACQDI) + + if !oQuery2:Update(oRow) + Alert(oQuery2:Error()) + endif + + else + + ? wn->CODF + " " + wn->CODP + + oRow := oQuery:GetBlankRow() + + oRow:FieldPut(oRow:FieldPos("CODF"), wn->CODF) + oRow:FieldPut(oRow:FieldPos("CODP"), wn->CODP) + oRow:FieldPut(oRow:FieldPos("GIACENZA"), wn->GIACENZA) + oRow:FieldPut(oRow:FieldPos("DATA"), wn->DATA + 365 * 100) + oRow:FieldPut(oRow:FieldPos("ACQGR"), wn->ACQGR) + oRow:FieldPut(oRow:FieldPos("ACQDI"), wn->ACQDI) + + if !oQuery:Append(oRow) + Alert(oQuery:Error()) + endif + + endif + + wn->(dbSkip()) + + enddo + + + wn->(dbCloseArea()) + +return + diff --git a/harbour/contrib/msql/tmsql.prg b/harbour/contrib/msql/tmsql.prg new file mode 100644 index 0000000000..08287623be --- /dev/null +++ b/harbour/contrib/msql/tmsql.prg @@ -0,0 +1,755 @@ + +/* + * Harbour Project source code: + * mSQL DBMS classes. + * These classes try to emulate clipper dbXXXX functions on a SQL query + * + * Copyright 2000 Maurilio Longo + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program 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 General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbclass.ch" +#include "common.ch" +#include "dbstruct.ch" +#include "msql.ch" + + +// Every single row of an answer +CLASS TmSQLRow + + DATA aRow // a single row of answer + DATA aDirty // array of booleans set to .T. if corresponding field of aRow has been changed + DATA aFieldStruct // type of each field + DATA cTable // Name of table containing this row, empty if TmSQLQuery returned this row + DATA nRowID // Record Number inside mSQL table. Used by Update() method of TmSQLTable + + METHOD New(aRow, aFStruct, cTableName, lRowID) // Create a new Row object and handle hidden _rowid field + + METHOD FieldGet(nNum) // Same as clipper ones + METHOD FieldPut(nNum, Value) + + METHOD FieldName(nPosition) + METHOD FieldPos(cFieldName) + +ENDCLASS + + +METHOD New(aRow, aFStruct, cTableName, lRowID) CLASS TmSQLRow + + default cTableName to "" + default aFStruct to {} + default lRowID to .F. + + ::cTable := cTableName + ::aFieldStruct := aFStruct + + // if first field is _rowid I'm inside a TmSQLTable, so remove this low level + // info from list of fields. + if lRowID + ::nRowID := aRow[1] + + // remove first field (copying from second) + ::aRow := Array(Len(aRow) - 1) + ACopy(aRow, ::aRow, 2) + + else + ::aRow := aRow + ::aFieldStruct := aFStruct + ::nRowID := -1 + endif + + ::aDirty := Array(Len(::aRow)) + AFill(::aDirty, .F.) + +return Self + + +METHOD FieldGet(nNum) CLASS TmSQLRow + + if nNum > 0 .AND. nNum <= Len(::aRow) + return ::aRow[nNum] + else + return nil + endif + +return + + +METHOD FieldPut(nNum, Value) CLASS TmSQLRow + + if nNum > 0 .AND. nNum <= Len(::aRow) + if Valtype(Value) == Valtype(::aRow[nNum]) .OR. Empty(::aRow[nNum]) + ::aRow[nNum] := Value + ::aDirty[nNum] := .T. + return Value + endif + endif + +return nil + + +// Given a field name returns it's position +METHOD FieldPos(cFieldName) CLASS TmSQLRow + + local cUpperName, nPos := 1 + + cUpperName := Upper(cFieldName) + + /* NOTE: this code block kills harbour if called a few thousand times + nPos := AScan(::aFieldStruct, {|aItem| iif(Upper(aItem[MSQL_FS_NAME]) == cUpperName, .T., .F.)}) + */ + + while nPos <= Len(::aFieldStruct) + if Upper(::aFieldStruct[nPos][MSQL_FS_NAME]) == cUpperName + exit + endif + nPos++ + enddo + +return nPos + + +// Returns name of field N +METHOD FieldName(nPosition) CLASS TmSQLRow + + if nPosition >=1 .AND. nPosition <= Len(::aFieldStruct) + return ::aFieldStruct[nPosition][MSQL_FS_NAME] + else + return "" + endif + +return + +/* ----------------------------------------------------------------------------------------*/ + +// Every single query submitted to mSQL server +CLASS TmSQLQuery + + DATA nSocket // connection handle to mSQL server + DATA nResultHandle // result handle received from mSQL + + DATA cQuery // copy of query that generated this object + + DATA nNumRows // number of rows available on answer NOTE msql is 0 based + DATA nCurRow // I'm currently over row number + + DATA nNumFields // how many fields per row (including hidden _rowID) + DATA aFieldStruct // type of each field, a copy is here a copy inside each row + + DATA lRowID // .T. if query has field _rowID + DATA lError // .T. if last operation failed + + METHOD New(nSocket, cQuery) // New query object + METHOD Destroy() + + METHOD GetRow(nRow) // return Row n of answer + + METHOD Skip(nRows) // Same as clipper ones + + METHOD Bof() INLINE ::nCurRow == 1 + METHOD Eof() INLINE ::nCurRow > ::nNumRows + METHOD RecNo() INLINE ::nCurRow + METHOD LastRec() INLINE ::nNumRows + + METHOD FCount() + + METHOD NetErr() INLINE ::lError // Returns .T. if something went wrong + METHOD Error() // Returns textual description of last error and clears ::lError + +ENDCLASS + + +METHOD New(nSocket, cQuery) CLASS TmSQLQuery + + local nI, aField + + ::aFieldStruct := {} + ::nSocket := nSocket + ::cQuery := cQuery + ::nNumRows := msqlQuery(nSocket, cQuery) + ::nCurRow := 1 + ::lRowID := .F. + ::lError := .F. + + if ::nNumRows >= 0 + + ::nResultHandle := msqlStoreR() + ::nNumFields := msqlNumFie(::nResultHandle) + + for nI := 1 to ::nNumFields + + aField := msqlFetchF(::nResultHandle) + + if Upper(aField[MSQL_FS_NAME]) == "_ROWID" + ::lRowID := .T. + else + AAdd(::aFieldStruct, aField) + endif + next + else + + ::nResultHandle := nil + ::nNumFields := 0 + ::lError := .T. + endif + +return Self + + + +METHOD Skip(nRows) CLASS TmSQLQuery + + // NOTE: mSQL row count starts from 0 + default nRows to 1 + + if nRows == 0 + // No move + elseif nRows < 0 + // Negative movement + ::nCurRow := Max(::nCurRow - nRows, 1) + else + // positive movement + ::nCurRow := Min(::nCurRow + nRows, ::nNumRows + 1) + endif + + msqlDataSe(::nResultHandle, ::nCurRow - 1) + +return Self + + +/* Given a three letter month name gives back month number as two char string (ie. Apr -> 04) */ +static function NMonth(cMonthValue) + + static cMonths := {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dec" } + + nMonth := AScan(cMonths, cMonthValue) + +return PadL(nMonth, 2, "0") + + +// Get row n of a query and return it as a TmSQLRow object +METHOD GetRow(nRow) CLASS TmSQLQuery + + local aRow := NIL + local oRow := NIL + local i + + default nRow to 0 + + if ::nResultHandle <> NIL + if nRow >= 1 .AND. nRow <= ::nNumRows + + // NOTE: row count starts from 0 + msqlDataSe(::nResultHandle, nRow - 1) + ::nCurRow := nRow + else + ::nCurRow++ + endif + + aRow := msqlFetchR(::nResultHandle, ::nNumFields) + + if aRow <> NIL + + if ::lRowID + aRow[1] := Val(aRow[1]) + endif + + // Convert answer from text field to correct clipper types + for i := iif(::lRowID, 2, 1) to ::nNumFields + do case + case ::aFieldStruct[iif(::lRowID, i - 1, i)][MSQL_FS_TYPE] == MSQL_UINT_TYPE + aRow[i] := iif(Val(aRow[i]) == 0, .F., .T.) + + case ::aFieldStruct[iif(::lRowID, i - 1, i)][MSQL_FS_TYPE] == MSQL_INT_TYPE + aRow[i] := Val(aRow[i]) + + case ::aFieldStruct[iif(::lRowID, i - 1, i)][MSQL_FS_TYPE] == MSQL_REAL_TYPE + aRow[i] := Val(aRow[i]) + + case ::aFieldStruct[iif(::lRowID, i - 1, i)][MSQL_FS_TYPE] == MSQL_DATE_TYPE + if Empty(aRow[i]) + aRow[i] := CToD("") + else + // Date format MM/DD/YYYY + aRow[i] := CToD(NMonth(__StrToken(aRow[i], 2, "-")) + "/" + __StrToken(aRow[i], 1, "-") + "/" + __StrToken(aRow[i], 3, "-")) + endif + otherwise + endcase + next + + oRow := TmSQLRow():New(aRow, ::aFieldStruct,, ::lRowID) + endif + endif + +return iif(aRow == NIL, NIL, oRow) + + +// Free result handle and associated resources +METHOD Destroy() CLASS TmSQLQuery + + msqlFreeR(::nResultHandle) + +return Self + + +METHOD FCount() CLASS TmSQLQuery + +return ::nNumFields - iif(::lRowID, 1, 0) + + +METHOD Error() CLASS TmSQLQuery + + ::lError := .F. + +return msqlGetErr() + +/* ----------------------------------------------------------------------------------------*/ + +// A Table is a query without joins; this way I can Insert() e Delete() rows. +// NOTE: it's always a SELECT result, so it will contain a full table only if +// SELECT * FROM ... was issued +CLASS TmSQLTable FROM TmSQLQuery + + DATA cTable // name of table + + METHOD New(nSocket, cQuery, cTableName) + METHOD GetRow(nRow) + + METHOD Update(oRow) // Gets an oRow and updates changed fields + METHOD Delete(oRow) // Deletes passed row from table + METHOD Append(oRow) // Inserts passed row into table + METHOD GetBlankRow() // Returns an empty row with all available fields empty + +ENDCLASS + + +METHOD New(nSocket, cQuery, cTableName) CLASS TmSQLTable + + local cTrimmedQuery, nRes, i, cFieldList := "SELECT _rowid, ", aField + + ::cTable := cTableName + + // Add _rowid to query, Update() method needs this field + cTrimmedQuery := AllTrim(cQuery) + + // if it's a SELECT * I cannot add _rowid to query; I need to expand * to the full list of fields + if __StrToken(cTrimmedQuery, 2, " ") == "*" + + nRes := msqlListFi(nSocket, cTableName) + + if nRes > 0 + for i := 1 to msqlNumFie(nRes) + aField := msqlFetchF(nRes) + // don't count indexes as real fields + if aField[MSQL_FS_TYPE] <= MSQL_LAST_REAL_TYPE + cFieldList += aField[MSQL_FS_NAME] + "," + endif + next + // remove last comma + cFieldList := Left(cFieldList, Len(cFieldList) - 1) + + // remove SELECT + cTrimmedQuery := StrTran(cTrimmedQuery, __StrToken(cTrimmedQuery, 1, " "), "") + // remove * + cTrimmedQuery := StrTran(cTrimmedQuery, __StrToken(cTrimmedQuery, 1, " "), "") + cTrimmedQuery := cFieldList + cTrimmedQuery + msqlFreeR(nRes) + endif + else + cTrimmedQuery := StrTran(cTrimmedQuery, __StrToken(cTrimmedQuery, 1, " "), "SELECT _rowid, ") + endif + + super:New(nSocket, cTrimmedQuery) + +return Self + + +METHOD GetRow(nRow) CLASS TmSQLTable + + local oRow := super:GetRow(nRow) + + if oRow <> NIL + oRow:cTable := ::cTable + endif + +return oRow + + +/* Creates an update query for changed fields and submits it to server */ +METHOD Update(oRow) CLASS TmSQLTable + + local cUpdateQuery := "UPDATE " + ::cTable + " SET " + local i, cField + + // is this a row of this table ? + if oRow:cTable == ::cTable + for i := 1 to Len(oRow:aRow) + if oRow:aDirty[i] + do case + case Valtype(oRow:aRow[i]) == "N" + cField := AllTrim(Str(oRow:aRow[i])) + cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + cField + "," + + case Valtype(oRow:aRow[i]) == "D" + if !Empty(oRow:aRow[i]) + // mSQL dates are like this 1-Oct-1900 + cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + "'" + Str(Day(oRow:aRow[i]), 2) + "-" + Left(CMonth(oRow:aRow[i]), 3) + "-" + Str(Year(oRow:aRow[i]), 4) + "'," + else + cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + "''," + endif + + case Valtype(oRow:aRow[i]) == "C" + cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "='" + oRow:aRow[i] + "'," + + case Valtype(oRow:aRow[i]) == "L" + cField := AllTrim(Str(iif(oRow:aRow[i] == .F., 0, 1))) + cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=" + cField + "," + + otherwise + cUpdateQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "=''," + + endcase + endif + next + + // remove last comma + cUpdateQuery := Left(cUpdateQuery, Len(cUpdateQuery) -1) + + cUpdateQuery += " WHERE _rowid=" + AllTrim(Str(oRow:nRowID)) + + if msqlQuery(::nSocket, cUpdateQuery) == 1 + // All values are commited + Afill(oRow:aDirty, .F.) + return .T. + else + ::lError := .T. + endif + endif + +return .F. + + +METHOD Delete(oRow) CLASS TmSQLTable + + local cDeleteQuery := "DELETE FROM " + ::cTable + " WHERE _rowid=" + + // is this a row of this table ? + if oRow:cTable == ::cTable + + cDeleteQuery += AllTrim(Str(oRow:nRowID)) + + if msqlQuery(::nSocket, cDeleteQuery) == 1 + return .T. + else + ::lError := .T. + endif + endif + +return .F. + + +// Adds a row with values passed into oRow +METHOD Append(oRow) CLASS TmSQLTable + + local cInsertQuery := "INSERT INTO " + ::cTable + " (" + local i, cField + + // is this a row of this table ? + if oRow:cTable == ::cTable + + // field names + for i := 1 to Len(oRow:aRow) + cInsertQuery += oRow:aFieldStruct[i][MSQL_FS_NAME] + "," + next + // remove last comma from list + cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ") VALUES (" + + // field values + for i := 1 to Len(oRow:aRow) + + do case + case Valtype(oRow:aRow[i]) == "N" + cField := AllTrim(Str(oRow:aRow[i])) + cInsertQuery += cField + "," + + case Valtype(oRow:aRow[i]) == "C" + cInsertQuery += "'" + oRow:aRow[i] + "'," + + case Valtype(oRow:aRow[i]) == "D" + if !Empty(oRow:aRow[i]) + // mSQL dates have this form " 1-Oct-1990" + /* NOTE: current implementation CANNOT retrieve from mSQL dates BEFORE 1st January 1970 */ + cInsertQuery += "'" + Str(Day(oRow:aRow[i]), 2) + "-" + Left(CMonth(oRow:aRow[i]), 3) + "-" + Str(Year(oRow:aRow[i]), 4) + "'," + else + cInsertQuery += "''," + endif + + case Valtype(oRow:aRow[i]) == "L" + cField := AllTrim(Str(iif(oRow:aRow[i] == .F., 0, 1))) + cInsertQuery += cField + "," + + otherwise + cInsertQuery += "''," + + endcase + next + + // remove last comma from list of values and add closing parenthesis + cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ")" + + if msqlQuery(::nSocket, cInsertQuery) == 1 + return .T. + else + ::lError := .T. + endif + + endif + +return .F. + + +METHOD GetBlankRow() CLASS TmSQLTable + + local i + local aRow := {} + + // crate an array of empty fields + for i := 1 to ::FCount() + do case + case ::aFieldStruct[i][MSQL_FS_TYPE] == MSQL_CHAR_TYPE + AAdd(aRow, "") + + case ::aFieldStruct[i][MSQL_FS_TYPE] == MSQL_INT_TYPE + AAdd(aRow, 0) + + case ::aFieldStruct[i][MSQL_FS_TYPE] == MSQL_UINT_TYPE + AAdd(aRow, .F.) + + case ::aFieldStruct[i][MSQL_FS_TYPE] == MSQL_REAL_TYPE + AAdd(aRow, 0.0) + + case ::aFieldStruct[i][MSQL_FS_TYPE] == MSQL_DATE_TYPE + AAdd(aRow, CToD("")) + + otherwise + AAdd(aRow, nil) + + endcase + next + + return TmSQLRow():New(aRow, ::aFieldStruct, ::cTable, .F.) + +return nil + + +/* ----------------------------------------------------------------------------------------*/ + +// Every available mSQL server +CLASS TmSQLServer + + DATA nSocket // connection handle to server + DATA cServer // server name + DATA cDBName // Selected DB + DATA lError // .T. if occurred an error + + METHOD New(cServer) // Open connection to a server, returns a server object + METHOD Destroy() // Closes connection to server + + METHOD SelectDB(cDBName) // Which data base I will use for subsequent queries + + METHOD CreateTable(cName, aStruct) // Create new table using the same syntax of dbCreate() + METHOD DeleteTable(cName) // delete table + METHOD CreateIndex(cName, cTable, aFNames, lUnique) // Create an index (unique) on field name(s) passed as an array of strings aFNames + METHOD DeleteIndex(cName, cTable) // Delete index cName from cTable + + METHOD Query(cQuery) // Gets a textual query and returns a TmSQLQuery or TmSQLTable object + + METHOD NetErr() INLINE ::lError // Returns .T. if something went wrong + METHOD Error() // Returns textual description of last error + +ENDCLASS + + +METHOD New(cServer) CLASS TmSQLServer + + ::cServer := cServer + ::cDBName := "" + ::nSocket := msqlConnec(cServer) + ::lError := .F. + + if ::nSocket == -1 + ::lError := .T. + endif + +return Self + + +METHOD SelectDB(cDBName) CLASS TmSQLServer + + if msqlSelect(::nSocket, cDBName) >= 0 + ::cDBName := cDBName + return .T. + else + ::cDBName := "" + endif + +return .F. + + +METHOD CreateTable(cName, aStruct) CLASS TmSQLServer + + local cCreateQuery := "CREATE TABLE " + cName + " (" + local i + + for i := 1 to Len(aStruct) + do case + case aStruct[i][DBS_TYPE] == "C" + cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")," + + case aStruct[i][DBS_TYPE] == "N" + if aStruct[i][DBS_DEC] == 0 + cCreateQuery += aStruct[i][DBS_NAME] + " int," + else + cCreateQuery += aStruct[i][DBS_NAME] + " real," + endif + + case aStruct[i][DBS_TYPE] == "D" + cCreateQuery += aStruct[i][DBS_NAME] + " date," + + case aStruct[i][DBS_TYPE] == "L" + cCreateQuery += aStruct[i][DBS_NAME] + " uint," + + otherwise + cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")," + + endcase + + next + + // remove last comma from list + cCreateQuery := Left(cCreateQuery, Len(cCreateQuery) -1) + ")" + + if msqlQuery(::nSocket, cCreateQuery) == 1 + return .T. + else + ::lError := .T. + endif + +return .F. + + +METHOD CreateIndex(cName, cTable, aFNames, lUnique) CLASS TmSQLServer + + local cCreateQuery := "CREATE " + local i + + default lUnique to .F. + + if lUnique + cCreateQuery += "UNIQUE INDEX " + else + cCreateQuery += "INDEX " + endif + + cCreateQuery += cName + " ON " + cTable + " (" + + for i := 1 to Len(aFNames) + cCreateQuery += aFNames[i] + "," + next + + // remove last comma from list + cCreateQuery := Left(cCreateQuery, Len(cCreateQuery) -1) + ")" + + if msqlQuery(::nSocket, cCreateQuery) == 1 + return .T. + endif + +return .F. + + +METHOD DeleteIndex(cName, cTable) CLASS TmSQLServer + + local cDropQuery := "DROP INDEX " + cName + " FROM " + cTable + + if msqlQuery(::nSocket, cDropQuery) == 1 + return .T. + endif + +return .F. + + +METHOD DeleteTable(cName) CLASS TmSQLServer + + local cDropQuery := "DROP TABLE " + cName + + if msqlQuery(::nSocket, cDropQuery) == 1 + return .T. + endif + +return .F. + + +METHOD Query(cQuery) CLASS TmSQLServer + + local oQuery, cTableName, i, cUpperQuery, nNumTables, cToken + + cUpperQuery := Upper(AllTrim(cQuery)) + i := 1 + nNumTables := 0 + + while __StrToken(cUpperQuery, i++, " ") <> "FROM" + enddo + while (cToken := __StrToken(cUpperQuery, i++, " ")) <> "WHERE" .AND. !Empty(cToken) + cTableName := __StrToken(cQuery, i - 1, " ") + nNumTables++ + enddo + + if nNumTables == 1 + oQuery := TmSQLTable():New(::nSocket, cQuery, cTableName) + else + oQuery := TmSQLQuery():New(::nSocket, cQuery) + endif + + if oQuery:nNumRows < 0 + ::lError := .T. + endif + +return oQuery + + +METHOD Destroy() CLASS TmSQLServer + + msqlClose(::nSocket) + +return Self + + +METHOD Error() CLASS TmSQLServer + + ::lError := .F. + +return msqlGetErr() +