form export/import etmek

Local loCursor, lcConStr

Set Multilocks On

oXMLAdapter = Createobject('XMLAdapter')

oXMLAdapter.LoadXML('c:\temp\test\Dataset2.xml',.T.)

 

loCursor1 = Newobject('CaGeneric','cageneric.prg','','XML')

With loCursor1

  .Alias = Strconv(oXMLAdapter.Tables.Item(1).XMLName,10)

  .SelectCmd = "oXMLAdapter.Tables.Item(1)"

  If .QueryFill()

    Select (.Alias)

    Browse Last

  Endif

Endwith

 

loCursor2 = Newobject('CaGeneric','cageneric.prg','','XML')

With loCursor2

  .Alias = Strconv(oXMLAdapter.Tables.Item(2).XMLName,10)

  .SelectCmd = "oXMLAdapter.Tables.Item(2)"

  If .QueryFill()

    Select (.Alias)

    Browse Last

  Endif

Endwith

 

loCursor3 = Newobject('CaGeneric','cageneric.prg','','XML')

With loCursor3

  .Alias = Strconv(oXMLAdapter.Tables.Item(3).XMLName,10)

  .SelectCmd = "oXMLAdapter.Tables.Item(3)"

  If .QueryFill()

    Select (.Alias)

    Browse Last

  Endif

Endwith

 

WITH oXMLAdapter

    *-- Release the XML document but preserve the schema

    .ReleaseXML(.F.)      

    .IsDiffGram = .t.

 

    llIncludeBefore = .T. && Include <diffgram:before> format

    llChangesOnly = .T.   && Generate only changes we made

    llIsFile = .F.          && Our XML is a stream     

    lcSchemaLocation = "" && Our schema is inline

 

    .ToXML("lcXML",lcSchemaLocation,llIsFile,llIncludeBefore,llChangesOnly)

ENDWITH

_Cliptext = m.lcXML

Define Class CaGeneric As CursorAdapter

  CompareMemo = .F.

  FetchAsNeeded = .T.

  FetchSize = 100

  FetchMemo = .T.

  BatchUpdateCount = 100

  WhereType = 1

  AllowSimultaneousFetch = .T.

  MapVarchar = .T.

  MapBinary = .T.

  BufferModeOverride = 5

  *!*      *  Nodata = .T.

  Handle = 0

 

  Procedure AutoOpen

    If Not Pemstatus(This, '__VFPSetup', 5)

      This.AddProperty('__VFPSetup', 1)

      This.Init()

    Endif

  Endproc

 

  Procedure Init(tcType,tcConnectionString)

    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

    Set Multilocks On

    llReturn = DoDefault()

 

    This.DataSourceType = m.tcType

 

    Store This.DataSourceType To ;

      this.InsertCmdDataSourceType, ;

      this.UpdateCmdDataSourceType, ;

      this.DeleteCmdDataSourceType

 

    ***<DataSource>

    Do Case

      Case Upper(This.DataSourceType) == "ODBC"

        This.Handle = Sqlstringconnect(m.tcConnectionString)

 

        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 = m.tcConnectionString

        ***</DataSource>

        loConnDataSource.Open()

        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 This.__VFPSetup = 1

      This.__VFPSetup = 2

    Endif

    Return llReturn

  Endproc

 

  Procedure MakeUpdatable(tcTableName,tckeyField,tlDoNotIncludeKey)

    This.Tables = m.tcTableName

    This.KeyFieldList = m.tckeyField

    Local ix, lnUpdateableFCount

    lnUpdateableFCount = Fcount(This.Alias)-Iif(This.DataSourceType='ADO',1,0) && last one is ADOBOOKMARK

    For ix = 1 To m.lnUpdateableFCount

      If !m.tlDoNotIncludeKey Or !(Upper(Field(m.ix,This.Alias,0)) == Upper(m.tckeyField))

        This.UpdatableFieldList = This.UpdatableFieldList + ;

          IIF(Empty(This.UpdatableFieldList),'',',') + ;

          FIELD(m.ix,This.Alias,0)

      Endif

      This.UpdateNameList = This.UpdateNameList + ;

        IIF(Empty(This.UpdateNameList),'',',') + ;

        TEXTMERGE('<<FIELD(m.ix,this.Alias,0)>> <<m.tcTableName>>.<<FIELD(m.ix,this.Alias,0)>>')

    Endfor

  Endproc

 

  Procedure QueryFill()

    Local llSuccess

    If This.DataSourceType ="ADO"

      llSuccess = This.CursorFill(.F.,.F.,0,This.oCommand)

    Else

      llSuccess = This.CursorFill(.F.)

    Endif

    If !m.llSuccess

        If This.DataSourceType ="ADO"

            lcMessage = This.oCommand.CommandText + CHR(13) + This.GetErrorExplanation()

        ELSE

            lcMessage = This.GetErrorExplanation()

        endif    

      Messagebox(m.lcMessage)

    Endif

    Return m.llSuccess

  Endproc

 

  Procedure GetErrorExplanation

    Local lcError,ix

    Local Array aWhy[1]

    Aerror(aWhy)

    lcError = ""

    For ix = 1 To 7

      lcError = m.lcError + Transform(aWhy[m.ix]) + Chr(13)

    Endfor

    Return m.lcError

  Endproc

Enddefine