*!* ADO CursorAdapter Example for the SQL Server Northwind sample database
*!*

LOCAL oXC
oXC = CREATEOBJECT('xcADO')
oXC.lAutoGenerateSQL = .F.
oXC.lUseCursorSchema = .F.
oXC.GetSQLData()
CLEAR
IF oXC.lFilled
   LIST STRUCTURE
   BROWSE
   oXC.SaveData()
   IF oXC.lSaved
      MESSAGEBOX('Save worked.')
   ELSE
      MESSAGEBOX('Save failed.')
      ?
      ? 'Save Failed'
      ? oXC.aErrorInfo(1)
      ? oXC.aErrorInfo(2)
      _CLIPTEXT = oXC.aErrorInfo(2)
   ENDIF
ELSE
   MESSAGEBOX('CursorFill Failed')
   ?
   ? 'CursorFill Failed'
   ? oXC.aErrorInfo(1)
   ? oXC.aErrorInfo(2)
   _CLIPTEXT = oXC.aErrorInfo(2)
ENDIF
oXC.cCompanyName = 'T%'
oXC.NewData()
IF oXC.lFilled
   CLEAR
   LIST STRUCTURE
   BROWSE
   oXC.SaveData()
   IF oXC.lSaved
      MESSAGEBOX('Save worked.')
   ELSE
      MESSAGEBOX('Save failed.')
      ?
      ? 'Second save failed'
      ? oXC.aErrorInfo(1)
      ? oXC.aErrorInfo(2)
   ENDIF
ELSE
   MESSAGEBOX('CursorRefresh Failed')
   ?
   ? 'CursorRefresh failed'
   ? oXC.aErrorInfo(1)
   ? oXC.aErrorInfo(2)
ENDIF
*!* SUSPEND
oXC.RELEASE()
RETURN


DEFINE CLASS xcADO AS CURSORADAPTER

   lUseMSDE = .F.
   nTableUpdateType = 0   && First parameter value for TABLEUPDATE()

   *!* Change lUseCursorSchema to .T. to create a cursor according to the CursorSchema property
   lUseCursorSchema = .F.
   cCompanyName = 'M%'

   *!* Set the following property to .F. if you want the adapter to use your own SQL found
   *!*   in the InsertCmd, UpdateCmd and DeleteCmd properties. See Assign method below.
   *!*   Set it to .T. if you want VFP to auto-generate the SQL commands.
   lAutoGenerateSQL = .F.

   ALIAS = [crsCustomers]
   CURSORSCHEMA = [CustomerID C(5),CompanyName C(40),ContactName C(30),ContactTitle C(30),] ;
      + [Address C(60),City C(15),Region C(15),PostalCode C(10),Country C(15),Phone C(24),] ;
      + [Fax C(24)]
   BUFFERMODEOVERRIDE = 5
   DATASOURCETYPE = [ADO]
   ALLOWUPDATE = .T.
   ALLOWDELETE = .T.
   ALLOWINSERT = .T.

   *!* RTRIM() is needed for an earlier provider that had a bug where
   *!* the parameter was right padded with spaces to the width of the field
   *!* This has since been fixed, so if you have a more current provider
   *!* you can try removing the RTRIM(). If you do and get no results,
   *!* RTRIM the parameter and try again.
   SELECTCMD = [SELECT * FROM Customers WHERE CompanyName LIKE RTRIM(?cCompany) ORDER BY CompanyName]
   WHERETYPE = 3

   lFilled = .F.
   DIMENSION aErrorInfo(1)
   DIMENSION aUpdateInfo(1)
   nError = 0
   lSaved = .F.

   PROTECTED PROCEDURE INIT
      CLEAR
      THIS.ADDPROPERTY('oConn', NEWOBJECT('ADODB.Connection'))
      THIS.ADDPROPERTY('oRS', NEWOBJECT('ADODB.Recordset'))
      THIS.ADDPROPERTY('oCommand', NEWOBJECT('ADODB.Command'))

      WITH THIS.oConn
         .CursorLocation = 3
         IF THIS.lUseMSDE
            .ConnectionString = ;
                 [Provider=SQLOLEDB.1;Integrated Security=SSPI;] ;
               + [Persist Security Info=False;] ;
               + [Initial Catalog=Northwind;Data Source=localhost]
         ELSE
            .ConnectionString = [Provider=VFPOLEDB.1;Data Source=] + ADDBS(_SAMPLES) ;
               + [Northwind\;Mode=ReadWrite|Share Deny None;]
         ENDIF
         .OPEN()
      ENDWITH
      THIS.oCommand.ActiveConnection = THIS.oConn
      WITH THIS.oRS
         .ActiveConnection = THIS.oConn
         .CursorType       = 1  && adOpenKeyset
         .CursorLocation   = 3  && adUseClient
         .LockType         = 3  && adLockOptimistic
      ENDWITH
      THIS.DATASOURCE = THIS.oRS
      THIS.UPDATECMDDATASOURCETYPE = [ADO]
      THIS.UPDATECMDDATASOURCE     = THIS.oCommand
      THIS.DELETECMDDATASOURCETYPE = [ADO]
      THIS.DELETECMDDATASOURCE     = THIS.oCommand
      THIS.INSERTCMDDATASOURCETYPE = [ADO]
      THIS.INSERTCMDDATASOURCE     = THIS.oCommand
      THIS.lAutoGenerateSQL = .F.  && needed to initially fire the Assign method for this property
   ENDPROC
   PROCEDURE GetSQLData
      THIS.ResetError()
      PRIVATE cCompany
      cCompany = THIS.cCompanyName
      THIS.lFilled = THIS.CURSORFILL(THIS.lUseCursorSchema, .F., -1, THIS.oCommand)
      IF NOT THIS.lFilled
         THIS.nError = AERROR(THIS.aErrorInfo)
      ENDIF
   ENDPROC
   PROCEDURE SaveData
      THIS.ResetError()
      THIS.lSaved = .T.
      IF THIS.nTableUpdateType = 0
         LOCAL nRecord
         nRecord = GETNEXTMODIFIED(0)
         DO WHILE nRecord > 0
            GOTO nRecord IN crsCustomers
            THIS.lSaved = TABLEUPDATE(0, .F., 'crsCustomers')
            IF NOT THIS.lSaved
               THIS.nError = AERROR(THIS.aErrorInfo)
               EXIT
            ENDIF
            nRecord = GETNEXTMODIFIED(nRecord)
         ENDDO
      ELSE
         THIS.lSaved = TABLEUPDATE(THIS.nTableUpdateType, .F., 'crsCustomers')
         IF NOT THIS.lSaved
            THIS.nError = AERROR(THIS.aErrorInfo)
            EXIT
         ENDIF
      ENDIF
   ENDPROC
   PROCEDURE NewData
      PRIVATE cCompany
      cCompany = THIS.cCompanyName
      THIS.lFilled = THIS.CURSORREFRESH()
      IF NOT THIS.lFilled
         THIS.nError = AERROR(THIS.aErrorInfo)
      ENDIF
   ENDPROC
   PROTECTED PROCEDURE ResetError
      THIS.nError = 0
      THIS.aErrorInfo = []
   ENDPROC
   PROTECTED PROCEDURE DESTROY
      THIS.oRS = .NULL.
      THIS.oConn = .NULL.
      THIS.oCommand = .NULL.
   ENDPROC
   PROCEDURE RELEASE
      RELEASE THIS
   ENDPROC

   PROTECTED PROCEDURE lAutoGenerateSQL_Assign
      LPARAMETERS tlAuto
      IF VARTYPE(tlAuto) <> "L"
         RETURN .F.
      ENDIF
      THIS.lAutoGenerateSQL = tlAuto
      IF tlAuto
         WITH THIS
            .KEYFIELDLIST = [CustomerID]
            .TABLES = [Customers]
            .UPDATECMD = []
            .INSERTCMD = []
            .DELETECMD = []
            .UPDATABLEFIELDLIST = [CompanyName,] ;
               + [ContactName,] ;
               + [ContactTitle,] ;
               + [Address,] ;
               + [City,] ;
               + [Region,] ;
               + [PostalCode,] ;
               + [Country,] ;
               + [Phone,] ;
               + [Fax]
            .UPDATENAMELIST = [CustomerID Customers.CustomerID,] ;
               + [CompanyName Customers.CompanyName,] ;
               + [ContactName Customers.ContactName,] ;
               + [Contacttitle Customers.ContactTitle,] ;
               + [Address Customers.Address,] ;
               + [City Customers.City,] ;
               + [Region Customers.Region,] ;
               + [Postalcode Customers.PostalCode,] ;
               + [Country Customers.Country,] ;
               + [Phone Customers.Phone,] ;
               + [Fax Customers.Fax]
            .CONVERSIONFUNC = [CompanyName RTRIM,] ;
               + [ContactName RTRIM,] ;
               + [ContactTitle RTRIM,] ;
               + [Address RTRIM,] ;
               + [City RTRIM,] ;
               + [Region RTRIM,] ;
               + [PostalCode RTRIM,] ;
               + [Country RTRIM,] ;
               + [Phone RTRIM,] ;
               + [Fax RTRIM]
         ENDWITH
      ELSE
         WITH THIS
            .KEYFIELDLIST = []
            .TABLES = []
            .UPDATABLEFIELDLIST = []
            .UPDATENAMELIST = []
            .CONVERSIONFUNC = []
            .UPDATECMD = [UPDATE Customers SET ] ;
               + [CompanyName = ?RTRIM(crsCustomers.CompanyName), ] ;
               + [ContactName = ?RTRIM(crsCustomers.ContactName), ] ;
               + [ContactTitle = ?RTRIM(crsCustomers.ContactTitle), ] ;
               + [Address = ?RTRIM(crsCustomers.Address), ] ;
               + [City = ?RTRIM(crsCustomers.City), ] ;
               + [Region = ?RTRIM(crsCustomers.Region),] ;
               + [PostalCode = ?crsCustomers.PostalCode, ] ;
               + [Country = ?RTRIM(crsCustomers.Country), ] ;
               + [Phone = ?RTRIM(crsCustomers.Phone), ] ;
               + [Fax = ?RTRIM(crsCustomers.Fax) ] ;
               + [WHERE CustomerID = ?crsCustomers.CustomerID]
            .INSERTCMD = [INSERT INTO Customers ( ] ;
               + [CustomerID, ] ;
               + [CompanyName, ] ;
               + [ContactName, ] ;
               + [ContactTitle, ] ;
               + [Address, ] ;
               + [City, ] ;
               + [Region, ] ;
               + [PostalCode, ] ;
               + [Country, ] ;
               + [Phone, ] ;
               + [Fax ] ;
               + [) ] ;
               + [values ( ] ;
               + [?RTRIM(crsCustomers.CustomerID), ] ;
               + [?RTRIM(crsCustomers.CompanyName), ] ;
               + [?RTRIM(crsCustomers.ContactName), ] ;
               + [?RTRIM(crsCustomers.ContactTitle), ] ;
               + [?RTRIM(crsCustomers.Address), ] ;
               + [?RTRIM(crsCustomers.City), ] ;
               + [?RTRIM(crsCustomers.Region), ] ;
               + [?RTRIM(crsCustomers.PostalCode), ] ;
               + [?RTRIM(crsCustomers.Country), ] ;
               + [?RTRIM(crsCustomers.Phone), ] ;
               + [?RTRIM(crsCustomers.Fax) ] ;
               + [)]
            .DELETECMD = [DELETE FROM Customers WHERE CustomerID = ?crsCustomers.CustomerID]
         ENDWITH
      ENDIF
   ENDPROC
ENDDEFINE