fmain.class

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

      mnuPasteDatabase.Visible = Clipboard.Format = "text/x-gambas-database"
      mnuPasteTable2.Visible = Clipboard.Format = "text/x-gambas-table" AND NOT IsNull($hConn)

      mnuDatabase.Popup

    CASE "U"

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

      IF $bDefault THEN
        mnuEditUser_Click
      ELSE
        mnuUser.Popup
      ENDIF

    CASE "T"

      $hServer = CServer.All[aKey[0]]
      $sName = aKey[1]
      $sTable = aKey[2]
      $hConn = CConnection.Get($hServer, $sName)

      tvwBase.MoveTo(sKey)
      tvwBase.MoveParent()
      bEnabled = Left$(tvwBase.Item.Key) <> "Z"
      mnuDeleteTable.Enabled = bEnabled
      'mnuEditTable.Enabled = bEnabled
      mnuRenameTable.Enabled = bEnabled

      mnuPasteTable.Visible = Clipboard.Format = "text/x-gambas-table"

      IF $bDefault THEN
        mnuOpenTable_Click
      ELSE
        mnuTable.Popup
      ENDIF

  END SELECT

  $bDefault = FALSE

END

PUBLIC SUB mnuCreateUser_Click()

  IF FUser.Run($hServer) THEN RETURN

  RefreshUser($sKey)

END

PUBLIC SUB mnuEditUser_Click()

  IF FUser.Run($hServer, $sName) THEN RETURN

  RefreshUser($sKey)

END

PUBLIC SUB mnuDeleteUser_Click()

  IF Message.Delete(Subst(("Do you really want to delete the user '&1' ?"), $sName), ("Delete"), ("Cancel")) = 2 THEN RETURN

  IF $hServer.DeleteUser($sName) THEN RETURN

  RefreshUser($sKey)

END

PUBLIC SUB tvwBase_Activate()

  IF tvwBase.Current.Children = 0 THEN
    $bDefault = TRUE
    tvwBase_Menu
  ENDIF

END

PUBLIC SUB mnuCloseServer_Click()

  IF Message.Delete(Subst(("Do you really want to remove the following server ?\n\n&1"), $hServer.Name), ("Remove"), ("Cancel")) = 2 THEN RETURN

  CServer.Remove($hServer)
  RefreshServer

END

PUBLIC SUB mnuCreateDatabase_Click()

  IF FDatabase.Run($hServer) THEN RETURN

  RefreshDatabase($sKey)

END

PUBLIC SUB mnuDeleteDatabase_Click()

  IF Message.Delete(Subst(("Do you really want to delete the database '&1' ?\n\nBE CAREFUL ! All your data will be lost."), $sName), ("Delete"), ("Cancel")) = 2 THEN RETURN

  IF $hServer.DeleteDatabase($sName) THEN RETURN

  RefreshDatabase($sKey)

END

PUBLIC SUB mnuEditTable_Click()

  $hConn.OpenTable($sTable, FALSE)

END

PUBLIC SUB mnuOpenTable_Click()

  $hConn.OpenTable($sTable, TRUE)

END

PUBLIC SUB mnuAbout_Click()

  FAbout.Run

END

PUBLIC SUB mnuCreateTable_Click()

  DIM aType AS String[]
  DIM sTable AS String

  IF $hConn.Handle.Type = "mysql" THEN
    'aType = [ "InnoDB", "BDB", "HEAP", "ISAM", "MERGE", "MRG_MYISAM", "MYISAM" ]
    aType = [ "MyISAM", "MERGE", "HEAP", "InnoDB", "BDB", "ISAM" ]
  ENDIF

  IF FNewTable.Run("", "InnoDB", aType) THEN RETURN

  IF $hConn.CreateTable(FNewTable.Name, FNewTable.Type) THEN RETURN

  RefreshTable($sKey)

END

PUBLIC SUB mnuDeleteTable_Click()

  IF Message.Delete(Subst(("Do you really want to delete the table '&1' ?"), $sTable), ("Delete"), ("Cancel")) <> 1 THEN RETURN

  IF $hConn.DeleteTable($sTable) THEN RETURN

  RefreshTable($sKey)

END


PUBLIC SUB mnuRefreshDatabase_Click()

  $hConn.RefreshTree
  'RefreshTable($sKey)

END


PUBLIC SUB mnuRequest_Click()

  $hConn.OpenRequest()

END


PUBLIC SUB mnuRefreshServer_Click()

  $hServer.Close
  $hServer.Exec
  tvwBase.Remove("S" & $hServer.Key)
  RefreshServer

CATCH

  Message(("Cannot refresh connection.") & "\n\n" & Error.Text)

END


PUBLIC SUB mnuCloseDatabase_Click()

  IF $hConn.Close() THEN RETURN

  WITH tvwBase[$sKey]
    .Expanded = FALSE
    .Clear()
    .Picture = Picture["img/16/database.png"]
  END WITH

  CConnection.Remove($hConn)
  RefreshDatabase("S" & $hServer.Key)

CATCH

  Message(("Cannot close database.") & "\n\n" & Error.Text)

END


' PUBLIC SUB mnuWindow_Show()
'
'   DIM hWin AS Window
'   DIM iInd AS Integer
'   DIM hMenu AS Menu
'
'   mnuWindow.Children.Clear
'
'   IF wrkBase.Children.Count = 0 THEN
'     hMenu = NEW Menu(mnuWindow)
'     hMenu.Text = ("No window")
'     hMenu.Enabled = FALSE
'     RETURN
'   ENDIF
'
'   hMenu = NEW Menu(mnuWindow) AS "mnuCascade"
'   hMenu.Text = ("&Cascade")
'
'   hMenu = NEW Menu(mnuWindow) AS "mnuTile"
'   hMenu.Text = ("&Tile")
'
'   hMenu = NEW Menu(mnuWindow)
'
'   FOR EACH hWin IN wrkBase.Children
'     INC iInd
'     hMenu = NEW Menu(mnuWindow) AS "mnuOneWindow"
'     hMenu.Text = "&" & CStr(iInd) & " " & hWin.Text
'     hMenu.Checked = hWin = wrkBase.ActiveWindow
'     hMenu.Tag = hWin
'   NEXT
'
' END


PUBLIC SUB mnuOneWindow_Click()

  LAST.Tag.Show

END


' PUBLIC SUB mnuCascade_Click()
'
'   wrkBase.Arrange(wrkBase.Cascade)
'
' END
'
'
' PUBLIC SUB mnuTile_Click()
'
'   wrkBase.Arrange(wrkBase.Tile)
'
' END
'

PUBLIC SUB Form_Open()

  IF Application.Args.Count = 2 THEN
    IF Application.Args[1] = "-debug" THEN
      DB.Debug = TRUE
    ENDIF
  ENDIF

  Config.LoadWindow(ME, "/FMain")
  'Config.LoadSplitterPos(splBase, "/FMain", "Splitter")
  splBase.Layout = Settings["/FMain/Splitter"]

  IF Application.Args.Count >= 2 THEN
    Project = Application.Args[1]
  ENDIF

END


PUBLIC SUB mnuUseDatabaseEncoding_Click()

  mnuUseDatabaseEncoding.Checked = NOT mnuUseDatabaseEncoding.Checked
  $hConn.UseEncoding = mnuUseDatabaseEncoding.Checked

END


PUBLIC SUB mnuShowSystemTables_Click()

  LAST.Checked = NOT LAST.Checked
  $hConn.ShowSystemTables = LAST.Checked
  RefreshTable($sKey)

END


PUBLIC SUB mnuScan_Click()

  FindLocalServer

END

PUBLIC SUB mnuKillAll_Click()

  IF Message.Delete(("Do you really want to remove all servers ?"), ("Remove all"), ("Cancel")) <> 1 THEN RETURN

  CServer.RemoveAll
  RefreshServer

END

PUBLIC SUB mnuOpenConnection_Click()

  tvwBase[$sKey].Expanded = TRUE

END

PUBLIC SUB mnuOpenDatabase_Click()

  tvwBase[$sKey].Expanded = TRUE

END

PUBLIC SUB mnuPasteDatabase_Click()

  DIM aData AS String[]

  aData = Split(Clipboard.Paste("text/x-gambas-database"), "\n")

  WITH FPasteDatabase
    .SrcKey = aData[0]
    .SrcName = aData[1]
    .SrcDatabase = aData[2]
    .DestKey = $hServer.Key
    .DestName = $hServer.Name
  END WITH

  IF NOT FPasteDatabase.ShowModal() THEN RETURN

  RefreshDatabase("S" & $hServer.Key)

END

PUBLIC SUB mnuPasteTable_Click()

  DIM aData AS String[]

  aData = Split(Clipboard.Paste("text/x-gambas-table"), "\n")

  WITH FPasteTable
    .SrcKey = aData[0]
    .SrcName = aData[1]
    .SrcDatabase = aData[2]
    .SrcTable = aData[3]
    .DestKey = $hServer.Key
    .DestName = $hServer.Name
    .DestDatabase = $sName
  END WITH

  IF NOT FPasteTable.ShowModal() THEN RETURN

  $hConn.RefreshTree
  'RefreshTable("D" & $hServer.Key &/ $sName)

END

PUBLIC SUB mnuCopyDatabase_Click()

  DIM sData AS String

  sData = $hServer.Key & "\n" & $hServer.Name & "\n" & $sName

  Clipboard.Copy(sData, "text/x-gambas-database")

END

PUBLIC SUB mnuCopyTable_Click()

  DIM sData AS String

  sData = $hServer.Key & "\n" & $hServer.Name & "\n" & $sName & "\n" & $sTable

  Clipboard.Copy(sData, "text/x-gambas-table")

END

PUBLIC SUB mnuMakeCode_Click()

  WITH FCode
    .Server = $hServer
    .Database = $sName
    .ShowDialog
  END WITH

END


STATIC PUBLIC FUNCTION GetProjectIcon(sPath AS String, iSize AS Integer) AS Picture

  DIM hFile AS File
  DIM sLig AS String
  DIM hImage AS Image
  DIM hPict AS Picture

  OPEN sPath &/ ".project" FOR READ AS #hFile

  WHILE NOT Eof(hFile)
    LINE INPUT #hFile, sLig
    IF Left$(sLig, 5) = "Icon=" THEN
      sPath = sPath &/ Mid$(sLig, 6)
      hImage = NEW Image
      TRY hImage.Load(sPath)
      IF ERROR THEN hImage = NULL
      BREAK
    ENDIF
  WEND

  CLOSE #hFile

FINALLY

  IF NOT hImage THEN
    hImage = NEW Image
    hImage.Load("img/32/gambas.png")
  ENDIF

  RETURN hImage.Stretch(iSize, iSize, TRUE).Picture

END


PRIVATE FUNCTION Crypt(sStr AS String) AS String

  DIM iInd AS Integer
  DIM iPos AS Integer
  DIM sRes AS String

  FOR iInd = 1 TO Len(sStr)
    INC iPos
    IF iPos > Len($sCryptKey) THEN iPos = 1
    sRes = sRes & Chr$(Asc(sStr, iInd) XOR Asc($sCryptKey, iPos) XOR 13)
  NEXT

  RETURN sRes

END


PRIVATE FUNCTION ToHexaString(sStr AS String) AS String

  DIM iInd AS Integer
  DIM sRes AS String

  FOR iInd = 1 TO Len(sStr)
    sRes = sRes & Hex$(Asc(sStr, iInd), 2)
  NEXT

  RETURN sRes

END


PRIVATE FUNCTION FromHexaString(sStr AS String) AS String

  DIM iInd AS Integer
  DIM sRes AS String

  FOR iInd = 1 TO Len(sStr) STEP 2
    sRes = sRes & Chr$(Val("&H" & Mid$(sStr, iInd, 2)))
  NEXT

  RETURN sRes

END