[Delphi] DH Database Manager 0.8

Iniciado por BigBear, Octubre 28, 2016, 05:16:16 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Un programa en Delphi para administrar bases de datos del tipo :

  • MSSQL
  • MySQL
  • SQLite

    Unas imagenes :







    El codigo :

    Código: delphi

    // DH Database Manager 0.8
    // (C) Doddy Hackman 2016

    unit manager;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls,
      Vcl.StdCtrls,
      Vcl.DBCtrls, Vcl.Grids, Vcl.DBGrids, ZAbstractConnection, ZConnection,
      ZAbstractTable, ZDataset, Data.DB, ZAbstractRODataset, ZAbstractDataset,
      ShellApi, Vcl.ImgList, Vcl.Imaging.pngimage;

    type
      TFormHome = class(TForm)
        imgLogo: TImage;
        status: TStatusBar;
        pcOptions: TPageControl;
        tsConfiguration: TTabSheet;
        tsOptions: TTabSheet;
        tsGrid: TTabSheet;
        gbConfiguration: TGroupBox;
        lblHost: TLabel;
        txtHostname: TEdit;
        lblPort: TLabel;
        txtPort: TEdit;
        lblUsername: TLabel;
        txtUsername: TEdit;
        lblPassword: TLabel;
        txtPassword: TEdit;
        lblDatabase: TLabel;
        txtDatabase: TEdit;
        cmbService: TComboBox;
        btnConnect: TButton;
        btnDisconnect: TButton;
        gbOptions: TGroupBox;
        lblTable: TLabel;
        lblSQL_Query: TLabel;
        cmbTables: TComboBox;
        txtSQL_Query: TEdit;
        btnLoadTable: TButton;
        btnExecute: TButton;
        connection: TZConnection;
        lblService: TLabel;
        grid_connection: TDBGrid;
        nav_connection: TDBNavigator;
        query_connection: TZQuery;
        table_connection: TZTable;
        datasource_connection: TDataSource;
        btnLoadDB: TButton;
        odLoadDB: TOpenDialog;
        btnRefreshTables: TButton;
        ilIconosMenu: TImageList;
        ilIconosBotones: TImageList;
        procedure btnConnectClick(Sender: TObject);
        procedure btnDisconnectClick(Sender: TObject);
        procedure btnLoadTableClick(Sender: TObject);
        procedure btnExecuteClick(Sender: TObject);
        procedure cmbServiceSelect(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure btnLoadDBClick(Sender: TObject);
        procedure btnRefreshTablesClick(Sender: TObject);
      private
        { Private declarations }
        procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
      public
        { Public declarations }
        procedure cargarTablas();
      end;

    var
      FormHome: TFormHome;

    implementation

    {$R *.dfm}
    // Functions

    function message_box(title, message_text, type_message: string): string;
    begin
      if not(title = '') and not(message_text = '') and not(type_message = '') then
      begin
        try
          begin
            if (type_message = 'Information') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end
            else if (type_message = 'Warning') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONWARNING);
            end
            else if (type_message = 'Question') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONQUESTION);
            end
            else if (type_message = 'Error') then
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONERROR);
            end
            else
            begin
              MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
                MB_ICONINFORMATION);
            end;
            Result := '[+] MessageBox : OK';
          end;
        except
          begin
            Result := '[-] Error';
          end;
        end;
      end
      else
      begin
        Result := '[-] Error';
      end;
    end;

    // Function to DragDrop

    // Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
    // Thanks to ecfisa

    var
      bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;

    procedure TFormHome.DragDropFile(var Msg: TMessage);
    var
      nombre_archivo, extension: string;
      limite, number: integer;
      path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
    begin
      limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
      if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
        for number := 0 to limite do
        begin
          bypass_window(number, 1);
        end;
      for number := 0 to limite do
      begin
        DragQueryFile(Msg.WParam, number, path, 255);

        //

        if (FileExists(path)) then
        begin
          nombre_archivo := ExtractFilename(path);
          extension := ExtractFileExt(path);
          extension := StringReplace(extension, '.', '',
            [rfReplaceAll, rfIgnoreCase]);
          if (extension = 'sqlite') or (extension = 'db3') or (extension = 's3db')
          then
          begin
            txtDatabase.Text := path;
            status.Panels[0].Text := '[+] DB Loaded';
            message_box('DH Database Manager 0.8', 'DB Loaded', 'Information');
          end
          else
          begin
            status.Panels[0].Text := '[-] The DB is not valid';
            message_box('DH Database Manager 0.8', 'The DB is not valid',
              'Warning');
          end;
        end;

        //

      end;
      DragFinish(Msg.WParam);
    end;

    //

    procedure TFormHome.cargarTablas();
    var
      lst: TStrings;
      count: integer;
    begin
      if (connection.Connected = true) then
      begin
        try
          begin
            cmbTables.Clear;
            lst := TStringList.Create;
            connection.GetTableNames('', lst);
            count := lst.count;
            cmbTables.Items.Assign(lst);
            lst.Free();
            if (count >= 1) then
            begin
              cmbTables.ItemIndex := 0;
            end;
            ShowMessage('Tables loaded : ' + IntToStr(count));
          end;
        except
          begin
            ShowMessage('Tables not found');
          end;
        end;
      end
      else
      begin
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.cmbServiceSelect(Sender: TObject);
    begin
      if (cmbService.Text = 'MSSQL') then
      begin
        txtDatabase.ReadOnly := false;
        btnLoadDB.Enabled := false;
      end
      else if (cmbService.Text = 'MYSQL') then
      begin
        txtDatabase.ReadOnly := false;
        btnLoadDB.Enabled := false;
      end
      else if (cmbService.Text = 'SQLITE') then
      begin
        txtDatabase.Text := '';
        txtDatabase.ReadOnly := true;
        btnLoadDB.Enabled := true;
      end
      else
      begin
        status.Panels[0].Text := '[-] Service not found';
        message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
      end;
    end;

    procedure TFormHome.FormCreate(Sender: TObject);
    begin

      //

      if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
      begin
        @bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
          'ChangeWindowMessageFilter');
        bypass_window(WM_DROPFILES, 1);
        bypass_window(WM_COPYDATA, 1);
        bypass_window($0049, 1);
      end;
      DragAcceptFiles(Handle, true);

      //

      UseLatestCommonDialogs := false;
      odLoadDB.InitialDir := GetCurrentDir;
      odLoadDB.Filter :=
        'SQLITE files (*.sqlite)|*.SQLITE|DB3 Files (*.db3)|*.DB3|S3DB File (*.s3db)|*.S3DB';

      //

      btnLoadDB.Enabled := false;
    end;

    procedure TFormHome.btnConnectClick(Sender: TObject);
    begin

      // MSSQL : localhost\SQLEXPRESS
      // admin:123456

      // MYSQL : localhost:3306
      // root

      if (cmbService.Text = 'MSSQL') then
      begin
        if (txtHostname.Text = '') or (txtUsername.Text = '') or
          (txtPassword.Text = '') then
        begin
          status.Panels[0].Text := '[-] Missing data';
          message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
        end
        else
        begin
          try
            begin
              connection.HostName := txtHostname.Text;

              if not(txtDatabase.Text = '') then
              begin
                connection.Database := txtDatabase.Text;
              end;

              connection.Database := 'sistema';
              connection.Protocol := 'mssql';
              connection.User := txtUsername.Text;
              connection.Password := txtPassword.Text;
              connection.Connect;

              status.Panels[0].Text := '[+] Connected';
              message_box('DH Database Manager 0.8', 'Connected', 'Information');

              if not(txtDatabase.Text = '') then
              begin
                cargarTablas();
              end;

            end;
          except
            begin
              status.Panels[0].Text := '[-] Error connecting';
              message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
            end;
          end;
        end;
      end
      else if (cmbService.Text = 'MYSQL') then
      begin
        if (txtHostname.Text = '') or (txtPort.Text = '') or (txtUsername.Text = '')
        then
        begin
          status.Panels[0].Text := '[-] Missing data';
          message_box('DH Database Manager 0.8', 'Missing data', 'Warning');
        end
        else
        begin
          try
            begin
              connection.HostName := txtHostname.Text;
              connection.Port := StrToInt(txtPort.Text);

              if not(txtDatabase.Text = '') then
              begin
                connection.Database := txtDatabase.Text;
              end;

              connection.Protocol := 'mysql-5';

              connection.User := txtUsername.Text;
              connection.Password := txtPassword.Text;
              connection.Connect;

              status.Panels[0].Text := '[+] Connected';
              message_box('DH Database Manager 0.8', 'Connected', 'Information');

              if not(txtDatabase.Text = '') then
              begin
                cargarTablas();
              end;

            end;
          except
            begin
              status.Panels[0].Text := '[-] Error connecting';
              message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
            end;
          end;
        end;
      end
      else if (cmbService.Text = 'SQLITE') then
      begin
        if not(FileExists(txtDatabase.Text)) then
        begin
          status.Panels[0].Text := '[-] SQLITE Database not found';
          message_box('DH Database Manager 0.8', 'SQLITE Database not found',
            'Warning');
        end
        else
        begin
          try
            begin
              connection.Protocol := 'sqlite-3';
              connection.Database := txtDatabase.Text;
              connection.Connect;

              status.Panels[0].Text := '[+] Connected';
              message_box('DH Database Manager 0.8', 'Connected', 'Information');

              if not(txtDatabase.Text = '') then
              begin
                cargarTablas();
              end;

            end;
          except
            begin
              status.Panels[0].Text := '[-] Error connecting';
              message_box('DH Database Manager 0.8', 'Error connecting', 'Error');
            end;
          end;
        end;
      end
      else
      begin
        status.Panels[0].Text := '[-] Service not found';
        message_box('DH Database Manager 0.8', 'Service not found', 'Warning');
      end;

    end;

    procedure TFormHome.btnDisconnectClick(Sender: TObject);
    begin
      if connection.Connected = true then
      begin
        connection.Connected := false;
        status.Panels[0].Text := '[+] Disconnect';
        message_box('DH Database Manager 0.8', 'Disconnect', 'Information');
      end
      else
      begin
        status.Panels[0].Text := '[-] Not connected';
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.btnExecuteClick(Sender: TObject);
    begin
      if (connection.Connected = true) then
      begin
        try
          begin
            query_connection.Active := false;
            query_connection.SQL.Clear;
            query_connection.SQL.Add(txtSQL_Query.Text);
            query_connection.Active := true;
            datasource_connection.DataSet := query_connection;
            datasource_connection.DataSet.Refresh;
            status.Panels[0].Text := '[+] Command Executed';
            message_box('DH Database Manager 0.8', 'Command Executed',
              'Information');
          end;
        except
          on E: Exception do
          begin
            if (E.Message = 'Can not open a Resultset') then
            begin
              status.Panels[0].Text := '[?] SQL Query not return ResultSet';
              message_box('DH Database Manager 0.8',
                'SQL Query not return ResultSet', 'Information');
            end
            else
            begin
              status.Panels[0].Text := '[-] SQL Query Error';
              message_box('DH Database Manager 0.8', 'SQL Query Error', 'Error');
            end;
          end;
        end;
      end
      else
      begin
        status.Panels[0].Text := '[-] Not connected';
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.btnLoadDBClick(Sender: TObject);
    begin
      if odLoadDB.Execute then
      begin
        txtDatabase.Text := odLoadDB.filename;
      end;
    end;

    procedure TFormHome.btnLoadTableClick(Sender: TObject);
    begin
      if (connection.Connected = true) then
      begin
        try
          begin
            table_connection.Active := false;
            table_connection.TableName := cmbTables.Text;
            datasource_connection.DataSet := table_connection;
            table_connection.Active := true;
            datasource_connection.DataSet.Refresh;
            status.Panels[0].Text := '[+] Table Loaded';
            message_box('DH Database Manager 0.8', 'Table Loaded', 'Information');
          end;
        except
          begin
            status.Panels[0].Text := '[-] Error loading table';
            message_box('DH Database Manager 0.8', 'Error loading table', 'Error');
          end;
        end;
      end
      else
      begin
        status.Panels[0].Text := '[-] Not connected';
        message_box('DH Database Manager 0.8', 'Not connected', 'Warning');
      end;
    end;

    procedure TFormHome.btnRefreshTablesClick(Sender: TObject);
    begin
      cargarTablas();
    end;

    end.

    // The End ?


    Si quieren bajar el programa lo pueden hacer de aca :

    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.
    No tienes permitido ver los links. Registrarse o Entrar a mi cuenta.

    Eso seria todo.