cconnection.class

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

' Gambas class file

STATIC PUBLIC All AS NEW Collection

PUBLIC Server AS CServer
PUBLIC Handle AS Connection
PUBLIC SystemTables AS String[]
PUBLIC Tables AS String[]
PUBLIC Name AS String
PUBLIC Key AS String

PUBLIC ShowSystemTables AS Boolean

PROPERTY UseEncoding AS Boolean
PROPERTY READ Charset AS String

PRIVATE $bUseEncoding AS Boolean


STATIC PUBLIC FUNCTION Get(hServer AS CServer, sName AS String) AS CConnection

  DIM sKey AS String
  DIM hConn AS CConnection

  sKey = hServer.Key &/ sName

  hConn = All[sKey]
  IF NOT hConn THEN
    hConn = NEW CConnection(hServer, sName)
  ENDIF

  RETURN hConn

END

STATIC PUBLIC SUB CloseAll()

  DIM hConn AS CConnection

  FOR EACH hConn IN All
    hConn.Close
  NEXT

END

STATIC PUBLIC SUB Remove(hConn AS CConnection)

  IF hConn THEN
    hConn.Close
    hConn.Server = NULL
    All.Remove(hConn.Key)
  ENDIF

END

STATIC PUBLIC FUNCTION RemoveAll(OPTIONAL hServer AS CServer) AS Boolean

  DIM hConn AS CConnection

  FOR EACH hConn IN All
    IF hServer THEN
      IF hConn.Server <> hServer THEN CONTINUE
    ENDIF
    IF hConn.Close() THEN RETURN TRUE
    Remove(hConn)
  NEXT

END


PUBLIC SUB _new(hServer AS CServer, sName AS String, OPTIONAL bTemp AS Boolean)

  Server = hServer
  Name = sName

  Key = hServer.Key &/ sName
  IF NOT bTemp THEN All[Key] = ME
  $bUseEncoding = TRUE

END


PRIVATE SUB Refresh()

  DIM hTable AS Table

  Tables = NEW String[]
  SystemTables = NEW String[]

  'Handle.Tables.Refresh

  FOR EACH hTable IN Handle.Tables
    IF hTable.System THEN
      SystemTables.Add(hTable.Name)
    ELSE
      Tables.Add(hTable.Name)
    ENDIF
  NEXT

  Tables.Sort
  SystemTables.Sort

END



PUBLIC FUNCTION Open() AS String

  IF Handle THEN RETURN

  Handle = NEW Connection

  Handle.Type = Server.Handle.Type
  Handle.Host = Server.Handle.Host
  Handle.Login = Server.Handle.Login
  Handle.Password = Server.Handle.Password
  Handle.Name = Name

  Handle.Open

  Refresh

CATCH

  Handle = NULL
  RETURN Error.Text

END

PUBLIC FUNCTION Close() AS Boolean

  DIM hForm AS Object
  DIM hConn AS CConnection
  DIM sType AS String
  DIM aDelete AS NEW Object[]

  IF NOT Handle THEN RETURN

  FOR EACH hForm IN FMain.Container.Children
    SELECT CASE Object.Type(hForm)
      CASE "FTable", "FData", "FRequest"
        IF hForm.Connection = ME THEN aDelete.Add(hForm)
    END SELECT
  NEXT

  FOR EACH hForm IN aDelete
    IF hForm.Close() THEN RETURN TRUE
  NEXT

  'IF FMain.Config.ReadBoolean("/CodeGeneration" &/ File.Name(FMain.Project) &/ Server.Key &/ Name &/ "AutoUpdate") THEN
  IF Settings["/CodeGeneration" &/ File.Name(FMain.Project) &/ Server.Key &/ Name &/ "AutoUpdate", FALSE] THEN
    FCode.GenerateCode(Server, Name)
  ENDIF

  TRY Handle.Close
  Handle = NULL

END

PUBLIC FUNCTION IsOpened() AS Boolean

  RETURN Handle

END


PRIVATE FUNCTION FindForm(sType AS String, OPTIONAL sTable AS String) AS Form

  DIM hForm AS Object

  FOR EACH hForm IN FMain.Container.Children
    IF Object.Type(hForm) = sType THEN
      IF hForm.Connection = ME THEN
        IF Len(sTable) THEN
          IF hForm.Table = sTable THEN RETURN hForm
        ELSE
          RETURN hForm
        ENDIF
      ENDIF
    ENDIF
  NEXT

END


PUBLIC SUB OpenTable(sTable AS String, bData AS Boolean)

  DIM hForm AS Object

  bData = FALSE

  hForm = FindForm(If(bData, "FData", "FTable"), sTable)

  IF NOT hForm THEN
    IF bData THEN
      hForm = NEW FData(ME, sTable, SystemTables.Find(sTable) >= 0, FMain.Container)
    ELSE
      hForm = NEW FTable(ME, sTable, SystemTables.Find(sTable) >= 0, FMain.Container)
    ENDIF
  ENDIF

  hForm.Show
  'hForm.Raise

END


PUBLIC SUB OpenRequest()

  DIM hForm AS Object

  hForm = FindForm("FRequest")

  IF NOT hForm THEN
    hForm = NEW FRequest(ME, FMain.Container)
  ENDIF

  hForm.Show

END


PUBLIC FUNCTION CreateTable(sTable AS String, sType AS String) AS Boolean

  DIM hTable AS Table

  IF Handle.Tables.Exist(sTable) THEN
    Message.Warning(("Table already exists."))
    RETURN
  ENDIF

  hTable = Handle.Tables.Add(sTable, sType)
  WITH hTable
    .Fields.Add("id", gb.Integer)
    .PrimaryKey = ["id"]
    .Update
  END WITH

  Refresh
  OpenTable(sTable, FALSE)

CATCH

  Message(Subst(("Cannot create table '&1'."), sTable) & "\n\n" & Error.Text)
  RETURN TRUE

END


PUBLIC FUNCTION DeleteTable(sTable AS String) AS Boolean

  DIM hForm AS Form

  hForm = FindForm("FTable", sTable)
  IF hForm THEN hForm.Delete

  hForm = FindForm("FData", sTable)
  IF hForm THEN hForm.Close

  Handle.Tables.Remove(sTable)
  Refresh

CATCH

  Message(Subst(("Cannot delete table '&1'."), sTable) & "\n\n" & Error.Text)
  RETURN TRUE

END


PUBLIC FUNCTION GetTempTableName() AS String

  DIM iInd AS Integer
  DIM sTemp AS String

  FOR iInd = 0 TO 99
    sTemp = "_gdbmgr_table"
    IF iInd THEN sTemp = sTemp & "_" & iInd
    IF NOT Handle.Tables.Exist(sTemp) THEN BREAK
    INC iInd
    sTemp = ""
  NEXT

  IF NOT sTemp THEN Error.Raise("Cannot find a free temporary table name")

  RETURN sTemp

END



PUBLIC FUNCTION CopyTableData(sTable AS String) AS String

  DIM sTemp AS String
  DIM iInd AS Integer
  DIM sReq AS String
  DIM hSrc AS Table
  DIM hDst AS Table
  DIM rSrc AS Result
  DIM rDst AS Result
  DIM sField AS String
  DIM hField AS Field
  DIM sError AS String

  sTemp = GetTempTableName()

  SELECT CASE Handle.Type

    CASE "postgresql"
      sReq = "SELECT * INTO TABLE " & sTemp & " FROM \"" & sTable & "\""
      Handle.Exec(sReq)

    CASE "mysql"
      sReq = "CREATE TABLE " & sTemp & " SELECT * FROM `" & sTable & "`"
      Handle.Exec(sReq)

    'CASE "sqlite"
    '  sReq = "INSERT INTO " & sTemp & " SELECT * FROM " & sTable

    DEFAULT

      hSrc = Handle.Tables[sTable]
      hDst = Handle.Tables.Add(sTemp, hSrc.Type)

      'IF NOT hSrc.PrimaryKey THEN Error.Raise("No primary key")

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

      hDst.PrimaryKey = hSrc.PrimaryKey

      hDst.Update

      Handle.Begin

      rSrc = Handle.Find(sTable)
      rDst = Handle.Create(sTemp)

      FOR EACH rSrc
'         FOR EACH hField IN rSrc.Fields
'           sField = hField.Name
'           rDst[sField] = rSrc[sField]
'         NEXT
        FOR iInd = 0 TO rSrc.Fields.Count - 1
          rDst[iInd] = rSrc[iInd]
        NEXT
        rDst.Update
      NEXT

      Handle.Commit

  END SELECT

  RETURN sTemp

CATCH

  sError = Error.Text

  SELECT CASE Handle.Type

    CASE "postgresql"

    CASE "mysql"
      TRY Handle.Rollback
      IF Handle.Tables.Exist(sTable) THEN
         TRY Handle.Tables.Remove(sTemp)
      ELSE
         IF Handle.Tables.Exist(sTemp) THEN
            sReq = "RENAME TABLE " & sTemp & " TO " & sTable
            TRY Handle.Exec(sReq)
         ELSE
            Error.Raise("Severe Error: Table has been lost!!")
         ENDIF
      ENDIF

    DEFAULT
      TRY Handle.Rollback
      IF Handle.Tables.Exist(sTable) THEN
         TRY Handle.Tables.Remove(sTemp)
      ELSE
         IF Handle.Tables.Exist(sTable) THEN
            Error.Raise("Severe Error: Table " & sTable & " has not been recreated. Data held in " & sTemp)
         ENDIF
      ENDIF

  END SELECT

  Error.Raise("Cannot copy table data: " & sError)

END


PUBLIC FUNCTION CountTableData(sTable AS String) AS Integer

  DIM rResult AS Result

  rResult = Handle.Exec("SELECT COUNT(*) AS nRecord FROM " & Handle.Quote(sTable))
  RETURN rResult!nRecord

END


STATIC PUBLIC FUNCTION WidthFromType(hCtrl AS control, iType AS Integer, iLength AS Integer, sTitle AS String) AS Integer

  DIM iWidth AS Integer

  SELECT CASE iType

    CASE gb.Boolean
      iWidth = hCtrl.Font.Width(Str(FALSE)) + 32

    CASE gb.Integer
      iWidth = hCtrl.Font.Width("1234567890") + 8

    CASE gb.Float
      iWidth = hCtrl.Font.Width(CStr(Pi) & "E+999") + 8

    CASE gb.Date
      iWidth = hCtrl.Font.Width(Str(Now)) + 8

    CASE gb.String
      IF iLength = 0 THEN iLength = 255
      iLength = Min(32, iLength)
      iWidth = hCtrl.Font.Width("X") * iLength + 8

  END SELECT

  iWidth = Max(iWidth, hCtrl.Font.Width(sTitle) + 8)

  RETURN iWidth

END

PUBLIC SUB RefreshTree()

  Refresh
  FMain.RefreshTable("D" & Key)

END


PUBLIC FUNCTION GetCharset() AS String

  IF $bUseEncoding THEN RETURN Handle.Charset

END


PRIVATE FUNCTION UseEncoding_Read() AS Boolean

  RETURN $bUseEncoding

END


PRIVATE SUB UseEncoding_Write(bEncoding AS Boolean)

  DIM hWin AS Object
  DIM hConn AS CConnection

  IF bEncoding = $bUseEncoding THEN RETURN

  $bUseEncoding = bEncoding

  FOR EACH hWin IN FMain.Container.Children
    hConn = NULL
    TRY hConn = hWin.Connection
    IF hConn THEN
      TRY hWin.EncodingChange()
    ENDIF
  NEXT

END


PRIVATE FUNCTION Charset_Read() AS String

  IF $bUseEncoding THEN
    RETURN Handle.Charset
  ELSE
    RETURN "UTF-8"
  ENDIF

END