fpastetable.class

Gambas is a graphical development environment based on a Basic interpreter, like Visual Basic. It us

' Gambas class file

STATIC PUBLIC SrcKey AS String
STATIC PUBLIC SrcName AS String
STATIC PUBLIC SrcDatabase AS String
STATIC PUBLIC SrcTable AS String

STATIC PUBLIC DestKey AS String
STATIC PUBLIC DestName AS String
STATIC PUBLIC DestDatabase AS String
STATIC PUBLIC DestTable AS String

STATIC PRIVATE $bData AS Boolean
STATIC PRIVATE $iCpt AS Integer
STATIC PRIVATE $iTotal AS Integer
STATIC PRIVATE $eTimer AS Float

PUBLIC SUB Form_Open()

  DIM sText AS String
  DIM iInd AS Integer
  DIM hServer AS CServer
  DIM hConn AS CConnection

  lblSrcServer.Text = SrcName
  lblSrcDatabase.Text = SrcDatabase
  lblSrcTable.Text = SrcTable

  lblDstServer.Text = DestName
  lblDstDatabase.Text = DestDatabase

  hServer = CServer.All[DestKey]

  hConn = CConnection.Get(hServer, DestDatabase)
  FOR iInd = 0 TO 99
    sText = SrcTable
    IF iInd THEN sText = sText & CStr(iInd + 1)
    IF NOT hConn.Handle.Tables.Exist(sText) THEN BREAK
  NEXT

  txtName.Text = sText
  txtName.SetFocus
  txtName.Select

END

PUBLIC SUB btnCancel_Click()

  ME.Close

END

PUBLIC SUB btnOK_Click()

  DestTable = Trim(txtName.Text)

  IF NOT DestTable THEN
    Message.Warning(("Please enter a table name."))
    txtName.SetFocus
    RETURN
  ENDIF

  $bData = optCopyData.Value

  CopyTable
  ME.Close(TRUE)

END

PRIVATE SUB CopyTable()

  DIM hSrc AS CConnection
  DIM hDst AS CConnection
  DIM rSrc AS Result
  DIM sMsg AS String

  INC Application.Busy

  pgbPaste.Value = 0

  hSrc = NEW CConnection(CServer.All[SrcKey], SrcDatabase, TRUE)
  hDst = NEW CConnection(CServer.All[DestKey], DestDatabase, TRUE)

  hSrc.Open
  hDst.Open

  $iTotal = 0

  IF $bData THEN

    rSrc = hSrc.Handle.Exec("SELECT COUNT(*) FROM " & hSrc.Handle.Quote(SrcTable))
    $iTotal = $iTotal + rSrc[0]

  ENDIF

  $iCpt = 0
  $eTimer = Timer

  DoCopyTable(hSrc.Handle, hDst.Handle, SrcTable, DestTable)
  UpdateProgress(TRUE)

FINALLY

  sMsg = Error.Text
  DEC Application.Busy
  TRY hSrc.Close
  TRY hDst.Close

CATCH

  Message.Error(sMsg)

END


PRIVATE SUB DoCopyTable(hSrc AS Connection, hDst AS Connection, sSrc AS String, sDst AS String)

  DIM hTableSrc AS Table
  DIM hTableDst AS Table
  DIM hField AS Field
  DIM hIndex AS Index
  DIM rSrc AS Result
  DIM rDst AS Result
  DIM iInd AS Integer
  DIM sMsg AS String
  DIM sSrcCharset AS String
  DIM sDstCharset AS String

  sSrcCharset = hSrc.Charset
  sDstCharset = hDst.Charset

  hTableSrc = hSrc.Tables[sSrc]
  hTableDst = hDst.Tables.Add(sDst, hTableSrc.Type)

  FOR EACH hField IN hTableSrc.Fields
    WITH hField
      hTableDst.Fields.Add(.Name, .Type, .Length, .Default)
    END WITH
  NEXT

  hTableDst.PrimaryKey = hTableSrc.PrimaryKey
  hTableDst.Update

  FOR EACH hIndex IN hTableSrc.Indexes
    IF hIndex.Primary THEN CONTINUE
    WITH hIndex
      hTableDst.Indexes.Add(.Name, .Fields, .Unique)
    END WITH
  NEXT

  IF $bData THEN

    hDst.Begin

    rSrc = hSrc.Find(sSrc)

    IF sSrcCharset = sDstCharset THEN

      FOR EACH rSrc
        rDst = hDst.Create(sdST)
        FOR iInd = 0 TO rSrc.Fields.Count - 1
          rDst[iInd] = rSrc[iInd]
        NEXT
        rDst.Update
        INC $iCpt
        UpdateProgress
      NEXT

    ELSE

      FOR EACH rSrc
        rDst = hDst.Create(sDst)
        FOR iInd = 0 TO rSrc.Fields.Count - 1
          rDst[iInd] = rSrc[iInd]
          IF rSrc.Fields[iInd].Type = gb.String THEN
            TRY rDst[iInd] = Conv(rSrc[iInd], sSrcCharset, sDstCharset)
          ENDIF
        NEXT
        rDst.Update
        INC $iCpt
        UpdateProgress
      NEXT

    ENDIF

    hDst.Commit

  ENDIF

CATCH

  sMsg = Subst("Cannot copy table &1.", sSrc) & "\n\n" & Error.Text
  TRY hDst.Rollback
  TRY hDst.Tables.Remove(sDst)
  Error.Raise(sMsg)

END

PRIVATE SUB UpdateProgress(OPTIONAL bForce AS Boolean)

  IF NOT bForce THEN
    IF Timer < $eTimer THEN RETURN
  ENDIF

  $eTimer = Timer + 0.25

  IF $iTotal THEN
    pgbPaste.Value = CFloat($iCpt) / $iTotal
  ELSE
    pgbPaste.Value = 1
  ENDIF
  WAIT

END