uformmain.pas

精彩编程百例75～100 其中有媒体播放器 SQL语言编辑器 ADO方法连接多个数据库 用户密码验证系统 获取Man地址 信史服务 ping命令等待

unit UFormMain;

// UFormMain.pas - Main form for SQL Builder
// Copyright (c) 2000. All Rights Reserved.
// By Paul Kimmel. Okemos, MI USA

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, DBTables, ComCtrls, StdCtrls, Grids, DBGrids, ValEdit,
  ExtCtrls;


resourcestring
 sDatabaseNamesLoaded = 'Database names loaded';
 sTableNamesLoaded = 'Table names changed';
 sQueryTypeChanged = 'Query type changed to %s';
 sModifyDataSQL = 'You are about to execute a query that will modify data. Are you sure?';
 sSelectSql = 'SELECT %s FROM %s';
 sSelectWhereSql = 'SELECT %s FROM %s WHERE %s';
 sDeleteSql = 'DELETE FROM %s';
 sDeleteWhereSql = 'DELETE FROM %s WHERE %s';
 sInsertSql = 'INSERT INTO %s (%s) VALUES (%s)';
 sUpdateSql = 'UPDATE %s SET %s';

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    MainMenu1: TMainMenu;
    Query1: TQuery;
    DataSource1: TDataSource;
    File1: TMenuItem;
    Exit1: TMenuItem;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DBGrid1: TDBGrid;
    SaveDialog1: TSaveDialog;
    SaveAs1: TMenuItem;
    N1: TMenuItem;
    Tools1: TMenuItem;
    RefreshFields1: TMenuItem;
    RunSQL1: TMenuItem;
    Panel1: TPanel;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    ValueListEditor1: TValueListEditor;
    Panel2: TPanel;
    RadioGroup1: TRadioGroup;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    Open1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure ValueListEditor1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RefreshFields1Click(Sender: TObject);
    procedure ValueListEditor1StringsChange(Sender: TObject);
    procedure RunSQL1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
  private
    { Private declarations }
    procedure CreateSQL( Strings : TStrings );
    procedure CreateSelect( Strings : TStrings );
    procedure CreateDelete( Strings : TStrings );
    procedure CreateUpdate( Strings : TStrings );
    procedure CreateInsert( Strings : TStrings );
    function GetNameAndValuePairs( const Delim : string = ', ' ) : string;
    function GetFieldNames : string;
    procedure GetFieldsAndValuesForInsert( var FieldList, ValueList : String );
  public
    { Public declarations }
    procedure RunSQL;

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Exit1Click(Sender: TObject);
//退出程序
begin
 Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
//初始化控件属性
begin
 SaveDialog1.InitialDir := ExtractFilePath(Application.EXEName);
 //设置文件的保存路径
 ComboBox1.Text := '';
 //清空下来列表框的内容
 Session.GetDatabaseNames(ComboBox1.Items);
 //设置数据库名称
 ComboBox2.Text := '';
 Memo1.Lines.Clear;
end;



procedure TForm1.ComboBox1Change(Sender: TObject);
//取得当前数据库的名称
begin
 ComboBox2.Text := '';
 //清空第二个列表框的内容
 Session.GetTableNames(ComboBox1.Text, '*.*', True, False, ComboBox2.Items );
 //取得Table名称
 ValuelistEditor1.Strings.Clear;
 Memo1.Lines.Clear;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
//取得表的名称
var
 T : TTable;
 I : Integer;
begin
 Memo1.Lines.Clear;
 if( ComboBox1.Text = '' ) and (ComboBox2.Text <> '' )then exit;

 T := TTable.Create(Nil);
 //生成Table对象
 try
   T.DatabaseName := ComboBox1.Text;
   //设置Table所链接的表
   T.TableName := ComboBox2.Text;
   T.Open;

   ValueListEditor1.Strings.Clear;
   for I := 0 to T.FieldCount - 1 do
     ValueListEditor1.InsertRow( T.Fields[I].FieldName, '', True );
 finally
   FreeAndNil(T);
 end;

end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
//生成新的Sql语句
begin
 Memo1.Lines.Clear;
 CreateSQL( Memo1.Lines );
end;

procedure TForm1.RunSQL;
//启动SQL语句
begin

 try
   Query1.Close;//关闭Query控件
   Query1.DatabaseName := ComboBox1.Text;//设置Query控件要链接的数据库
   Query1.SQL.Text := Trim(Memo1.Lines.Text);
   if( Pos( 'select', LowerCase(Query1.SQL.Text)) > 0 ) then
     Query1.Open
   else
     if( MessageDlg(sModifyDataSql, mtConfirmation, [mbYes, mbNo], 0 ) = mrYes ) then
       Query1.ExecSQL;//执行SQL查询
 except//异常处理
   on E : Exception do
     ShowException( E, Addr(E));
 end;

end;

procedure TForm1.PageControl1Change(Sender: TObject);
//改变标签页式，更新控件的显示
begin
 if( Memo1.Lines.Text = '' ) or (PageControl1.ActivePageIndex = 0) then exit;
 RunSQL;
end;

procedure TForm1.CreateDelete( Strings : TStrings );
//删除对象
var
 Where : string;
begin
 Where := GetNameAndValuePairs( ' AND ' );
 if( Where <> '' ) then
   Strings.Text := Format(sDeleteWhereSql, [ComboBox2.Text, Where] )
 else
   Strings.Text := Format( sDeleteSql, [ComboBox2.Text] );
end;

procedure TForm1.CreateInsert( Strings : TStrings );
//生成插入语句
var
 Fields, Values : string;
begin
 GetFieldsAndValuesForInsert( Fields, Values );
 Strings.Text := Format( sInsertSql, [ComboBox2.Text, Fields, Values] );
end;

procedure TForm1.CreateSQL( Strings : TStrings );
//生成SQL语句
begin
 case RadioGroup1.ItemIndex of
 0: CreateSelect( Strings );
 1: CreateDelete( Strings );
 2: CreateInsert( Strings );
 3: CreateUpdate( Strings );
 end;
end;

procedure TForm1.CreateUpdate( Strings : TStrings );
var//生成更新语句
 ModFields : string;
begin
 ModFields := GetNameAndValuePairs;
 Strings.Text := Format( sUpdateSql, [ComboBox2.Text, ModFields] );
end;

procedure TForm1.CreateSelect( Strings : TStrings );
//生成选择语句，显示查询信息
var
 Where, Fields : string;
begin
 Where := GetNameAndValuePairs;
 Fields := GetFieldNames;

 if( Where <> '' ) then
   Strings.Text := Format( sSelectWhereSql, [Fields, ComboBox2.Text, Where])
 else
   Strings.Text := Format( sSelectSql, [Fields, ComboBox2.Text] );
end;

procedure TForm1.SaveAs1Click(Sender: TObject);
//保存SQL语句
begin
 if( SaveDialog1.Execute ) then
 begin
   Memo1.Lines.SaveToFile(SaveDialog1.FileName);
   SaveDialog1.InitialDir := ExtractFilePath( SaveDialog1.FileName );
 end;
end;

procedure TForm1.ValueListEditor1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//判断选中了哪一列
begin
 if( Shift = [ssCtrl] ) and ( key = VK_DELETE ) then
 begin
   ValueListEditor1.DeleteRow(ValueListEditor1.Row);
   CreateSQL( Memo1.Lines );
 end;
end;

procedure TForm1.RefreshFields1Click(Sender: TObject);
//更新字段信息
begin
 ComboBox2Change(Self);
end;

function TForm1.GetFieldNames : string;
//取得字段信息
const
 FIELD = '"%s".%s';
var
 I : Integer;
begin
 result := '';
 for I := 0 to ValueListEditor1.Strings.Count - 1 do
   with ValueListEditor1.Strings do
     if( Names[I] <> '' ) then
     begin
       result := result + Format( FIELD, [ComboBox2.Text, Names[I]] );
       if( I < Count - 1 ) then
         result := result + ', ';
     end;
end;

procedure TForm1.GetFieldsAndValuesForInsert( var FieldList, ValueList : String );
//取得插入的字段的信息
var
 I : Integer;
begin
 for I := 0 to ValueListEditor1.Strings.Count - 1 do
   with ValueListEditor1.Strings do
     if( Values[Names[I]] <> '' ) then
     begin
       FieldList := FieldList + Names[I];
       ValueList := ValueList + Values[Names[I]];

       if( I < Count - 1 ) and ( Values[Names[I+1]] <> '' )then
       begin
         FieldList := FieldList + ', ';
         ValueList := ValueList + ', ';
       end;
     end;
end;

function TForm1.GetNameAndValuePairs( const Delim : string = ', ' ) : string;
var
 I : Integer;
begin
 result := '';
 for I := 0 to ValueListEditor1.Strings.Count - 1 do
   with ValueListEditor1.Strings do
     if( Values[ Names[I] ] <> '' ) then
     begin
       result := result + Strings[I];
       if( I < Count - 1 ) and ( Values[Names[I+1]] <> '' ) then
         result := result + Delim;
     end;
end;

procedure TForm1.ValueListEditor1StringsChange(Sender: TObject);
//生成SQL查询
begin
 CreateSQL( Memo1.Lines );
end;

procedure TForm1.RunSQL1Click(Sender: TObject);
//执行SQL查询
begin
 RunSQL;
end;

procedure TForm1.Open1Click(Sender: TObject);
//打开SQL语句
begin
 if( SaveDialog1.InitialDir <> '' ) then
   OpenDialog1.InitialDir := SaveDialog1.InitialDir;

 if( OpenDialog1.Execute ) then
   Memo1.Lines.LoadFromFile( OpenDialog1.FileName );  
end;

end.