fmain.class

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

' Gambas class file

STATIC PUBLIC Container AS Container
'STATIC PUBLIC Config AS Config
STATIC PUBLIC Project AS String

PRIVATE $sKey AS String
PRIVATE $hServer AS CServer
PRIVATE $hConn AS CConnection
PRIVATE $sName AS String
PRIVATE $sTable AS String
PRIVATE $bDefault AS Boolean

PRIVATE $sCryptKey AS String

' STATIC PUBLIC SUB MoveRandom(hForm AS Window)
'
'   DIM iW AS Integer
'   DIM iH AS Integer
'
'   iW = Min(hForm.W, FMain.Container.W)
'   iH = Min(hForm.H, FMain.Container.H)
'
'   hForm.Move(Int(Rnd(FMain.Container.W - iW)), Int(Rnd(FMain.Container.H - iH)), iW, iH)
'
' END


PRIVATE SUB FindLocalServer()

  DIM hServer AS CServer
  DIM sTemp AS String

  sTemp = Temp$

  SHELL "pgrep postmaster > " & sTemp WAIT

  IF Stat(sTemp).Size THEN
    hServer = NEW CServer("postgresql")
  ENDIF

  SHELL "pgrep mysqld > " & sTemp WAIT

  IF Stat(sTemp).Size THEN
    hServer = NEW CServer("mysql")
  ENDIF

  IF Exist(Component.Path &/ "lib.gb.db.sqlite.la") THEN
    hServer = NEW CServer("sqlite")
  ENDIF

  KILL sTemp

  RefreshServer

END



' STATIC PUBLIC SUB Main()
'
'   FindLocalServer
'
'   Form = NEW FMain
'   Form.Show
'
' END

PRIVATE SUB LoadServer()

  DIM hServer AS CServer
  DIM iNbr AS Integer
  DIM iInd AS Integer
  DIM sType AS String
  DIM sHost AS String
  DIM sUser AS String
  DIM sPassword AS String
  DIM sKey AS String

  $sCryptKey = FPassword.Run()
  IF NOT $sCryptKey THEN RETURN

  'iNbr = Config.ReadInteger("/Connection/Count", 0)
  iNbr = Settings["/Connection/Count", 0]

  FOR iInd = 1 TO iNbr

    sKey = "/Connection/#" & CStr(iInd)

    'sType = Config.ReadString(sKey &/ "Type")
    'sHost = Config.ReadString(sKey &/ "Host")
    'sUser = Config.ReadString(sKey &/ "User")
    'sPassword = Config.ReadString(sKey &/ "Password")
    sType = Settings[sKey &/ "Type"]
    sHost = Settings[sKey &/ "Host"]
    sUser = Settings[sKey &/ "User"]
    sPassword = Crypt(FromHexaString(Settings[sKey &/ "Password"]))

    hServer = NEW CServer(sType, sHost, sUser, sPassword)

  NEXT

END


PRIVATE SUB SaveServer()

  DIM hServer AS CServer
  DIM iInd AS Integer
  DIM sKey AS String

  IF NOT $sCryptKey THEN RETURN

  'Config.WriteInteger("/Connection/Count", CServer.All.Count)
  Settings["/Connection/Count"] = CServer.All.Count

  FOR EACH hServer IN CServer.All

    INC iInd

    sKey = "/Connection/#" & CStr(iInd)

    'Config.WriteString(sKey &/ "Type", hServer.Handle.Type)
    'Config.WriteString(sKey &/ "Host", hServer.Handle.Host)
    'Config.WriteString(sKey &/ "User", hServer.Handle.Login)
    'Config.WriteString(sKey &/ "Password", hServer.Handle.Password)
    WITH hServer.Handle
      Settings[sKey &/ "Type"] = .Type
      Settings[sKey &/ "Host"] = .Host
      Settings[sKey &/ "User"] = .Login
      Settings[sKey &/ "Password"] = ToHexaString(Crypt(.Password))
    END WITH

  NEXT

END



PUBLIC SUB _new()

  'USE "Util"

  Application.Font = Font["10"]

  'Config = NEW Config
  Container = panBase

  LoadServer
  RefreshServer

END


PRIVATE SUB RefreshServer()

  DIM hServer AS CServer
  DIM sKey AS String

  FOR EACH hServer IN CServer.All
    sKey = "S" & CServer.All.Key
    IF NOT tvwBase.Exist(sKey) THEN
      tvwBase.Add(sKey, hServer.Name, Picture["img/16/host.png"])
      tvwBase.Add(sKey & "/", ("Cannot connect to server"), Picture["img/16/quit.png"], sKey)
    ENDIF
  NEXT

  tvwBase.MoveFirst
  WHILE tvwBase.Available
    IF NOT CServer.All.Exist(Mid$(tvwBase.Item.Key, 2)) THEN
      tvwBase.Item.Delete
    ELSE
      tvwBase.MoveNext
    ENDIF
  WEND

END

PUBLIC SUB Form_Resize()

  splBase.Move(0, 0, ME.ClientW, ME.ClientH)

END

PUBLIC SUB mnuQuit_Click()

  ME.Close

END

PUBLIC FUNCTION Form_Close() AS Boolean

  Config.SaveWindow(ME, "/FMain")
  Settings["/FMain/Splitter"] = splBase.Layout
  'Config.SaveSplitterPos(splBase, "FMain", "Splitter")
  SaveServer

  IF CConnection.RemoveAll() THEN RETURN TRUE
  CServer.RemoveAll

  'Container = NULL
  '$hConn = NULL
  '$hServer = NULL
  'Config = NULL
  'IF Message.Question(("Do you really want to quit ?"), "Yes", "No") = 1 THEN
    'CConnection.All = NULL
    'CServer.All = NULL
  'ELSE
  '  RETURN TRUE
  'ENDIF

END

PRIVATE SUB RefreshUser(sParent AS String)

  DIM hServer AS CServer
  DIM sName AS String
  DIM sKey AS String
  DIM sIcon AS String

  IF tvwBase[sParent].Children = 0 THEN
    tvwBase.MoveParent
    sParent = tvwBase.Item.Key
  ENDIF

  hServer = CServer.All[Split(Mid$(sParent, 2), "/")[0]]

  tvwBase[sParent].Clear

  FOR EACH sName IN hServer.Users
    sKey = "U" & hServer.Key &/ sName
    IF hServer.IsAdmin(sName) THEN
      sIcon = "admin.png"
    ELSE
      sIcon = "user.png"
    ENDIF
    tvwBase.Add(sKey, sName, Picture["img/16" &/ sIcon], sParent)
  NEXT

END


PUBLIC SUB RefreshDatabase(sParent AS String)

  DIM hServer AS CServer
  DIM sKey AS String
  DIM sName AS String
  DIM cKey AS NEW Collection

  WHILE Left$(sParent) <> "S"
    tvwBase.MoveTo(sParent)
    tvwBase.MoveParent
    IF NOT tvwBase.Available THEN RETURN
    sParent = tvwBase.Item.Key
  WEND

  hServer = CServer.All[Split(Mid$(sParent, 2), "/")[0]]

  FOR EACH sName IN hServer.Databases
    sKey = "D" & hServer.Key &/ sName
    cKey[sKey] = TRUE
    IF NOT tvwBase.Exist(sKey) THEN
      tvwBase.Add(sKey, sName, Picture["img/16/database.png"], sParent)
    ENDIF
    IF tvwBase[sKey].Children = 0 AND NOT tvwBase[sKey].Expanded THEN
      tvwBase.Add(sKey &/ "/", ("Cannot connect to database"), Picture["img/16/quit.png"], sKey)
    ENDIF
  NEXT

  tvwBase.MoveTo(sParent)
  tvwBase.MoveChild

  WHILE tvwBase.Available

    IF Left$(tvwBase.Item.Key) = "D" THEN
      IF NOT cKey.Exist(tvwBase.Item.Key) THEN
        tvwBase.Item.Delete
        CONTINUE
      ENDIF
    ENDIF

    tvwBase.MoveNext
  WEND

END


PUBLIC SUB RefreshTable(sParent AS String)

  DIM hConn AS CConnection
  DIM sName AS String
  DIM aKey AS String[]
  DIM sKey AS String
  DIM bSystem AS Boolean

  WHILE Left$(sParent) <> "D"
    tvwBase.MoveTo(sParent)
    tvwBase.MoveParent()
    sParent = tvwBase.Item.Key
  WEND

  aKey = Split(Mid$(sParent, 2), "/")

  hConn = CConnection.Get(CServer.All[aKey[0]], aKey[1])

  tvwBase[sParent].Clear

  FOR EACH sName IN hConn.Tables
    sKey = "T" & hConn.Key &/ sName
    tvwBase.Add(sKey, sName, Picture["img/16/table.png"], sParent)
  NEXT

  IF hConn.ShowSystemTables THEN
    FOR EACH sName IN hConn.SystemTables
      sKey = "T" & hConn.Key &/ sName
      tvwBase.Add(sKey, sName, Picture["img/16/system-table.png"], sParent)
    NEXT
  ENDIF

END


PUBLIC SUB tvwBase_Expand()

  DIM sKey AS String
  DIM sParent AS String
  DIM sChild AS String
  DIM sErr AS String
  DIM sName AS String
  DIM hServer AS CServer
  DIM hConn AS CConnection
  DIM aKey AS String[]
  DIM sRemove AS String

  sParent = tvwBase.Item.Key
  tvwBase.MoveChild
  sChild = tvwBase.Item.Key

  IF Right$(sChild) = "/" THEN

    INC Application.Busy

    sRemove = sChild

    SELECT CASE Left$(sParent)

      CASE "S"

        hServer = CServer.All[Mid$(sParent, 2)]
        sErr = hServer.Exec()
        IF sErr THEN
          DEC Application.Busy
          tvwBase[sParent].Expanded = FALSE
          Message.Error(("Cannot connect to database") & "\n\n" & sErr)
          RETURN
        ENDIF

        tvwBase[sParent].Picture = Picture["img/16/host-open.png"]

        sKey = "G" & hServer.Key
        tvwBase.Add(sKey, ("Users"), Picture["img/16/users.png"], sParent)
        tvwBase.Add(sKey & "/", "", , sKey)

        RefreshDatabase(sKey)

      CASE "G"

        RefreshUser(sParent)

      CASE "D"

        aKey = Split(Mid$(sParent, 2), "/")
        hConn = CConnection.Get(CServer.All[aKey[0]], aKey[1])

        sErr = hConn.Open()
        IF sErr THEN
          DEC Application.Busy
          tvwBase[sParent].Expanded = FALSE
          Message.Error(Subst(("Cannot connect to database '&1'"), hConn.Name) & "\n\n" & sErr)
          RETURN
        ENDIF

        tvwBase[sParent].Picture = Picture["img/16/database-open.png"]

        RefreshTable(sParent)

    END SELECT

    TRY tvwBase.Remove(sRemove)
    DEC Application.Busy

  ENDIF

END

PUBLIC SUB mnuNew_Click()

  IF FServer.Run() THEN RETURN
  RefreshServer

END

PUBLIC SUB mnuRefresh_Click()

  tvwBase.Clear
  CConnection.RemoveAll

  RefreshServer

END

PUBLIC SUB tvwBase_Menu()

  DIM sKey AS String
  DIM bEnabled AS Boolean
  DIM aKey AS String[]
  DIM bVisible AS Boolean

  IF NOT tvwBase.Current THEN
    mnuConnection.Popup
    RETURN
  ENDIF

  sKey = tvwBase.Current.Key
  aKey = Split(Mid$(sKey, 2), "/")
  $sKey = sKey

  SELECT CASE Left$(sKey)

    CASE "S", "G"

      $hServer = CServer.All[aKey[0]]

      bVisible = tvwBase["S" & $hServer.Key].Expanded
      mnuRefreshServer.Visible = NOT tvwBase.Exist("S" & $hServer.Key & "/")
      mnuCreateDatabase.Visible = bVisible
      mnuCreateUser.Visible = bVisible
      mnuOpenConnection.Visible = NOT bVisible

      mnuPasteDatabase2.Visible = bVisible AND Clipboard.Format = "text/x-gambas-database"

      mnuServer.Popup

    CASE "D", "Z"

      $hServer = CServer.All[aKey[0]]
      $sName = aKey[1]

      $hConn = CConnection.All[Mid$(sKey, 2)]

      mnuOpenDatabase.Visible = IsNull($hConn)
      mnuCreateTable.Visible = NOT Null?($hConn)
      mnuRequest.Visible = NOT Null?($hConn)
      mnuRefreshDatabase.Visible = NOT Null?($hConn)
      mnuCloseDatabase.Visible = NOT Null?($hConn)
      mnuMakeCode.Visible = Project AND NOT Null?($hConn)
      mnuSepEncoding.Visible = NOT Null?($hConn)
      mnuSepEncoding2.Visible = NOT Null?($hConn)
      'mnuCopyDatabase.Visible = NOT IsNull($hConn)

      WITH mnuUseDatabaseEncoding
        .Visible = NOT Null?($hConn)
        IF NOT IsNull($hConn) THEN
          .Checked = $hConn.UseEncoding
          .Text = Subst(("&Use encoding (&1)"), $hConn.Handle.Charset)
        ENDIF
      END WITH

      WITH mnuShowSystemTables
        .Visible = NOT Null?($hConn)
        IF NOT IsNull($hConn) THEN
          .Checked = $hConn.ShowSystemTables
        ENDIF
      END WITH