fpastedatabase.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

  lblDstServer.Text = DestName

  hServer = CServer.All[DestKey]

'   IF SrcTable THEN
'
'     hConn = CConnection.Get(hServer, DestDatabase)
'     'txtName.Text = If(Table, Table, Database)
'     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
'
'   ELSE

    'txtName.Text = If(Table, Table, Database)

  FOR iInd = 0 TO 99
    sText = SrcDatabase
    IF iInd THEN sText = sText & CStr(iInd + 1)
    IF hServer.Databases.Find(sText) < 0 THEN BREAK
  NEXT

  txtName.Text = sText
  txtName.SetFocus
  txtName.Select

END

PUBLIC SUB btnCancel_Click()

  ME.Close

END

PUBLIC SUB btnOK_Click()

  DestDatabase = Trim(txtName.Text)

  IF NOT DestDatabase THEN
    'IF DestDatabase THEN
    Message.Warning(("Please enter a database name."))
    'ELSE
    '  Message.Warning(("Please enter a table name."))
    'ENDIF
    txtName.SetFocus
    RETURN
  ENDIF

  $bData = optCopyData.Value

  CopyDatabase
  ME.Close(TRUE)

END

PRIVATE SUB CopyDatabase()

  DIM hSrc AS CConnection
  DIM hDst AS CConnection
  DIM hServer AS CServer
  DIM sTable AS String
  DIM rSrc AS Result
  DIM sMsg AS String

  INC Application.Busy

  pgbPaste.Value = 0

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

  hServer = CServer.All[DestKey]
  hServer.CreateDatabase(DestDatabase)

  hDst = NEW CConnection(hServer, DestDatabase, TRUE)

  hSrc.Open
  hDst.Open

  $iTotal = hSrc.Tables.Count * 1000

  IF $bData THEN

    FOR EACH sTable IN hSrc.Tables

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

    NEXT

  ENDIF

  $iCpt = 0
  $eTimer = Timer

  FOR EACH sTable IN hSrc.Tables
    CopyTable(hSrc.Handle, hDst.Handle, sTable)
    $iCpt = $iCpt + 1000
    UpdateProgress
  NEXT

  UpdateProgress(TRUE)

FINALLY

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

CATCH

  TRY hServer.DeleteDatabase(DestDatabase)
  Message.Error(("Cannot copy database.") & "\n\n" & sMsg)

END


PRIVATE SUB CopyTable(hSrc AS Connection, hDst AS Connection, sTable 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[sTable]
  hTableDst = hDst.Tables.Add(sTable, 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(sTable)

    IF sSrcCharset = sDstCharset THEN

      FOR EACH rSrc
        rDst = hDst.Create(sTable)
        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(sTable)
        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.", sTable) & "\n" & Error.Text
  TRY hDst.Rollback
  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