execsql_f.pas

县级供电企业电费核算源码, 在客户处正常运行8年以上, Delphi 5开发,数据库为Interbase/Firebird, 深入使用Procedure和Trigger等, 对入门者具有很好的参考价值

unit ExecSQL_F;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, StdCtrls, ExtCtrls, DBCtrls, Db, DBTables, ComCtrls;

type
  TF_ExecSQL = class(TForm)
    Q_New: TQuery;
    Tb_SQL: TTable;
    Tb_SQLF_TOPIC: TStringField;
    Tb_SQLF_SQL: TBlobField;
    Ds_SQL: TDataSource;
    Tb_SQLF_ID: TStringField;
    PC: TPageControl;
    TS_Select: TTabSheet;
    TS_Other: TTabSheet;
    DBG_SQL: TDBGrid;
    DBM_SQL: TDBMemo;
    DBGrid1: TDBGrid;
    Ds_New: TDataSource;
    Panel3: TPanel;
    M_Select: TMemo;
    TS_EditTable: TTabSheet;
    DBGrid2: TDBGrid;
    Panel4: TPanel;
    Label1: TLabel;
    E_Table: TEdit;
    Bt_OpenTable: TButton;
    Tb_Edit: TTable;
    Ds_Edit: TDataSource;
    TS_Move: TTabSheet;
    DBGrid3: TDBGrid;
    Button2: TButton;
    M_Move: TMemo;
    Panel1: TPanel;
    Panel5: TPanel;
    Button3: TButton;
    M_SelectAmmeter: TMemo;
    CB_Select: TCheckBox;
    Bt_Sql: TButton;
    DBN: TDBNavigator;
    Bt_Export: TButton;
    Label2: TLabel;
    E_ExportFile: TEdit;
    Splitter1: TSplitter;
    procedure Bt_OpenTableClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Bt_SqlClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Bt_ExportClick(Sender: TObject);
    procedure E_ExportFileChange(Sender: TObject);
    procedure CB_SelectClick(Sender: TObject);
  private
    { Private declarations }
    Procedure P_Export(Dataset: TDataset; FileName:String);
  public
    { Public declarations }
  end;

var
  F_ExecSQL: TF_ExecSQL;

implementation
Uses
    ShellAPI;

{$R *.DFM}



procedure TF_ExecSQL.Bt_OpenTableClick(Sender: TObject);
begin
	If E_Table.Text = '' Then
    	Exit;
	If Tb_Edit.Active Then
    	Tb_Edit.Close;
    Tb_Edit.TableName := E_Table.Text;
    Tb_Edit.Open;
end;






procedure TF_ExecSQL.Button3Click(Sender: TObject);
Var
	V_SQL:String;
    I:Integer;
begin
	Tb_Sql.First();
   	Q_New.SQL.Clear();
	While Not Tb_Sql.EOF Do
   	Begin
    	For I := 0 To DBM_SQL.Lines.Count - 1 Do
        Begin
        	V_SQL := DBM_SQL.Lines[I];
            If Trim(V_SQL) = '' Then
            Begin
            	Q_New.ExecSQL();
                Q_New.SQL.Clear();
            End
            Else
            Begin
                Q_New.SQL.Add(V_SQL);
            End;
        End;
	    If Q_New.Text <> '' Then
    	Begin
        	Q_New.ExecSQL();
            Q_New.SQL.Clear();
        End;
        Tb_Sql.Next();
    End;
end;

procedure TF_ExecSQL.Button2Click(Sender: TObject);
begin
	If M_Move.Lines.Count > 0 Then
    Begin
		Q_New.SQL.Clear();
    	Q_New.Sql.AddStrings(M_Move.Lines);
    	Q_New.ExecSQL();
    End;
    Q_New.SQL.Clear();
	Q_New.Sql.AddStrings(M_SelectAmmeter.Lines);
    Q_New.Open();
end;

procedure TF_ExecSQL.Bt_SqlClick(Sender: TObject);
begin
	If Q_New.Active Then
       	Q_New.Close();
   	Q_New.SQL.Clear();
    Q_New.SQL.Add(M_Select.Text);
    If Cb_Select.Checked Then
       	Q_New.Open()
    Else
       	Q_New.ExecSQL();
end;

procedure TF_ExecSQL.FormShow(Sender: TObject);
begin
	MessageBox(Handle,'在执行任何操作之前请备份原有数据库，以免操作失败造成数据丢失!'#13#10
    				+ '两条SQL语句之间需用空行格开; 一条SQL语句中不能含有空行.',
                    '成批执行SQL语句时注意',0);
    Tb_SQL.Open();
end;



procedure TF_ExecSQL.Bt_ExportClick(Sender: TObject);
begin
    If Not Q_New.Active Then
        ShowMessage('请先执行查询, 然后才能输出结果')
    Else
        P_Export(Q_New, E_ExportFile.Text + '.CSV');
end;

Procedure TF_ExecSQL.P_Export(Dataset: TDataset; FileName:String);
Var
	i:Integer;
	FieldsName: String;
	FieldsValue: String;
	F: TextFile;
Begin
	FileName := ExtractFilePath(Application.EXEName) + FileName;
	AssignFile(F, FileName);
	Try
		Rewrite(F);
	Except
		ShowMessage('文件:' + FileName + '不能建立');
		CloseFile(F);
		Exit;
	End;

	FieldsName := '';
	For i:=0 To Dataset.FieldCount-1 Do
		FieldsName := FieldsName +  ',' + Dataset.Fields[i].DisplayLabel;
	Writeln(F,FieldsName);
	Dataset.First();
	While Not Dataset.Eof Do
	Begin
		FieldsValue := '';
		For i:=0 To Dataset.FieldCount-1 Do
			FieldsValue := FieldsValue + ',' + Trim(Dataset.Fields[i].Text);
		Writeln(F,FieldsValue);
		Dataset.Next();
	End;
	CloseFile(F);
    If Application.MessageBox(PChar('您的查询结果已输出到文件 ['+FileName+ '], 立即用Excel打开此文件吗'), '系统提示', MB_YESNO) = IDYES Then
        ShellExecute(Handle, nil, PChar(FileName), nil, nil, SW_SHOWMAXIMIZED);
End;

procedure TF_ExecSQL.E_ExportFileChange(Sender: TObject);
begin
    Bt_Export.Enabled := E_ExportFile.Text <> '';
end;

procedure TF_ExecSQL.CB_SelectClick(Sender: TObject);
begin
	If CB_Select.Checked Then
		Bt_SQL.Caption := '&S查询'
	Else
		Bt_SQL.Caption := '&E执行';
end;

end.