unttablefield.pas

用delphi编写的数据库管理软件

unit untTableField;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Base_S, Grids, DBGridEh, ExtCtrls, StdCtrls, DB, ADODB, ActnList;

type
  TfrmTableField = class(TfrmBase_S)
    Panel2: TPanel;
    Panel3: TPanel;
    GridTable: TDBGridEh;
    buttonOk: TButton;
    TableName: TLabel;
    Panel1: TPanel;
    buttonnewly: TButton;
    Button3: TButton;
    Baseinfo: TADOQuery;
    DSBaseinfo: TDataSource;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    ActionList1: TActionList;
    acAdd: TAction;
    adEdit: TAction;
    acDelete: TAction;
    acSave: TAction;
    acCancel: TAction;
    acExit: TAction;
    Baseinfofid: TAutoIncField;
    BaseinfoftableName: TWideStringField;
    Baseinfofname: TWideStringField;
    Baseinfoftype: TWideStringField;
    Baseinfoflength: TIntegerField;
    Baseinfofisnullable: TBooleanField;
    Baseinfofdesc: TWideStringField;
    Baseinfofisvisible: TBooleanField;
    Label1: TLabel;
    acok: TAction;
    acnewly: TAction;
    edit1: TComboBox;
    edit2: TComboBox;
    TableRecombine: TAction;
    Button1: TButton;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure GridTableGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure GridTableKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DSBaseinfoStateChange(Sender: TObject);
    procedure DSBaseinfoDataChange(Sender: TObject; Field: TField);
    procedure acExitExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure acokExecute(Sender: TObject);
    procedure acnewlyExecute(Sender: TObject);
    procedure edit2Change(Sender: TObject);
    procedure acAddExecute(Sender: TObject);
    procedure adEditExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acSaveExecute(Sender: TObject);
    procedure acCancelExecute(Sender: TObject);
    procedure BaseinfoBeforePost(DataSet: TDataSet);
    procedure GridTableTitleClick(Column: TColumnEh);
    procedure TableRecombineExecute(Sender: TObject);
  private
    sortBoolean:Boolean;
    function CheckSave :Boolean;
    procedure SaveAll;
    procedure newload;
    procedure GetTableName;
    procedure GetDBName;
    procedure SetFieldReadonly;
    procedure SetfieldEnalabel;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmTableField: TfrmTableField;

implementation

uses untDmServer;

{$R *.dfm}

procedure TfrmTableField.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  frmTableField:=nil;
end;

procedure TfrmTableField.GridTableGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if gridTable.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED
    else
    BackGround:=clWhite;
end;

procedure TfrmTableField.GridTableKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if (key=VK_DOWN) or (key=VK_TAB) then
    begin
      (sender as TDBGridEh).DataSource.DataSet.Next;
      key:=0;
    end;
end;

function TfrmTableField.CheckSave: Boolean;
begin
Result:=true;
if Baseinfo.State in [dsEdit] then
   Case Messagedlg('要保存当前修改吗 ？ ',mtWarning,[mbYes,mbNo,mbCancel],0) of
   mrYes:
     begin
     SaveAll;
     Result := Baseinfo.State = dsBrowse;
     end;
   mrNo:
     begin
     Baseinfo.Cancel;
     Result := BaseInfo.State = dsBrowse;
     end;
   mrCancel:
     Result := False ;
   End
end;

procedure TfrmTableField.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  CanClose:=CheckSave;
end;

procedure TfrmTableField.SaveAll;
begin
  if Baseinfo.State in [dsEdit,dsInsert] then
    Baseinfo.UpdateBatch(arAll);
  SetFieldReadonly;  
end;

procedure TfrmTableField.DSBaseinfoStateChange(Sender: TObject);
begin
  inherited;
  acSave.Enabled:=Baseinfo.State in [dsEdit,dsInsert];
  acAdd.Enabled:=not acSave.Enabled;

  adEdit.Enabled:=not acSave.Enabled;

  acDelete.Enabled:=not acSave.Enabled;

  acCancel.Enabled:=acSave.Enabled;
  acok.Enabled:=not acSave.Enabled;
  acnewly.Enabled:= not acsave.Enabled;
end;

procedure TfrmTableField.DSBaseinfoDataChange(Sender: TObject;
  Field: TField);
begin
  inherited;
  DSBaseinfoStateChange(self);
end;

procedure TfrmTableField.newload;
var
  tiaoStr:string;
  tiaoStr1:String;
  cmdStr:String;
  Qtemp:Tadoquery;
  Qtemp1:Tadoquery;
begin
  tiaoStr:=' id = OBJECT_ID('+Quotedstr(edit1.Text)+')';
  try
    Qtemp:=Tadoquery.Create(nil);
    Qtemp.Connection:=DmServer.AdoConMain;
    Qtemp.CacheSize:=1000;
    Qtemp.CursorType:=ctStatic;
    Qtemp.LockType:=ltBatchOptimistic;
    Qtemp1:=Tadoquery.Create(nil);
    Qtemp1.Connection:=DmServer.AdoConMain;
    Qtemp1.CacheSize:=1000;
    Qtemp1.CursorType:=ctStatic;
    Qtemp1.LockType:=ltBatchOptimistic;
    cmdStr:='';
    with Qtemp do
      begin
        close;
        sql.Clear;
        sql.Add(' use '+edit2.Text);
        sql.Add('Select * from '+edit2.Text+'..Syscolumns where '+tiaoStr+' order by name');
        open;
      end;
    if Qtemp.RecordCount > 0 then
    begin
      with Qtemp1 do
        begin
          close;
          sql.Clear;
          sql.Add(' use '+edit2.Text);
          sql.Add('Delete from '+edit2.Text+'..tTableField where fTablename='+Quotedstr(edit1.Text));
          Execsql;
        end;

      Qtemp.First;
      while not Qtemp.Eof do
        begin
          tiaoStr1:=' xusertype='+quotedstr(inttostr(Qtemp.fieldbyname('xtype').AsInteger));
          with Qtemp1 do
            begin
              close;
              sql.Clear;
              sql.Add(' use '+edit2.Text);
              sql.add('Select * from '+edit2.Text+'..Systypes where '+tiaoStr1+' order by name ');
              open;
            end;

          cmdStr:='insert into '+edit2.Text+'..tTableField(fTablename,fname,ftype,flength,fisnullable) values(';
          cmdStr:=cmdStr+quotedstr(edit1.Text)+',';
          cmdStr:=cmdStr+quotedstr(Qtemp.fieldbyname('name').AsString)+',';
          cmdStr:=cmdStr+quotedstr(Qtemp1.fieldbyname('name').AsString)+',';
          cmdStr:=cmdStr+quotedstr(inttostr(Qtemp.fieldbyname('prec').AsInteger))+',';
          cmdStr:=cmdStr+quotedstr(Qtemp.fieldbyname('isnullable').AsString)+')';
          with Qtemp1 do
            begin
              close;
              sql.Clear;
              sql.Add(' use '+edit2.Text);
              sql.Add(cmdStr);
              Execsql;
            end;
          cmdStr:='';
          tiaoStr1:='';
          Qtemp.Next;
        end;
        with Baseinfo do
          begin
            close;
            sql.Clear;
            sql.Add('Select * from '+edit2.Text+'..tTableField where fTableName='+quotedstr(edit1.Text)+' order by fName');
            open;
          end;
    end
    else
    begin
      messagedlg('Error Table Name ! ',mtError,[mbok],0);
      Exit;
    end;
  finally
    Qtemp.Close;
    Qtemp.Free;
    Qtemp1.Close;
    Qtemp1.Free;
  end;
end;

procedure TfrmTableField.acExitExecute(Sender: TObject);
begin
  inherited;
  Close;
end;

procedure TfrmTableField.FormShow(Sender: TObject);
begin
  inherited;
  edit2.SetFocus;
  GetDBName;
end;

procedure TfrmTableField.acokExecute(Sender: TObject);
begin
  inherited;
 if Trim(Edit1.Text)='' then
    begin
      messagedlg('Please enter Table Name ! ',mtWarning,[mbok],0);
      Exit;
    end;

  if Trim(Edit2.Text)='' then
    begin
      messagedlg('Please enter DataBase Name ! ',mtWarning,[mbok],0);
      Exit;
    end;

  Baseinfo.Close;
  Baseinfo.SQL.Clear;
  Baseinfo.sql.Text:='Select * from '+edit2.Text+'..Ttablefield where fTablename='+Quotedstr(Edit1.Text)+' order by fname';
  Baseinfo.open;

  if Baseinfo.RecordCount = 0 then
    begin
      messagedlg('The Table have not build ! ',mtWarning,[mbok],0);
      newload;
    end;
  SetFieldReadonly;  
end;

procedure TfrmTableField.acnewlyExecute(Sender: TObject);
begin
  inherited;
  if Trim(Edit1.Text)='' then
    begin
      messagedlg('Please enter Table Name ! ',mtWarning,[mbok],0);
      Exit;
    end;

  if Trim(Edit2.Text)='' then
    begin
      messagedlg('Please enter DataBase Name ! ',mtWarning,[mbok],0);
      Exit;
    end;

  if messagedlg('Are you affrim to restore ?',mtWarning,[mbok,mbcancel],0)=mrok then
    newLoad;
  SetFieldReadonly;    
end;

procedure TfrmTableField.GetTableName;
var
  ListTable:Tstrings;
  i:integer;
  ListAdo:TadoQuery;
begin
  try
    ListAdo:=Tadoquery.Create(nil);
    ListTable:=TstringList.Create;
    ListAdo.Connection:=DmServer.AdoConMain;
    ListAdo.CacheSize:=1000;
    ListAdo.CursorType:=ctStatic;
    ListAdo.LockType:=ltBatchOptimistic;
    with ListAdo do
      begin
        close;
        sql.Clear;
        sql.Text:='Use '+edit2.Text;
        Execsql;
      end;
    dmServer.AdoConMain.GetTableNames(ListTable,False);
    for i:=0 to ListTable.Count - 1 do
      begin
        edit1.Items.Add(ListTable[i]);
      end;
  finally
    ListAdo.Close;
    ListAdo.Free;  
    ListTable.Free;
  end;
end;

procedure TfrmTableField.GetDBName;
var
  DBado:Tadoquery;
  cmdStr:string;
begin
  try
    DBado:=Tadoquery.Create(nil);
    DBado.Connection:=DmServer.AdoConMain;
    DBado.CacheSize:=1000;
    DBado.CursorType:=ctStatic;
    DBado.LockType:=ltBatchOptimistic;
    cmdStr:='select Name from master..sysdatabases where name not in ('
        +quotedstr('master')+','+quotedstr('msdb')+','
        +quotedstr('model')+','+quotedstr('tempDB')+')';
    with DBAdo do
      begin
        close;
        sql.Clear;
        sql.Add(' use Master '); 
        sql.Add(cmdStr);
        open;
      end;
    if DBAdo.RecordCount > 0 then
      begin
        DBAdo.First;
        while not DBAdo.Eof do
          begin
            edit2.Items.Add(DBAdo.fieldbyname('name').AsString);
            DBAdo.Next;
          end;
      end;
  finally
    DBado.Close;
    DBado.Free;
  end;
end;

procedure TfrmTableField.edit2Change(Sender: TObject);
begin
  inherited;
  GetTableName;
end;

procedure TfrmTableField.acAddExecute(Sender: TObject);
begin
  inherited;
  if Baseinfo.Active then
    Baseinfo.Append;
  SetFieldEnalabel;
end;

procedure TfrmTableField.adEditExecute(Sender: TObject);
begin
  inherited;
  if Baseinfo.Active then
    begin
      SetfieldEnalabel;
      if Baseinfo.RecordCount > 0 then
        Baseinfo.Edit;
    end;
end;

procedure TfrmTableField.acDeleteExecute(Sender: TObject);
begin
  inherited;
  if Baseinfo.Active then
    begin
      if Baseinfo.RecordCount > 0 then
        Baseinfo.Delete;
        Baseinfo.UpdateBatch(arAll);
    end;
end;

procedure TfrmTableField.acSaveExecute(Sender: TObject);
begin
  inherited;
  saveall;
end;

procedure TfrmTableField.acCancelExecute(Sender: TObject);
begin
  inherited;
  if Baseinfo.State in [dsInsert,dsEdit] then
    Baseinfo.Cancel;
  SetFieldReadonly;  
end;

procedure TfrmTableField.SetfieldEnalabel;
begin
  GridTable.ReadOnly:=False;
  Baseinfo.FieldByName('fname').ReadOnly:=False;
  Baseinfo.FieldByName('ftype').ReadOnly:=False;
  Baseinfo.FieldByName('flength').ReadOnly:=False;
  Baseinfo.FieldByName('fisnullable').ReadOnly:=False;
  Baseinfo.FieldByName('fdesc').ReadOnly:=False;
  Baseinfo.FieldByName('fisvisible').ReadOnly:=False;
end;

procedure TfrmTableField.SetFieldReadonly;
begin
  Baseinfo.FieldByName('fname').ReadOnly:=True;
  Baseinfo.FieldByName('ftype').ReadOnly:=True;
  Baseinfo.FieldByName('flength').ReadOnly:=True;
  Baseinfo.FieldByName('fisnullable').ReadOnly:=True;
  Baseinfo.FieldByName('fdesc').ReadOnly:=False;
  Baseinfo.FieldByName('fisvisible').ReadOnly:=False;
end;

procedure TfrmTableField.BaseinfoBeforePost(DataSet: TDataSet);
begin
  inherited;
  Baseinfo.FieldByName('fTableName').AsString:=Trim(Edit1.Text);
  Baseinfo.FieldByName('fIsVisible').AsBoolean:=True;  
end;

procedure TfrmTableField.GridTableTitleClick(Column: TColumnEh);
var
  sortstring: string;
begin
  inherited;
  with Column do
  begin

    if FieldName = '' then
      Exit;

    if sortBoolean then
      begin
        Title.SortMarker := smDownEh;
        SortBoolean:=False;
      end
      else
      begin
        Title.SortMarker := smUpEh;
        SortBoolean:=True;
      end;

    case Title.SortMarker of
      smNoneEh:
        begin
          Title.SortMarker := smDownEh;
          sortstring := Column.FieldName + ' DESC';
        end;
      smDownEh: sortstring := Column.FieldName + ' ASC';
      smUpEh: sortstring := Column.FieldName + ' DESC';
    end; //数据集排序。
    try
      Baseinfo.Sort:=SortString;
    except
    end;
  end;
end;

procedure TfrmTableField.TableRecombineExecute(Sender: TObject);
var
  RecomAdo:Tadoquery;
  i:integer;
  cmdStr:string;
begin
  inherited;
  cmdStr:='';
  if messagedlg('Are you sure continue? The operation will clear all data!',mtConfirmation,[mbok,mbcancel],0)=mrcancel then
    begin
      exit;
    end;
  if edit1.Items.Count = 0 then
    begin
      messagedlg('The Table is null ! ',mtWarning,[mbok],0);
      Exit;
    end;

  try
    RecomAdo:=Tadoquery.Create(nil);
    RecomAdo.Connection:=DmServer.AdoConMain;
    RecomAdo.CacheSize:=1000;
    RecomAdo.CursorType:=ctStatic;
    RecomAdo.LockType:=ltBatchOptimistic;
    for i:=0 to edit1.Items.Count-1 do
      begin
      screen.Cursor:=crSqlWait;
       if (uppercase(edit1.Items[i])=uppercase('tfunction')) or
           (uppercase(edit1.Items[i])=uppercase('ttablefield')) or
           (uppercase(edit1.Items[i])=uppercase('tbilltype')) or
           (uppercase(edit1.Items[i])=uppercase('tformprint')) or
           (uppercase(edit1.Items[i])=uppercase('tmodule')) or
           (uppercase(copy(edit1.Items[i],1,1))='V') then
        cmdStr:=' '
        else
        cmdStr:='Delete from '+edit1.Items[i];
        try
        with RecomAdo do
          begin
            close;
            sql.Clear;
            sql.Text:=cmdStr;
            Execsql;
          end;
          screen.Cursor:=crDefault;  
        except
        on E:exception do
          begin
            messagedlg('Faile :'+E.Message,mtError,[mbok],0);
            Abort;
          end;
        end;
        cmdStr:='';
      end;
      screen.Cursor:=crDefault;
  finally
    RecomAdo.Close;
    RecomAdo.Free;
    screen.Cursor:=crDefault;
  end;
end;

end.