[Delphi] DH Database Manager 0.8

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

Tema anterior - Siguiente tema

0 Miembros y 2 Visitantes 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 :

    You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.
    You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.

    Eso seria todo.