fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

20000528-13:08 GMT+2 Maurilio Longo <maurilio.longo@libero.it>

Browse Source
This commit is contained in:
Maurilio Longo
2000-05-28 11:11:17 +00:00
parent cb454fc1f1
commit 9b5cef673f
8 changed files with 1378 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -1,3 +1,17 @@
20000528-13:08 GMT+2 Maurilio Longo <maurilio.longo@libero.it>
+ 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 <ptucker@sympatico.ca>
* makefile.bc
* move eval from rtl.lib to vm.lib

17
harbour/contrib/msql/Makefile Normal file
View File

@@ -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)

177
harbour/contrib/msql/msql.c Normal file
View File

@@ -0,0 +1,177 @@
/*
* Harbour Project source code:
* mSQL DBMS low level (client api) interface code.
*
* Copyright 2000 Maurilio Longo <maurilio.longo@libero.it>
* 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));
}

63
harbour/contrib/msql/msql.ch Normal file
View File

@@ -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 <maurilio.longo@libero.it>
* 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

195
harbour/contrib/msql/msql.h Normal file
View File

@@ -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 <sys/types.h>
#include <sys/time.h> /* 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*/

47
harbour/contrib/msql/readme.txt Normal file
View File

@@ -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

110
harbour/contrib/msql/test.prg Normal file
View File

@@ -0,0 +1,110 @@
/*
* Harbour Project source code:
* mSQL DBMS test program
*
* Copyright 2000 Maurilio Longo <maurilio.longo@libero.it>
* 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

755
harbour/contrib/msql/tmsql.prg Normal file
View File

@@ -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 <maurilio.longo@libero.it>
* 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()