Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Cursoradapter problem
Message
From
22/03/2010 13:08:52
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
General information
Forum:
Visual FoxPro
Category:
Classes - VCX
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows XP SP2
Network:
Windows 2003 Server
Database:
Visual FoxPro
Application:
Desktop
Miscellaneous
Thread ID:
01455126
Message ID:
01456197
Views:
65
This is cabase.prg edited for my needs:
Define Class CaBase As CursorAdapter
  DataSourceType = "ODBC"
  Flags = 0
  CompareMemo = .F.
  FetchMemo = .T.
  FetchAsNeeded = .T.
  FetchSize = 10
  BatchUpdateCount = 100
  WhereType = 1
  AllowSimultaneousFetch = .T.
  MapVarchar = .T.
  MapBinary = .T.
  UseCursorSchema = .T.
  BufferModeOverride = 5
  FilterExpr = ''
  FilterExprMerge = ''
  Handle = 0
  lAutoOpen = .T.
  Order = ''

  Procedure AutoOpen
    If This.lAutoOpen
      If Not Pemstatus(This, '__VFPSetup', 5)
        This.AddProperty('__VFPSetup', 1)
        This.Init()
      Endif
    Endif
  Endproc


  Procedure Init(tcAlias,tcParamBlock,tcOrder)
	IF VARTYPE(oApp)!='O' AND VARTYPE(_screen.oApp) = 'O'
		oApp = _screen.oApp
	endif

    Local lnPcount
    lnPcount = Pcount()
    This.Tag = oApp.DataConnectionString
    Local llReturn
    Do Case
      Case Not Pemstatus(This, '__VFPSetup', 5)
        This.AddProperty('__VFPSetup', 0)
      Case This.__VFPSetup = 1
        This.__VFPSetup = 2
      Case This.__VFPSetup = 2
        This.__VFPSetup = 0
        Return
    Endcase

    If !Empty(m.tcAlias)
      This.Alias = m.tcAlias
    Endif
    This.Order = Evl(m.tcOrder,'')

    Set Multilocks On
    llReturn = DoDefault()

    This.DataSourceType = ;
      IIF(Lower(Trim(Getwordnum(oApp.DataConnectionString,1,'= ')))=='driver','ODBC','ADO')

    Store This.DataSourceType To ;
      this.InsertCmdDataSourceType, ;
      this.UpdateCmdDataSourceType, ;
      this.DeleteCmdDataSourceType

    ***<DataSource>
    Do Case
      Case Upper(This.DataSourceType) == "ODBC"
      IF VARTYPE(oApp.SQLHandle) = 'N' AND oApp.SQLHandle > 0
      	this.Handle = oApp.SQLHandle
      else
        This.Handle = Sqlstringconnect(oApp.DataConnectionString)
      endif

        Store This.Handle To ;
          This.Datasource,;
          This.InsertCmdDataSource,;
          This.UpdateCmdDataSource,;
          This.DeleteCmdDataSource

      Case Upper(This.DataSourceType) == "ADO"
        Local loConnDataSource
        loConnDataSource = Createobject('ADODB.Connection')
        ***<DataSource>
        loConnDataSource.ConnectionString = oApp.DataConnectionString
        ***</DataSource>
        loConnDataSource.Open()
        If oApp.DataMode = 'VFP'
        	loConnDataSource.Execute('set null off')
        endif

        This.Datasource = Createobject('ADODB.RecordSet')
        This.Datasource.CursorLocation   = 3  && adUseClient
        This.Datasource.LockType         = 3  && adLockOptimistic
        This.Datasource.ActiveConnection = loConnDataSource
        *** End of Select connection code: DO NOT REMOVE

        loCommand = Createobject('ADODB.Command')
        loCommand.ActiveConnection = loConnDataSource
        This.AddProperty('oCommand',loCommand)
        This.UpdateCmdDataSource=loCommand
        This.InsertCmdDataSource=loCommand
        This.DeleteCmdDataSource=loCommand

      Case Upper(This.DataSourceType)="NATIVE" && Not implemented
      Case Upper(This.DataSourceType)="XML"  && Not implemented
    Endcase
    ***</DataSource>
    If !Empty(m.tcParamBlock)
      If Occurs('<p>', m.tcParamBlock) > 0
        SetCAParameters(This, m.tcParamBlock)
        This.CursorFill(.T., .F., 0, loCommand)
        This.lAutoOpen = .F.
      Else
        This.FilterExpr = m.tcParamBlock
      Endif
    Endif
    If oApp.DataMode = 'VFP'
      This.BatchUpdateCount = 1
    Endif

	If Type('oApp.owner') = 'C' And LOWER(Evl(oApp.Owner,'dbo')) <> 'dbo'
		this.SelectCmd = this.PrefixOwner( this.SelectCmd, 'from', oApp.Owner)
	endif

    If This.__VFPSetup = 1
      This.__VFPSetup = 2
    Endif
    Return llReturn
  Endproc

  Procedure BeforeCursorFill
    Lparameters lUseCursorSchema, lNoDataOnLoad, cSelectCmd
    If !Empty(This.FilterExprMerge)
      cSelectCmd = m.cSelectCmd +" where "+Textmerge(This.FilterExprMerge)
    Else
      If !Empty(This.FilterExpr)
        cSelectCmd = m.cSelectCmd +" where "+This.FilterExpr
      Endif
    Endif
  Endproc

  Procedure AfterCursorFill
    Lparameters lUseCursorSchema, NoDataOnLoad, cSelectCmd, lResult
    CursorSetProp("Buffering",5,This.Alias)
  Endproc

  Procedure BeforeCursorRefresh
    Lparameters cSelectCmd
    Tablerevert(.T., This.Alias)
  Endproc

  Procedure AfterCursorRefresh
    Lparameters cSelectCmd, lResult
  ENDPROC
  
  Procedure PrefixOwner(tcSQL, tcPrefix, tcOwner)
	Local lnOccurance,ix, lcRest
	lnOccurance = Occurs( Upper(m.tcPrefix), Upper(m.tcSQL) )
	For ix = 1 To m.lnOccurance
		lcRest = Substr(m.tcSQL,Atc(m.tcPrefix, m.tcSQL, m.ix)+Len(m.tcPrefix))
		If Left(Ltrim(m.lcRest,1,Chr(32),Chr(13),Chr(10)),1) <> '('
			lcRest = Textmerge('[<<TRIM(m.tcOwner)>>].')+Ltrim(m.lcRest,1,Chr(32),Chr(13),Chr(10))
			tcSQL = Left(m.tcSQL,Atc(m.tcPrefix, m.tcSQL, m.ix)+Len(m.tcPrefix)) + ' ' + m.lcRest
		Endif
	Endfor
	Return m.tcSQL
ENDPROC
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Reply
Map
View

Click here to load this message in the networking platform