Chip 1998 November/Chip_1998-11_cd.bin/tema/rks_dd/_SETUP.1/psql_form.pas

Pascal/Delphi Source File | 1998-02-01 | 6KB | 266 lines

unit psql_form;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, Menus, DB, DBTables,
  ComCtrls, inifiles,shlobj,ole2;
  (* ole2.pas je v  \Borland\Delphi 3\Source\RTL\WIN\ole2.pas  *)

const
  inifilename = 'simpler.ini';

type

  TBrowseFolderDialog = class(TObject)
  private
    bi:tbrowseinfo;
    str:array[0..max_path] of char;
    pIDListItem:PItemIdList;
    pstr:pchar;
    function gettitle:string;
    function getpath:string;
  public
     function execute:boolean;
  published
    property path: string read getpath;
  end;



  Tf_psql = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit1: TMenuItem;
    Exit1: TMenuItem;
    LoadSQLscript1: TMenuItem;
    Query1: TQuery;
    OpenDialog1: TOpenDialog;
    ClearOutput1: TMenuItem;
    StatusBar1: TStatusBar;
    Panel5: TPanel;
    sb_load: TSpeedButton;
    sb_close: TSpeedButton;
    sb_run: TSpeedButton;
    Run1: TMenuItem;
    N1: TMenuItem;
    sb_selectfolder: TSpeedButton;
    Label1: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Memo1: TMemo;
    Memo2: TMemo;
    Splitter1: TSplitter;
    procedure Exit1Click(Sender: TObject);
    procedure LoadSQLscript1Click(Sender: TObject);
    procedure ClearOutput1Click(Sender: TObject);
    procedure sb_runClick(Sender: TObject);
    procedure sb_closeClick(Sender: TObject);
    procedure sb_selectfolderClick(Sender: TObject);
    procedure Run1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    errorcount:integer;
    browsefolderdialog1:tbrowsefolderdialog;
  public
    procedure run;
    procedure runsql(sl:tstringlist);
  end;

var
  f_psql: Tf_psql;

implementation

{$R *.DFM}

function charexist(ch:char;s:string):integer;
var i:integer;
    ch2:char;
begin
result := 0;
for i := length(s) downto 1 do
   begin
   ch2 := s[i];
   IF ch2 = ch then
      begin
      result := i;
      exit;
      end;
   end;
end;


function TBrowseFolderDialog.gettitle:string;
begin
result := bi.lpszTitle;
end;


function tbrowsefolderdialog.getpath:string;
begin
result := pstr;
end;


function tbrowsefolderdialog.execute:boolean;
begin
bi.hwndOwner := getactivewindow;
bi.pidlroot := nil;
bi.pszdisplayname := @str;
bi.ulflags := BIF_returnonlyfsdirs;
bi.lpfn := nil;
pIDListItem := SHBrowseforfolder(bi);
IF pIDListItem <> nil then
   begin
   pstr := @str;
   SHGEtPathFromIdLIst(pidlistitem,pstr);
   CoTaskMemFree(piDListItem);
   result := true;
   end
  else
   result := false;
end;




procedure Tf_psql.run;
var sl:tstringlist;
    i:integer;
    s:string;
    pozice:integer;
begin
query1.databasename := label1.caption;
errorcount := 0;
sl := tstringlist.create;
  try
  for i := 0 to memo1.lines.count-1 do
     begin
     s := memo1.lines.strings[i];
     pozice := charexist(';',s);
     IF pozice = 0 then
       begin
       IF trim(s) <>'' then sl.add(s);
       end
      else
       begin
       s := copy(s,0,pozice-1);
       if trim(s) <> '' then sl.add(s);
       runsql(sl);
       sl.clear;
       end;
     end;
  runsql(sl);
  IF errorcount > 0 then
     begin
     memo2.lines.add(format('pocet chyb %d',[errorcount]));
     MessageDlg(format('Ve scriptu bylo %d chyb',[errorcount]),mtWarning,[mbCancel],0);
     end
    else
     begin
     MessageDlg('Script probehl bez chyb',mtInformation,[mbOK],0);
     end;
  finally
  sl.free;
  end;
end;


procedure Tf_psql.runsql(sl:tstringlist);
begin
IF sl.count > 0 then
   begin
   memo2.lines.addstrings(sl);
   memo2.lines.add('');
   query1.sql.clear;
   query1.sql.assign(sl);
     try
     query1.execsql;;
     except
       on e:edbengineerror do
        begin
        memo2.lines.add(format('ERROR: %s',[e.message]));
        inc(errorcount);
        end;
     end;
   end;
end;

procedure Tf_psql.Exit1Click(Sender: TObject);
begin
close;
end;


procedure Tf_psql.LoadSQLscript1Click(Sender: TObject);
begin
IF opendialog1.execute then
   begin
   memo1.lines.clear;
   memo1.lines.loadfromfile(opendialog1.filename);
   end;
end;

procedure Tf_psql.ClearOutput1Click(Sender: TObject);
begin
memo2.lines.clear;
end;

procedure Tf_psql.sb_runClick(Sender: TObject);
begin
run;
end;

procedure Tf_psql.sb_closeClick(Sender: TObject);
begin
close;
end;

procedure Tf_psql.sb_selectfolderClick(Sender: TObject);
begin
IF browsefolderdialog1.execute then
   begin
   label1.caption := browsefolderdialog1.path;
   end;
end;

procedure Tf_psql.Run1Click(Sender: TObject);
begin
run;
end;

procedure Tf_psql.FormCreate(Sender: TObject);
var ini:tinifile;
begin
browsefolderdialog1 := tbrowsefolderdialog.create;
ini := tinifile.create(inifilename);
  try
  label1.caption := ini.readstring('pisql','directory','');
  finally
  ini.free;
  end;
end;

procedure Tf_psql.FormClose(Sender: TObject; var Action: TCloseAction);
var ini:tinifile;
begin
ini := tinifile.create(inifilename);
  try
  ini.writestring('pisql','directory',label1.caption);
  finally
  ini.free;
  end;
end;

procedure Tf_psql.FormDestroy(Sender: TObject);
begin
browsefolderdialog1.free;
end;

end.