Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
CursorAdapter Class
Message
General information
Forum:
Visual FoxPro
Category:
Other
Miscellaneous
Thread ID:
00726719
Message ID:
00727577
Views:
16
Here is some code that works. Note that I did not complete the ASSIGN method code, but it will give you an idea how it works using ADO on native VFP tables.
*!* ADO CursorAdapter Example for Oracle table of the following structure:
*!*

LOCAL oXC
oXC = CREATEOBJECT('xcADO')
oXC.lAutoGenerateSQL = .T.
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
oXC.RELEASE()

DEFINE CLASS xcADO AS CURSORADAPTER

   *!* 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.

   SELECTCMD = [select * from Customers where CompanyName like ?cCompany order by CompanyName]
   WHERETYPE = 1

   lFilled = .F.
   DIMENSION aErrorInfo(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
         .ConnectionString = [Provider=VFPOLEDB.1;Data Source=] + ADDBS(_SAMPLES) ;
            + [Northwind\;Mode=ReadWrite|Share Deny None;]
         .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 = TABLEUPDATE(1, .F., 'crsCustomers')
      IF NOT THIS.lSaved
         THIS.nError = AERROR(THIS.aErrorInfo)
      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 = []
         ENDWITH
      ELSE
         WITH THIS
            .KEYFIELDLIST = []
            .TABLES = []
            .UPDATABLEFIELDLIST = []
            .UPDATENAMELIST = []
            .CONVERSIONFUNC = []
            .UPDATECMD = [update Customers set ] ;
               + [where CustomerID = ?crsCustomers.CustomerID]
            .INSERTCMD = [insert into Customers (CompanyName)] ;
               + [values ] ;
               + [(?crsCustomers.CompanyName)]
            .DELETECMD = [delete from Customers where CustomerID = ?crsCustomers.CustomerID]
         ENDWITH
      ENDIF
   ENDPROC
ENDDEFINE
Mark McCasland
Midlothian, TX USA
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform