#INCLUDE WCONNECT.H

SET PROCEDURE TO wwSql ADDITIVE

*************************************************************
DEFINE CLASS wwSql AS Custom
*************************************************************
*: Author: Rick Strahl
*:         (c) West Wind Technologies, 2018
*:Contact: http://www.west-wind.com
*:Created: 11/04/2018
*************************************************************
#IF .F.
*:Help Documentation
*:Topic:
Class wwSql

*:Description:
A thin wrapper around SQLCONNECT(),SQLEXEC() that handles
Connection management and lets you execute commands more
easily than the raw commands. You can also easily reuse
this functionality with different database providers.

*:Example:

*:Remarks:

*:SeeAlso:


*:ENDHELP
#ENDIF


*** The Connection String to SQL backend
*** can be partial: database=webstore  fills in server, integrated security
cConnectString = ""

*** The Sql Passthrough Handle
nSqlHandle = 0

*** Last sql statement executed
cSql = ""

csqlCursor = "TSQLQuery"

cErrorMsg = ""

nErrorNo = 0

cErrorMsg2 = ""

nSqlResult = -5

*** Timeout in Seconds
nTimeout = 15

*-- Used to exclude fields explicitly from the INSERT and UPDATE statement generation routines in SQLBuildInsert/UpdateStatement methods.
cSkipFieldsForUpdates = ""

PROTECTED lInternalError
lInternalError = .F.

*-- A set of SQL parameters. Also used to retrieve parameter results in stored procedure calls.
oParameters = .NULL.

*-- Internal property used to determine when statement is done and next AddParameter operation causes the parameter collection to be cleared.
PROTECTED lParameterReset
lParameterReset = .F.

*-- Internally set property set when any OUT parameters are set by AddParameter. This flag is used to determine whether parameters need to be parsed back into the parameters collection.
lOutParameters = .F.

*-- Number of records affected by the last NonQuery operation.
nAffectedRecords = 0

*-- Used only with the ADO version. If set adds parameters in AddParameters as Named Parameters which allows stored procedures to call with partial parameter lists if parameters are
lNamedParameters = .F.

lError = .F.
nOdbcErrorNo = .F.

*-- .T. if a connection was used to connect, .f. if a DSN, UID, PWD was used. Used internally in reconnection.
PROTECTED lUseConnection
DIMENSION aErrors[1,1]


************************************************************************
*  Init
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Init(lcConnectString, llAsynch)

#IF SHAREWARE
	WAIT WINDOW NOWAIT ;
	"Welcome to West Wind Client Tools..." + CHR(13) + ;
	"This is a shareware copy of wwSQL." + CHR(13)+ CHR(13) +;
	"Please register your copy."
#ENDIF

IF !EMPTY(lcConnectString)
	THIS.CONNECT(lcConnectString,llAsynch)
ENDIF

ENDFUNC
*   Init




************************************************************************
*  Destroy
****************************************
***  Function: Closes the connection if one is open
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Destroy()
THIS.CLOSE()
ENDFUNC
*   Destroy


************************************************************************
* wwSQL :: Execute
*********************************
***  Function: Executes a SQL Passthrough command on the server.
***            lError, lErrorNo and lErrorMsg get set on error
***      Pass: lcSQL    - (Optional) SQL to execute - (THIS.cSQL)
***    Return: SQL Result Code 
************************************************************************
FUNCTION Execute(lcSQL, lcResultCursor, llStoredProcedure)
LOCAL lcParameterName
LOCAL ARRAY aCountInfo[1]

IF EMPTY(lcSQL)
	lcSQL = THIS.csql
ELSE
	THIS.csql = lcSQL
ENDIF

IF THIS.nsqlresult = 0
	THIS.SQLCANCEL()
ENDIF

IF EMPTY(lcResultCursor)
	lcResultCursor = THIS.csqlcursor
ENDIF

THIS.lerror = .F.
THIS.cerrormsg = ""
THIS.aerrors = .F.  && clear out the errors

*** Try to assign parameters as private vars
*** MUST DO THIS INLINE DUE TO PRIVATE VARS CREATED here
IF !ISNULL(THIS.oparameters)
*** Try to create each parameter
	FOR EACH loParm IN THIS.oparameters
		lcParameterName = loParm.NAME
		IF ATC("?" + lcParameterName,lcSQL) > 0
			LOCAL &lcParameterName
			&lcParameterName = loParm.VALUE
			IF loParm.Direction = "OUT"
				lcSQL = STRTRAN(lcSQL,"?" + lcParameterName,"?@" + lcParameterName,1,1,1)
			ENDIF
		ELSE
			IF ATC("?@" + lcParameterName,THIS.csql) > 0
				LOCAL &lcParameterName
				&lcParameterName = loParm.VALUE
				loParm.Direction = "OUT"
				THIS.loutparameters = .T.
			ENDIF
		ENDIF

	ENDFOR
ENDIF

*** Actual Sql Executed
THIS.csql = lcSQL

#IF wwVFPVERSION > 8
	THIS.nsqlresult = SQLEXEC(THIS.nsqlhandle,lcSQL,lcResultCursor,aCountInfo)
#ELSE
	THIS.nsqlresult = SQLEXEC(THIS.nsqlhandle,lcSQL,lcResultCursor)
#ENDIF

THIS.lparameterreset = .T.

IF THIS.nsqlresult < 0
	THIS.lerror = .T.
	THIS.FillErrors()

*** Try Reconnecting and re-executing request
	IF (ISNULL(THIS.nodbcerrorno) OR (THIS.nodbcerrorno=0) OR ;
		(THIS.nodbcerrorno=14)) AND  THIS.CONNECT(THIS.cconnectstring)
		#IF wwVFPVERSION > 8
			THIS.nsqlresult = SQLEXEC(THIS.nsqlhandle,lcSQL,lcResultCursor,aCountInfo)
		#ELSE
			THIS.nsqlresult = SQLEXEC(THIS.nsqlhandle,lcSQL,lcResultCursor)
		#ENDIF
		IF THIS.nsqlresult < 0
			THIS.lerror = .T.
			THIS.FillErrors()
		ELSE
			THIS.FillErrors("CLEAR")
			#IF wwVFPVERSION > 8
				THIS.naffectedrecords = aCountInfo[1,2]
			#ELSE
				THIS.naffectedrecords = RECCOUNT()
			#ENDIF
		ENDIF
	ENDIF
ELSE
	THIS.lerror = .F.
	IF SQLCOMMIT(THIS.nsqlhandle) < 0
		THIS.lerror = .T.
		THIS.FillErrors()
	ENDIF

	#IF wwVFPVERSION > 8
		THIS.naffectedrecords = aCountInfo[1,2]  &&RECCOUNT()
	#ELSE
		THIS.naffectedrecords = RECCOUNT()
	#ENDIF

*** Try to parse Out parameters back into the
	IF THIS.loutparameters
		FOR EACH loParm IN THIS.oparameters
			IF UPPER(loParm.Direction) = "OUT"
				lcParameterName = loParm.NAME
				IF TYPE(lcParameterName) # "U"
					loParm.VALUE = EVALUATE(lcParameterName )
				ENDIF
			ENDIF
		ENDFOR
	ENDIF

ENDIF

*** Always reset the SQL cursor
THIS.csqlcursor = "TSQLQuery"

RETURN THIS.nsqlresult
ENDPROC


************************************************************************
* wwSQL :: ExecuteNonQuery
*********************************
***  Function: Executes a SQL Passthrough command on the server that
***            doesn't return a cursor.
***            lError, lErrorNo and lErrorMsg get set on error
***      Pass: lcSQL    - (Optional) SQL to execute - (THIS.cSQL)
***    Return: SQL Result Code
************************************************************************
FUNCTION ExecuteNonQuery(lcSQL, llStoredProcedure)

THIS.naffectedrecords = 0

lnResult = THIS.execute(lcSQL,,llStoredProcedure)

IF lnResult < 0
	RETURN .F.
ENDIF

RETURN .T.
ENDPROC




************************************************************************
*  Connect
****************************************
***  Function: Connects to a datasource via connection or connect string
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Connect(lcConnectString, llAsync, llNoAutoTransactions)

THIS.cconnectstring = lcConnectString

*** Show no login
SQLSETPROP(0, 'DispLogin', 3)

*** Show no warnings - fail and report as errors
SQLSETPROP(0, 'DispWarnings', .F.)

*** Connection Timeout in seconds
SQLSETPROP(0, 'ConnectTimeout', this.nTimeout)

IF wwVFPVERSION > 8
	*** Map binary fields to BLOB/VarBinary
	CURSORSETPROP("MapBinary",.T.,0)
ENDIF

IF ATC("=",lcConnectString) < 1
	*** Connection Passed
	THIS.nsqlhandle = SQLCONNECT(lcConnectString)
	llUseConnection=.T.
ELSE
	IF ATC("dsn=",lcConnectString) < 1
	*** Full Connection string ( driver={sql server};database=WebStore;uid=test;pwd=test
		IF ATC("server=",lcConnectString) = 0
			lcConnectString = "server=.;" + lcConnectString
		ENDIF
		IF ATC("driver=",lcConnectString) = 0 AND ATC("provider=",lcConnectString) = 0
			lcConnectString = "driver={Sql Server};" + lcConnectString
		ENDIF
	ENDIF
	THIS.cconnectstring = lcConnectString
	THIS.nsqlhandle = SQLSTRINGCONNECT(  lcConnectString )
	llUseConnection = .F.
ENDIF

IF THIS.nsqlhandle < 1
	THIS.lerror = .T.
	THIS.FillErrors()
	RETURN .F.
ENDIF

THIS.SetAsyncMode(llAsync)

IF llNoAutoTransactions
	SQLSETPROP(THIS.nsqlhandle,"Transactions" ,2 )
ENDIF

RETURN .T.
ENDFUNC
*   Connect


************************************************************************
*  Close
****************************************
***  Function: Closes a SQL connection if one is kept open
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Close()


IF THIS.nsqlresult = 0
*** Still running a request
	=SQLCANCEL(THIS.nsqlhandle)
ENDIF

IF THIS.nsqlhandle > 0
	=SQLDISCONNECT(THIS.nsqlhandle)
ENDIF

THIS.nsqlhandle = 0

ENDFUNC
*   Close

************************************************************************
*  BeginTransaction
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION BeginTransaction(lcTransactionName)

RETURN THIS.execute("BEGIN TRANSACTION " + EVL(lcTransactionName,"") )
ENDFUNC
*   BeginTransaction


************************************************************************
*  Rollback
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Rollback(lcTransactionName)
RETURN THIS.execute("ROLLBACK TRANSACTION " + EVL(lcTransactionName,"") )
ENDFUNC
*   Rollback

************************************************************************
*  Commit
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Commit(lcTransactionName)
RETURN THIS.execute("COMMIT TRANSACTION " + EVL(lcTransactionName,"") )
ENDFUNC
*   Commit

************************************************************************
*  AddSql
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION AddSql(lcCode)


IF UPPER(lcCode)="CLEAR"
	THIS.csql=""
	RETURN
ENDIF

THIS.csql = THIS.csql + " " +lcCode

ENDFUNC
*   AddSql

************************************************************************
*  ConnectByDsn
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION ConnectByDsn(lcDSN,lcUID,lcPassword, llAsynch)

THIS.lerror = .F.
THIS.cconnectstring = lcDSN
THIS.nsqlhandle = SQLCONNECT(lcDSN,lcUID,lcPassword)
IF THIS.nsqlhandle < 1
	THIS.lerror = .T.
	THIS.FillErrors()
	RETURN .F.
ELSE
	THIS.setasynchmode(llAsynch)
ENDIF

RETURN .T.

ENDFUNC
*   ConnectByDsn



************************************************************************
*  CreateOdbcDataSource
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION CreateOdbcDataSource(lcDSNName, lcConnectString)

WAIT WINDOW "This  method is not implemented yet" NOWAIT
RETURN
#IF .F.
	DECLARE INTEGER SQLConfigDataSource ;
	IN odbccp32.DLL ;
	INTEGER, INTEGER,;
	STRING, STRING
	settings="DSN=TestVFP"+CHR(0)+;
	"Description=NEW_DSN_SQL7"+CHR(0)+;
	"Server=Pro200"+CHR(0)+;
	"Database=policia"+CHR(0)+;
	"UID=Peter"+CHR(0)


	settings="DSN=TestVFP"+CHR(0)+;
	"Description=NEW_DSN_SQL7"+CHR(0)+;
	"Server=Pro200"+CHR(0)+;
	"SourceDB=C:\mssql7\data\policia.MDF"+CHR(0)+;
	"SourceType=MDF"+CHR(0)+;
	"UID=Peter"

	Y = SQLConfigDataSource(0,1,"TestVFP",settings)
#ENDIF

ENDFUNC
*   CreateOdbcDataSource

************************************************************************
*  SqlBuildInsertStatementFromObject
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION SqlBuildInsertStatementFromObject(loData, lcFilename, ;
                                           loSQLRecord, llUseNamedParameters)
LOCAL lcFieldList, lcValueList, loData, lnFields, lnX, lcField, lcType, lcValue,lcSQL

lcSQL = "INSERT " + lcFilename

lcFieldList = ""
lcValueList = ""

IF PCOUNT() < 4 OR VARTYPE(llUseNamedParameters) # "L"
   llUseNamedParameters = .T.  && default to .T. if not passed
ENDIF

IF EMPTY(THIS.cskipfieldsforupdates)
	lcSkipFields = ",TIMESTAMP_COLUMN,"
ELSE
	lcSkipFields = ",TIMESTAMP_COLUMN," + UPPER(THIS.cskipfieldsforupdates) + ","
ENDIF

*** If a SQL Record was passed used its structure to look for fields
*** otherwise use the data record
lnFields = AMEMBERS(laFields,IIF(VARTYPE(loSQLRecord)="O",loSQLRecord,loData) )

THIS.linternalerror = .F.

FOR lnX=1 TO lnFields
	lcField = laFields[lnX]

*** We can't deal with Timestamp columns and any other fields to be skipped
*** so just loop out of this field
	IF "," + UPPER(lcField) + ","  $ lcSkipFields
		LOOP
	ENDIF

	lcRawValue = EVALUATE("loData." + lcField)

*** Handle case where an error occurred
	IF (THIS.linternalerror)
		THIS.linternalerror = .F.  && Field that doesn't exist in SQL but exists in local cursor
		THIS.lerror = .F.
		LOOP  && Skip this field
	ENDIF

	lcType = VARTYPE(lcRawValue)

	IF !llUseNamedParameters
		DO CASE
		CASE lcType = "C"
			lcValue = ['] + TRIM(STRTRAN(lcRawValue,"'","''"))+ [']
		CASE lcType = "N"
			lcValue = STRTRAN( TRANSFORM(lcRawValue),",",".")
		CASE lcType = "L"
			lcValue = IIF(lcRawValue,'1','0')
		CASE lcType = "D" OR lcType = "T"
			lcValue = this.TimeToCStrict(lcRawValue,.T.)
		CASE lcType = "Y"
			lcValue = TRANSFORM( lcRawValue,"" )
		CASE lcType = "X"  && NULL
			lcValue = "null"
		OTHERWISE
			LOOP   && Invalid Type - skip
		ENDCASE
		lcValueList = lcValueList + lcValue + ","
	ELSE
		LOCAL lcParmName
		lcParmName = "__" + lcField
		THIS.AddParameter(lcRawValue,lcParmName)
		lcValueList = lcValueList + "?" + lcParmName + ","
	ENDIF

	lcFieldList = lcFieldList + '[' +  lcField + '],'
ENDFOR

IF EMPTY(lcFieldList) OR EMPTY(lcValueList)
	RETURN ""
ELSE
	lcFieldList = SUBSTR(lcFieldList,1,LEN(lcFieldList) - 1)
	lcValueList = SUBSTR(lcValueList,1,LEN(lcValueList) - 1)
ENDIF

lcSQL = lcSQL + " (" + lcFieldList + ") VALUES (" +  lcValueList + ")"

RETURN lcSQL
ENDFUNC
* SqlBuildInsertStatementFromObject


************************************************************************
*  SqlBuildUpdateStatementFromObject
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION SqlBuildUpdateStatementFromObject(loData, lcFilename, lcPkField, ;
                                           loOrigData, loSQLRecord, llUseNamedParameters)
LOCAL loData, lnFields, lnX, lcField, lcType, lvValue, lcValue, ;
lvPkValue, lvRawValue, lvOrigValue


IF EMPTY(lcPkField)
	lcPkField = "PK"
ENDIF

IF VARTYPE(loOrigData) = "O"
	llOrigData = .T.
	IF COMPOBJ(loData,loOrigData)
		RETURN ""
	ENDIF
ELSE
	llOrigData = .F.
ENDIF

IF PCOUNT() < 6 OR VARTYPE(llUseNamedParameters) # "L"
   llUseNamedParameters = .T.  && default to .T. if not passed!
ENDIF



IF EMPTY(THIS.cskipfieldsforupdates)
	lcSkipFields = ",TIMESTAMP_COLUMN,"
ELSE
	lcSkipFields = ",TIMESTAMP_COLUMN," + UPPER(THIS.cskipfieldsforupdates) + ","
ENDIF

*** If a SQL Record was passed used its structure to look for fields
*** otherwise use the data record
lnFields = AMEMBERS(laFields,IIF(VARTYPE(loSQLRecord)="O",loSQLRecord,loData) )

THIS.linternalerror = .F.

lcSQL = ""
FOR lnX=1 TO lnFields
	lcField = laFields[lnX]

*** We can't deal with Timestamp columns and any other fields to be skipped
*** so just loop out of this field
	IF "," + UPPER(lcField) + ","  $ lcSkipFields
		LOOP
	ENDIF

	lvRawValue = EVALUATE("loData." + lcField)

*** Handle case where an error occurred
	IF (THIS.linternalerror)
		THIS.linternalerror = .F.  && Field that doesn't exist in SQL but exists in local cursor
		THIS.lerror = .F.
		LOOP  && Skip this field
	ENDIF

	lcType = VARTYPE(lvRawValue)

*** Skip the fields that haven't changed if loOrigData was passed
	IF llOrigData
		lvOrigValue = EVALUATE("loOrigData." + lcField)
		IF lvRawValue == lvOrigValue OR (ISNULL(lvRawValue) AND ISNULL(lvOrigValue))
			LOOP
		ENDIF
	ENDIF

	IF !llUseNamedParameters
		DO CASE
		CASE lcType = "C"
			lcValue = [']+ TRIM(STRTRAN(lvRawValue,['],[''])) + [']
		CASE lcType = "N"
			lcValue = STRTRAN( TRANSFORM(lvRawValue),[,],[.])
		CASE lcType = "L"
			lcValue = IIF(lvRawValue,'1','0')
		CASE lcType = "D" OR lcType = "T"
			lcValue = this.TimeToCStrict(lvRawValue,.T.)
		CASE lcType = "Y"
			lcValue = TRANSFORM( lvRawValue,"" )
		CASE lcType = "X"
			lcValue = "null"
		OTHERWISE
			LOOP   && Invalid Type - skip
		ENDCASE

		lcSQL = lcSQL +  " ["+lcField + "]=" + lcValue + ","
	ELSE
		THIS.AddParameter(lvRawValue,"__" + lcField)
		lcSQL =  lcSQL +  " [" + lcField + "]=?__" + lcField + ","
	ENDIF

ENDFOR

*** If no fields need updating return a blank string
IF EMPTY(lcSQL)
	RETURN ""
ENDIF

*** Strip comma at end
lcSQL = SUBSTR(lcSQL,1,LEN(lcSQL)-1)

*** Create full SQL statement
lcSQL = "UPDATE " + lcFilename + " SET " + lcSQL

*** Don't create Where clause if no pk value is set
*** Allows overriding the WHERE clause
IF lcPkField != "NONE"
	lvPkValue = EVALUATE("loData." + lcPkField)

	IF VARTYPE(lvPkValue) = "C"
		lcSQL = lcSQL + " WHERE " + lcPkField +  "='" + lvPkValue + "'"
	ELSE
		lcSQL = lcSQL + " WHERE " + lcPkField +  "=" + TRANSFORM( lvPkValue )
	ENDIF
ENDIF

RETURN lcSQL
ENDFUNC
* SqlBuildUpdateStatementFromObject


************************************************************************
*  CallStoredProcedure
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION CallStoredProcedure
PARAMETERS lcProcedure, pvResult, lvParm1, lvParm2, lvParm3, lvParm4, lvParm5, lvParm6, lvParm7, lvParm8

LOCAL lnX, lcParmString
PRIVATE pnResult

lnParms = PCOUNT() - 2
lcParmString = ""


*** Only SP name passed - use parameters if any
IF lnParms = -1
	FOR EACH loParm IN THIS.oparameters
		IF !EMPTY(lcParmString)
			lcParmString = lcParmString + ","
		ENDIF
		IF loParm.Direction = "OUT"
			lcParmString = lcParmString + "?@" + loParm.NAME
		ELSE
			lcParmString = lcParmString + "?" + loParm.NAME
		ENDIF
	ENDFOR
ELSE
	FOR lnX = 1 TO lnParms
		lcParmString = lcParmString + "?lvParm" + TRANSFORM(lnX) + ","
	ENDFOR

	IF !ISNULL(pvResult)
		lcParmString = lcParmString + "?@pvResult"
	ELSE
*** Strip off trailing
		IF !EMPTY(lcParmString)
			lcParmString = SUBSTR(lcParmString,1,LEN(lcParmString)-1)
		ENDIF
	ENDIF
ENDIF

lnResult = THIS.execute("Exec " + lcProcedure + " " + lcParmString)
IF lnResult # 1
	RETURN .F.
ENDIF

IF !ISNULL(pvResult)
	RETURN pvResult
ENDIF

RETURN .T.
ENDFUNC
*   CallStoredProcedure


************************************************************************
*  ExecuteStoredProcedure
****************************************
***  Function: Executes a stored procedure that returns a Cursor
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION ExecuteStoredProcedure(lcProcedure, lcCursor)
LOCAL lnCount, lnX, lcParms

*** Build up parameter string
lcParms = ""
FOR EACH loParm IN THIS.oparameters
	IF loParm.Direction = "OUT"
		lcParms = lcParms + " ?@" + loParm.NAME + ","
	ELSE
		lcParms = lcParms + " ?" + loParm.NAME + ","
	ENDIF
ENDFOR
IF !EMPTY(lcParms)
	lcParms = LEFT(lcParms,LEN(lcParms)-1)
ENDIF

lnResult = THIS.execute("Execute " + lcProcedure + lcParms, lcCursor, .T.)
IF lnResult < 1
	RETURN .F.
ENDIF

RETURN .T.
ENDFUNC

************************************************************************
*  InsertDataFromCursor
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION InsertDataFromCursor
LPARAMETERS lcTable, llExitOnFirstError
LOCAL loData, lcSQL, lcErrors, lcOldAlias, loSQLRecord

lcErrors = ""

IF EMPTY(lcTable)
	lcTable = ALIAS()
ENDIF

lcOldAlias=ALIAS()

THIS.execute("select * from " + lcTable + " where 0=1","__TCursor")
IF THIS.lerror
	RETURN .F.
ENDIF

*** Get the structure for the SQL table
SCATTER NAME loSQLRecord MEMO BLANK

SELECT (lcOldAlias)
SCAN
	SCATTER NAME loData MEMO

	THIS.lerror = .F.
	lcSQL = THIS.sqlbuildinsertstatementfromobject(loData,lcTable,loSQLRecord,.T.)  && Named Parameters
	THIS.execute( lcSQL )

	IF THIS.lerror
		lcErrors = lcErrors + THIS.cerrormsg + CHR(13)  + lcSQL + CHR(13) + CHR(13)
		IF llExitOnFirstError
			THIS.cerrormsg = lcErrors
			RETURN .F.
		ENDIF
	ENDIF
ENDSCAN

IF !EMPTY(lcErrors)
	THIS.cerrormsg = lcErrors
	THIS.lerror = .T.
	RETURN .F.
ENDIF

THIS.cerrormsg = ""

RETURN .T.
ENDFUNC
*   InsertDataFromCursor


************************************************************************
*  InsertBinaryField
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION InsertBinaryField(lcImageData, lcField, lcTable, lcWhereClause, llIsFile)
LOCAL lcContent, lnResult

IF llIsFile
	lcContent = FILETOSTR(lcImageData)
ELSE
	lcContent = lcImageData
ENDIF


lcOldAlias = ALIAS()
lcTFile = SYS(2023) + "\" + SYS(2015) + ".dbf"

SELECT 0

CREATE TABLE (lcTFile) (IMAGE M)
APPEND BLANK
REPLACE IMAGE WITH lcContent
USE

ll = FOPEN(lcTFile,12)
FSEEK(ll,43)
FWRITE(ll,'G')
FCLOSE(ll)

USE (lcTFile)

IF EMPTY(lcWhereClause)
	lnResult = THIS.execute("INSERT INTO " +lcTable +;
	"(" + lcField +") values (?Image)")
ELSE
	lnResult = THIS.execute("UPDATE " +lcTable +;
	" set " + lcField +"=?Image WHERE " + lcWhereClause)
ENDIF

USE
ERASE (lcTFile)

IF lnResult < 0
	RETURN .F.
ENDIF

RETURN .T.
ENDFUNC
*   InsertBinaryField


************************************************************************
*  ReadBinaryField
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION ReadBinaryField
LPARAMETERS lcField,lcTable,lcWhereClause
LOCAL lcTFileName, lcFilename, lcAlias, lcResult,llField, lnResult

IF EMPTY(lcWhereClause)
	lnResult = THIS.execute("select " + lcField + " from " + lcTable)
ELSE
	lnResult = THIS.execute("select " + lcField + " from " + lcTable + " where " + lcWhereClause)
ENDIF

IF lnResult < 1
	RETURN ""
ENDIF

lcTFileName =  SYS(2023) + "\"  + SYS(2015) + ".dbf"
lcFilename = DBF()
lcAlias = ALIAS()

*** Copy out the data - cursor deletes automatically
COPY TO (lcTFileName)

*** Close the cursor
SELECT (lcAlias)
USE

* Change the flag in the general field
llFile = FOPEN(lcTFileName,12)
FSEEK(llFile,43)
FWRITE(llFile,'M')
FCLOSE(llFile)

*** Reopen the copied file
USE (lcTFileName) ALIAS __TImage EXCL

*** Retrieve the binary field value
lcResult = EVAL("__Timage."  + lcField)

*** Close and Erase the temp file
USE
ERASE (FORCEEXT(lcTFileName,"*")

IF !EMPTY(lcAlias)
	SELECT (lcAlias)
ENDIF

RETURN lcResult
ENDFUNC
*   ReadBinaryField



************************************************************************
*  ClearParameters
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION ClearParameters()
THIS.AddParameter("CLEAR")
ENDFUNC
*   ClearParameters


************************************************************************
*  AddParameter
****************************************
***  Function: Adds a SQL Parameter to the current Sql command. Parameters are added as named parameters.
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION AddParameter
LPARAMETERS lvValue, lcName, lcDirection, lcType, lnSize, lnPrecision

*** Reset parameters for  new commands - set before execute and executenonquery
*** so when next parameter is added the commands clear. I you want to keep
*** explicitly set lParameterReset to .F.
IF THIS.lparameterreset OR ;
	TYPE("THIS.oParameters") # "O"
	THIS.oparameters = CREATEOBJECT("Collection")
	THIS.lparameterreset = .F.
ENDIF


IF VARTYPE(lvValue) = "C"
	lvValue = TRIM(lvValue)
	IF (lvValue == "RESET" OR lvValue == "CLEAR") AND EMPTY(lcName)
		THIS.oparameters = CREATEOBJECT("Collection")
		THIS.lparameterreset = .F.
		RETURN
	ENDIF
ENDIF

loParameter = CREATEOBJECT("EMPTY")
ADDPROPERTY(loParameter,"Value",lvValue)
ADDPROPERTY(loParameter,"Name",.NULL.)
ADDPROPERTY(loParameter,"Type",.NULL.)
ADDPROPERTY(loParameter,"Size",.NULL.)
ADDPROPERTY(loParameter,"Precision",.NULL.)
ADDPROPERTY(loParameter,"Direction","IN")

IF !EMPTY(lcName)
	loParameter.NAME = lcName
ENDIF
IF !EMPTY(lcType)
	loParameter.TYPE = lcType
ENDIF
IF VARTYPE(lnSize) =  "N"
	loParameter.SIZE = lnSize
ENDIF
IF VARTYPE(lnPrecision) = "N"
	loParameter.PRECISION = lnPrecision
ENDIF
IF VARTYPE(lcDirection) = "C"
	loParameter.Direction = UPPER(lcDirection)
	IF UPPER(lcDirection) = "OUT"
		THIS.loutparameters = .T.
	ENDIF
ENDIF

IF !EMPTY(lcName)
	THIS.oparameters.ADD(loParameter,lcName)
ELSE
	THIS.oparameters.ADD(loParameter,SYS(2015))
ENDIF
ENDFUNC
*   AddParameter


************************************************************************
*  AssignCommandParameters
****************************************
***  Function: Not used for plain SQL Passthrough - used in ADO
***    Assume:
***      Pass:
***    Return:
************************************************************************
PROTECTED FUNCTION AssignCommandParameters()


ENDFUNC


************************************************************************
*  GetAffectedRecords
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION GetAffectedRecords()
LOCAL lnResult

lcOldAlias=ALIAS()

THIS.csqlcursor = "__Count"
IF THIS.execute("SELECT @@ROWCOUNT") > -1
	lnResult = 	__Count.EXP
	USE IN __Count
ELSE
	lnResult = -1
ENDIF

IF !EMPTY(lcOldAlias)
	SELECT (lcOldAlias)
ENDIF

RETURN lnResult
ENDFUNC
*   GetAffectedRecords


************************************************************************
*  EnableUnicodeToAnsiMapping
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION EnableUnicodeToAnsiMapping(llSet)

IF wwVFPVERSION > 8
	IF PCOUNT()=0
		llSet = .T.
	ENDIF

	SYS(987,llSet)
ELSE
	ERROR "Unicode mapping is supported only in VFP 9.0"
ENDIF

ENDFUNC
*   EnableUnicodeToAnsiMapping



************************************************************************
*  EnableConnectionPooling
****************************************
***  Function: Enables connection pooling - should be called before
***            using wwSql instance
************************************************************************
FUNCTION EnableConnectionPooling()

DECLARE INTEGER SQLSetEnvAttr IN odbc32.DLL ;
LONG henv,;
LONG ATTRIBUTE, ;
LONG VALUE , ;
LONG StringLength

#DEFINE  SQL_ATTR_CONNECTION_POOLING  201
#DEFINE SQL_ATTR_CP_MATCH  202
#DEFINE SQL_CP_ONE_PER_DRIVER  1
#DEFINE SQL_IS_UINTEGER -5

SQLSetEnvAttr(0,SQL_ATTR_CONNECTION_POOLING,SQL_CP_ONE_PER_DRIVER, SQL_IS_UINTEGER)

ENDFUNC
*   EnableConnectionPooling


************************************************************************
*  SetAsyncMode
****************************************
***  Function: Makes subsequent queries async if .T. or not if .F.
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION SetAsyncMode(llAsynch)


IF SQLSETPROP(THIS.nsqlhandle, "Asynchronous", llAsynch) = 1
	RETURN .T.
ELSE
	RETURN .F.
ENDIF

ENDFUNC
*   SetAsyncMode

************************************************************************
*  SqlCancel
****************************************
***  Function: Cancels an async SQL Operation
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION SqlCancel()
RETURN SQLCANCEL(THIS.nsqlhandle)
ENDFUNC
*   SqlCancel


************************************************************************
*  Error
****************************************
***  Function: Intercepts errors, tries to reconnect on connection
***            errors
************************************************************************
FUNCTION Error(nError, cMethod, nLine)

DO CASE
*** Invalid Connection Handle
CASE nError = 1466 AND THIS.nerrorno <> 1466
	THIS.nerrorno = 1466
	THIS.cerrormsg = MESSAGE()
	IF THIS.CONNECT(THIS.cconnectstring)
		THIS.lerror = .F.
		THIS.nerrorno = 1466     && So we can trap 'recursive' errors above
		THIS.cerrormsg = ""
		RETRY
	ENDIF
ENDCASE

THIS.linternalerror = .T.

THIS.FillErrors()

ENDFUNC
*   Error

************************************************************************
*  FillErrors
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
PROTECTED FUNCTION FillErrors(lcClear)
LOCAL lnLoc, lcErrorMsg

lcClear=IIF(TYPE("lcClear")="C",UPPER(lcClear),"")

IF lcClear = "CLEAR"
	THIS.lerror=.F.
	THIS.nerrorno = 0
	THIS.nodbcerrorno = 0
	THIS.cerrormsg = ""
	RETURN
ENDIF

#DEFINE PARSESTRING "Server]"

lnCount = AERROR(laError)
IF lnCount > 0
	DIMENSION THIS.aerrors[1]
	ACOPY(laError,THIS.aerrors)

	lcErrorMsg = laError[2]
	lnLoc = ATC(PARSESTRING,lcErrorMsg)
	IF lnLoc > 0
		lcErrorMsg = SUBSTR(lcErrorMsg,lnLoc + LEN(PARSESTRING))
	ENDIF
	IF TYPE("THIS.nCodePage") = "N"
		IF TYPE("laError[3]") = "C"
			lcErrorMsg = laError[3]
		ENDIF
		IF TYPE("laError[7]")="N"
			THIS.nodbcerrorno = laError[7]
		ENDIF
	ELSE
		THIS.nodbcerrorno = laError[5]
	ENDIF

	THIS.nerrorno = laError[1]
	IF ISNULL(THIS.nodbcerrorno) OR EMPTY(THIS.nodbcerrorno)
		THIS.nodbcerrorno = 0
	ENDIF
	THIS.cerrormsg = lcErrorMsg + " ["+TRANS(THIS.nerrorno)+":"+TRANSFORM(THIS.nodbcerrorno)+"]"
ENDIF
#UNDEF PARSESTRING
ENDFUNC
* FillErrors





ENDDEFINE
*
*-- EndDefine: wwsql
**************************************************



**************************************************
*-- Class:        wwadosql (c:\webconnection\fox\classes\wwsql.vcx)
*-- ParentClass:  wwsql (c:\webconnection\fox\classes\wwsql.vcx)
*-- BaseClass:    custom
*
*
DEFINE CLASS wwAdoSql AS wwSql


HEIGHT = 17
WIDTH = 98
*-- The codepage used to convert data coming in from the server. Use 65001 for UTF-8 Unicode encoding which works for all languages.
ncodepage = 0
*-- ADO Connection object that is cached.
oadoconn = .NULL.
lkeepconnection = .F.
*-- Internal Error object used.
PROTECTED oexception
oexception = .NULL.
*-- The command mode that we're currently in. Usually 1 for text commands, or 4 for Stored Procs.
PROTECTED ncommandmode
ncommandmode = 1
NAME = "wwadosql"


PROCEDURE assigncommandparameters
*** Private method used to write out parameters to the
*** ADO COmmand object. Once done it clears the list of parameters
LPARAMETERS oCommand

#IF VERSION(5) > 700

	LOCAL lcSQL, lcOrigSql, llParseString, lcParm
*** Extract out ?  style parameters and add them to the parm collection

	lcSQL = THIS.csql &&oCommand.CommandText
	lcOrigSql = lcSQL

*** If no parameter collection is passed try to parse parms
*** THIS DOESN"T WORK BECAUSE OF THE TYPE ISSUES!
	LOCAL llParseString
	llParseString = .F.
	IF ISNULL(THIS.oparameters)
		llParseString = .T.
	ENDIF

	LOCAL llParms
	llParms =  !ISNULL(THIS.oparameters) AND THIS.oparameters.COUNT > 0

*** Parse out the VFP style parameters and add to parameters collection
	lnAt = AT("?",lcSQL)
	DO WHILE lnAt > 0
		lcSQL = SUBSTR(lcSQL,lnAt+1)

		IF lcSQL = " "
			lnAt = AT("?",lcSQL)
			LOOP
		ENDIF

		lcParm = GETWORDNUM(lcSQL,1," ,")

		IF RIGHT(lcParm,1) # "'"
			lcParm = CHRTRAN(lcParm,")","")

*** Check for invalid chars
			IF LEN(lcParm) > 50 OR CHRTRAN(lcParm,"?=&,%*$!","") # lcParm
				lnAt = AT("?",lcSQL)
				LOOP
			ENDIF

			IF lcParm = "@"  && Out Parm
				lcParm = SUBSTR(lcParm,2)
				THIS.AddParameter( EVALUATE(lcParm),lcParm,"OUT" )

*** Strip out the parm name and just leave ?
				lcOrigSql = STRTRAN(lcOrigSql,"?@" + lcParm,"?")
			ELSE
*** Add only named parameters if we have no collection to start with
				IF !EMPTY(lcParm) AND !llParms
					THIS.AddParameter( EVALUATE(lcParm),lcParm )
				ENDIF
*** Strip out the parm name and just leave ?
				lcOrigSql = STRTRAN(lcOrigSql,"?" + lcParm,"?",1,1)
			ENDIF

		ENDIF
		lcSQL = SUBSTR(lcSQL,2)
		lnAt = AT("?",lcSQL)
	ENDDO

	IF ISNULL(THIS.oparameters)
		RETURN .T.
	ENDIF

*!*   ACTIVATE SCREEN
*!*   ? lcOrigSql

	IF THIS.ncommandmode = 1
		oCommand.CommandText = lcOrigSql
	ENDIF


*** Take the internal parameter collection and parse into ADO parameters
	FOR EACH loParm IN THIS.oparameters
		LOCAL oParameter AS ADODB.PARAMETER
		oParameter = CREATEOBJECTEX("ADODB.Parameter","","")  && Early Binding
		oParameter.Direction = 1

		oParameter.VALUE = loParm.VALUE

		IF !ISNULL(loParm.NAME )
			oParameter.NAME = loParm.NAME
		ENDIF

		IF !ISNULL(loParm.TYPE)
			oParameter.TYPE  = loParm.TYPE
			IF !ISNULL(loParm.SIZE)
				oParameter.SIZE = loParm.SIZE
			ENDIF
			IF !ISNULL(loParm.PRECISION)
				oParameter.PRECISION = loParm.PRECISION
			ENDIF
		ELSE
			lcType = TYPE("loParm.Value")
			DO CASE
			CASE lcType = "C"
				LOCAL lnAdoStringType, lnAdoStringSize
				IF THIS.ncodepage = 65001  && UTF-8 Encoding (Unicode enabled)
					lnAdoStringType = 202
					lnAdoStringSize = 4000
				ELSE
					lnAdoStringType = 200
					lnAdoStringSize = 8000
				ENDIF

				oParameter.TYPE = lnAdoStringType
				IF !ISNULL(loParm.Direction) AND ;
					UPPER(loParm.Direction) = "OUT"
					oParameter.SIZE = lnAdoStringSize
				ELSE
					oParameter.SIZE = LEN(loParm.VALUE)
				ENDIF

				IF oParameter.SIZE < 1
					oParameter.SIZE = 1
				ENDIF

*** Switch to Text/nTEXT over 8000/4000
				IF oParameter.SIZE > lnAdoStringSize
					oParameter.TYPE= lnAdoStringType + 1  && adLongVarWChar
					oParameter.SIZE = LEN(loParm.VALUE)
				ENDIF


			CASE lcType = "N"
				oParameter.TYPE= 5  && adDouble
				oParameter.SIZE = 16
			CASE lcType = "L"
				oParameter.TYPE= 11  && adBoolean
			CASE lcType = "T" OR lcType = "D"
				oParameter.TYPE = 7 &&adDate
			CASE lcType = "W" OR lcType = "Q"
				oParameter.TYPE= 204  && adVarBinary
				oParameter.SIZE = LEN(loParm.VALUE)
				IF (oParameter.SIZE) > 8000
					oParameter.TYPE= 205  && adLongVarBinary
					oParameter.SIZE= .NULL.
				ENDIF
				IF oParameter.SIZE = 0
					oParameter.SIZE=1
				ENDIF
			OTHERWISE
				oParameter.TYPE = 12 && adVariant
			ENDCASE
		ENDIF

		IF !ISNULL(loParm.Direction) AND ;
			UPPER(loParm.Direction) = "OUT"
			oParameter.Direction=3  &&adOutput
		ENDIF

		oCommand.PARAMETERS.APPEND( oParameter )

	ENDFOR

*** Reset parameters on next ADD operation
	THIS.lparameterreset = .T.

	RETURN THIS.lerror
#ENDIF
ENDPROC


PROCEDURE callstoredprocedure
PARAMETERS lcProcedure, pvResult, lvParm1, lvParm2, lvParm3, lvParm4, lvParm5, lvParm6, lvParm7, lvParm8
LOCAL lnCount, lnX, lcParm

#IF VERSION(5) > 700

	lnCount = PCOUNT()
	IF lnCount > 2
		FOR lnX = 3 TO lnCount
			lcParm = "lvParm" + TRANSFORM(lnX-2)
			THIS.AddParameter( EVALUATE(lcParm),lcParm)
		ENDFOR
	ENDIF
	IF lnCount = 1
		pvResult = .NULL.
	ENDIF

	lnResult = THIS.execute(lcProcedure,,.T.)

	IF lnResult < 1
		RETURN .F.
	ENDIF

	IF !ISNULL(pvResult) AND !ISNULL(THIS.oparameters )
		FOR EACH loParm IN THIS.oparameters
			IF !ISNULL(loParm.Direction) AND loParm.Direction = "OUT"
				pvResult = loParm.VALUE
				RETURN
			ENDIF
		ENDFOR
	ENDIF

	RETURN .T.

#ENDIF
ENDPROC


************************************************************************
*  Connect
****************************************
***  Function:
***    Assume:
***      Pass:
***    Return:
************************************************************************
FUNCTION Connect()
LPARAMETER lcConnectString, llAsynch, llNoAutoTransactions
LOCAL llResult, loException

#IF VERSION(5) <  800
	THIS.cerrormsg = "The wwADOSql class requires VFP 8 or later"
	THIS.lerror = .T.
	RETURN .F.
#ELSE
*** AYSNC OPERATION NOT SUPPORTED AT THE MOMENT
*** AUTOTRANSACTIONS NOT SUPPORTED AT THE MOMENT
	IF ISNULL(THIS.oadoconn)
		THIS.oadoconn = CREATEOBJECT("ADODB.Connection")
	ENDIF

	IF EMPTY(lcConnectString)
		lcConnectString = THIS.cconnectstring
	ELSE
		THIS.cconnectstring = lcConnectString
	ENDIF

*this.oADOConn.ConnectionString = lcConnectString
	LOCAL oConn AS ADODB.CONNECTION
	oConn = CREATEOBJECT("ADODB.Connection")

	llResult = .T.
	TRY
		IF THIS.oadoconn.State = 0  && adStateClosed
			THIS.oadoconn.OPEN(lcConnectString)
		ENDIF
	CATCH TO loException
*this.FillErrors()
		THIS.cerrormsg = THIS.oadoconn.Errors.ITEM(1)
		THIS.lerror =.T.
		llResult = .F.
	ENDTRY

	RETURN llResult
#ENDIF
ENDPROC


PROCEDURE DESTROY
*!*   IF THIS.nSQLResult = 0
*!*      =SQLCancel(THIS.nSQLHandle)
*!*   ENDIF

IF !ISNULL(THIS.oadoconn)
	IF THIS.oadoconn.State = 1
		THIS.oadoconn.CLOSE()
	ENDIF
	THIS.oadoconn = .NULL.
ENDIF
ENDPROC


PROCEDURE execute
LPARAMETER lcSQL, lcResultCursor, llStoredProc
#IF VERSION(5) > 700
	THIS.linternalerror = .F.

	IF EMPTY(lcSQL)
		lcSQL = THIS.csql
	ELSE
		THIS.csql = lcSQL
	ENDIF

*** Delegate to ExecuteNonQuery for Insert and Updates
	IF LOWER(lcSQL) = "insert"  OR LOWER(lcSQL) = "update" OR LOWER(lcSQL) = "set "
		IF THIS.executenonquery(lcSQL)
			RETURN 1
		ENDIF

		RETURN -1
	ENDIF

	IF THIS.nsqlresult = 0
		THIS.SQLCANCEL()
	ENDIF

	IF EMPTY(lcResultCursor)
		lcResultCursor = THIS.csqlcursor
	ENDIF

*** Always reset the SQL cursor
	THIS.csqlcursor = "TSQLQuery"

	THIS.lerror = .F.
	THIS.cerrormsg = ""
	THIS.aerrors = .F.  && clear out the errors

	LOCAL lnOldCP
	lnOldCP = SYS(3101)
	IF THIS.ncodepage # 0
		SYS(3001,THIS.ncodepage)
	ENDIF

*** Hook up and optionally open the connection
	IF !THIS.CONNECT()
		THIS.nsqlresult = -1
		THIS.lparameterreset = .T.
		IF THIS.ncodepage # 0
			SYS(3001,lnOldCP)
		ENDIF
		RETURN -1
	ENDIF

	THIS.csql = lcSQL

	LOCAL oCommand AS ADODB.COMMAND
*oCommand = CREATEOBJECTEX("AdoDB.Command","","")  && Early binding causes problems
	oCommand = CREATEOBJECT("AdoDb.Command")
	oCommand.ActiveConnection=THIS.oadoconn
	IF THIS.lnamedparameters
		oCommand.NamedParameters = .T.
	ENDIF

	IF llStoredProc
		THIS.ncommandmode = 4  && AdcmdStoredProc
		oCommand.CommandType = 4
	ELSE
		THIS.ncommandmode = 1  && adCmdText
	ENDIF

*** Assign the SQL command Text so parms ALWAYS get parsed
	oCommand.CommandText = lcSQL

*** Parse parameters from oParameters collection
*** OR using VFP syntax
	THIS.assigncommandparameters(oCommand)

*? oCommand.CommandText


*** Open Forward Only Cursor for reading
	LOCAL oRS AS ADODB.Recordset
	oRS = oCommand.execute()

	THIS.lerror = THIS.linternalerror

*** If we have an open object - we can work with it
	IF VARTYPE(oRS) = "O"
		IF oRS.State = 1  && Make sure we have a recordset
			LOCAL llError, llResult

			LOCAL ca AS CURSORADAPTER
			ca = CREATEOBJECT("CursorAdapter")
			ca.ALIAS = lcResultCursor
			ca.DATASOURCETYPE = "ADO"
*ca.SelectCmd = lcSQL
			IF THIS.ncodepage # 0
				ca.ADOCODEPAGE = THIS.ncodepage
			ENDIF
			ca.FETCHSIZE = 99999999
			ca.ALLOWINSERT = .F.
			ca.ALLOWDELETE = .F.
			ca.ALLOWUPDATE = .F.


			IF USED(lcResultCursor)
				USE IN (lcResultCursor)
			ENDIF

*** Do a cursor fill from the RECORDSET
			llResult = ca.CURSORFILL( .F., .F., 0, oRS)

*!*      *** Let CA handle the parameters
*!*      llResult = ca.CursorFill(.F., .F., 0, oCommand)

*** If closing close immediately
			IF !THIS.lkeepconnection
				THIS.oadoconn.CLOSE()
			ENDIF

			IF !llResult
				THIS.FillErrors()
			ELSE
				ca.CURSORDETACH()
				oRS = .NULL.
				SELECT (lcResultCursor)
			ENDIF
		ENDIF
	ELSE
		THIS.FillErrors()

*** If closing close immediately
		IF !THIS.lkeepconnection
			THIS.oadoconn.CLOSE()
		ENDIF
	ENDIF

*** Loop through and update parameters
	IF llStoredProc
		FOR EACH Parm IN oCommand.PARAMETERS
			IF Parm.Direction = 2 OR Parm.Direction = 3
				THIS.oparameters[Parm.Name].VALUE = Parm.VALUE
				IF TYPE( Parm.NAME ) # "U"
					lcName = Parm.NAME
					&lcName = Parm.VALUE
				ENDIF
			ENDIF
		ENDFOR
	ENDIF

*** Reset to default
	IF THIS.ncodepage # 0
		SYS(3001,lnOldCP)
	ENDIF


	IF THIS.lerror
		THIS.nsqlresult=-1
		RETURN -1
	ENDIF

	THIS.nsqlresult = 1

	RETURN 1
#ENDIF
ENDPROC


PROCEDURE executenonquery
LPARAMETER lcSQL,  llStoredProc
#IF VERSION(5) > 700
	LOCAL lnOldCP

	THIS.linternalerror = .F.
	THIS.naffectedrecords = 0

*** Set up or open connection
	IF !THIS.CONNECT()
		RETURN .F.
	ENDIF

	lnOldCP = SYS(3101)
	IF THIS.ncodepage # 0
		SYS(3101,THIS.ncodepage)
	ENDIF

	THIS.csql = lcSQL

	LOCAL oCommand AS ADODB.COMMAND
	oCommand=CREATEOBJECT("ADODB.Command")
	oCommand.ActiveConnection=THIS.oadoconn
	IF THIS.lnamedparameters
		oCommand.NamedParameters = .T.
	ENDIF

	IF llStoredProc
		THIS.ncommandmode = 4  && AdcmdStoredProc
		oCommand.CommandType = 4
	ELSE
		THIS.ncommandmode = 1  && adCmdText
	ENDIF

*** Assign the SQL command Text so parms ALWAYS get parsed
	oCommand.CommandText = lcSQL

*** Parse parameters from oParameters collection
*** OR using VFP syntax
	THIS.assigncommandparameters(oCommand)

*!*   ACTIVATE SCREEN
*!*   ? oCommand.CommandText

	lnRecords = 0
	oCommand.execute(@lnRecords,,128)

	THIS.lerror = THIS.linternalerror

*** Updated affected records
	THIS.naffectedrecords = lnRecords

*** Loop through and update parameters
	IF llStoredProc OR LOWER(lcSQL) = "exec"
		FOR EACH Parm IN oCommand.PARAMETERS
			IF Parm.Direction = 2 OR Parm.Direction = 3
				THIS.oparameters[Parm.Name].VALUE = Parm.VALUE
				IF TYPE( Parm.NAME ) # "U"
					lcName = Parm.NAME
					&lcName = Parm.VALUE
				ENDIF
			ENDIF
		ENDFOR
	ENDIF

	IF THIS.ncodepage # 0
		SYS(3101,lnOldCP)
	ENDIF

	RETURN !THIS.lerror
#ENDIF
ENDPROC


PROCEDURE executestoredprocedure
#IF VERSION(5) > 700
	PARAMETERS lcProcedure, llNoCursorReturned

	IF llNoCursorReturned
		RETURN THIS.executenonquery(lcProcedure,.T.)
	ELSE
		lnResult = THIS.execute(lcProcedure,,.T.)
		IF lnResult < 1
			RETURN .F.
		ENDIF
	ENDIF

	RETURN .T.
#ENDIF
ENDPROC



************************************************************************
FUNCTION TimeToCStrict
****************************************
***  Function: Returns time in strict time format or in SQL Server
***            compliant format (llSql flag set).
***      Pass: Datetime value
***    Return: strict DateTime string, or SQL Server time string
************************************************************************
LPARAMETER ltTime, llSQL

IF ISNULL(ltTime)
  RETURN "NULL"
ENDIF  

IF llSQL
  IF EMPTY(ltTime)
     RETURN "''"
  ENDIF
  
  RETURN "'" + TRANSFORM(TTOC(ltTime,1),"@R 9999-99-99 99:99:99") + "'"
ENDIF

IF EMPTY(ltTime)
   RETURN "{^}"
ENDIF

RETURN "{^" + TRANSFORM(TTOC(ltTime,1),"@R 9999-99-99 99:99:99") + "}"


ENDDEFINE
*
*-- EndDefine: wwadosql
**************************************************

