ufrmview.pas

数据库通用工具

unit UfrmView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls, Grids, DBGrids, Buttons, CheckLst,
  ExtCtrls,IniFiles, Menus, cxShellDlgs, Excel2000, OleServer,
  cxShellBrowserDialog, ADODB, dxCntner, dxEditor, dxExEdtr, dxEdLib,
  DBCtrls;

const
  conn='Provider=SQLOLEDB.1;Persist Security Info=True;Data Source=%s;Initial Catalog=%s;User ID=%s;Password=%s';

type
  TfrmView = class(TForm)
    Panel2: TPanel;
    Splitter1: TSplitter;
    ListBox1: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    bbtLink: TBitBtn;
    bbtDisl: TBitBtn;
    Panel3: TPanel;
    DBGrid1: TDBGrid;
    Panel4: TPanel;
    CheckBox1: TCheckBox;
    Panel5: TPanel;
    BitBtn1: TBitBtn;
    DataSource1: TDataSource;
    Database1: TDatabase;
    Query1: TQuery;
    BitBtn3: TBitBtn;
    ExcelWorkbook1: TExcelWorkbook;
    ExcelApplication1: TExcelApplication;
    ExcelWorksheet1: TExcelWorksheet;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    cxShellBrowserDialog1: TcxShellBrowserDialog;
    bbtRead: TBitBtn;
    mo: TMemo;
    CheckBox2: TCheckBox;
    O1: TMenuItem;
    Panel6: TPanel;
    Splitter2: TSplitter;
    mo2: TMemo;
    SaveDialog1: TSaveDialog;
    bbtHF: TBitBtn;
    CheckBox3: TCheckBox;
    Splitter3: TSplitter;
    Panel7: TPanel;
    bbtQry: TBitBtn;
    bbtBack: TBitBtn;
    bbtCopy: TBitBtn;
    BitBtn2: TBitBtn;
    Database2: TDatabase;
    Query2: TQuery;
    bbtAdd: TBitBtn;
    bbtEdit: TBitBtn;
    Splitter4: TSplitter;
    bbtDel: TBitBtn;
    CheckBox4: TCheckBox;
    Timer1: TTimer;
    labMSG: TLabel;
    BitBtn4: TBitBtn;
    cmbList: TComboBox;
    BitBtn5: TBitBtn;
    adoQry: TADOQuery;
    cbxZD: TComboBox;
    cbxNR: TComboBox;
    Query3: TQuery;
    dxcSL: TdxCurrencyEdit;
    PopupMenu2: TPopupMenu;
    N3: TMenuItem;
    Panel8: TPanel;
    CheckListBox1: TCheckListBox;
    Panel9: TPanel;
    Panel10: TPanel;
    Panel11: TPanel;
    BitBtn6: TBitBtn;
    Query4: TQuery;
    DataSource2: TDataSource;
    DBGrid2: TDBGrid;
    labTBCap: TLabel;
    CheckBox5: TCheckBox;
    DBMemo1: TDBMemo;
    CheckBox6: TCheckBox;
    OpenDialog1: TOpenDialog;
    SaveDialog2: TSaveDialog;
    BitBtn7: TBitBtn;
    BitBtn8: TBitBtn;
    qryPub: TQuery;
    btnSS: TBitBtn;
    procedure bbtLinkClick(Sender: TObject);
    procedure Database1AfterConnect(Sender: TObject);
    procedure Database1AfterDisconnect(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure bbtDislClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ListBox1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    function GetFilePathName(sTableName:string):string;
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure bbtReadClick(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure O1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure bbtQryClick(Sender: TObject);
    procedure bbtBackClick(Sender: TObject);
    procedure bbtHFClick(Sender: TObject);
    procedure mo2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure bbtCopyClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BitBtn2Click(Sender: TObject);
    procedure SetConnStr;
    procedure DataBaseList;
    procedure BitBtn4Click(Sender: TObject);
    procedure cmbListChange(Sender: TObject);
    procedure bbtAddClick(Sender: TObject);
    procedure bbtEditClick(Sender: TObject);
    procedure bbtDelClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    function GetRandomPersonInfo( iType,iNum :integer ):string;
    function getRandomPersonInfo2( ):string;
    procedure BitBtn5Click(Sender: TObject);
    function listRandomPersonInfo( iType:integer ):Integer;
    procedure cbxNRChange(Sender: TObject);
    procedure N3Click(Sender: TObject);
    function getExcelType( sDPName : string ) : string;
    procedure ListBox1DblClick(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure listField( sTableName: string; bAutoWidth: Boolean=True );
    procedure Panel11MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure CheckBox6Click(Sender: TObject);
    procedure cbxZDChange(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure BitBtn8Click(Sender: TObject);
    procedure btnSSClick(Sender: TObject);

  private
    { Private declarations }
    path:string;
    ini:TIniFile;
    sServer,sDatabase,sUser,sPass:string;
    ConnStr:string;
  public
    { Public declarations }
  end;

var
  frmView: TfrmView;

implementation

uses Udbm, UfrmDBList;

{$R *.dfm}

procedure TfrmView.bbtLinkClick(Sender: TObject);
var
  slt:TStringList;
  i,j:integer;
  ss,sb:string;
begin

  try
    Database1.Connected := false;
    Database1.Params.Clear();
    Database1.Params.Values['SERVER NAME']  := Edit1.Text;
    Database1.Params.Values['DATABASE NAME']:= Edit2.Text;
    Database1.Params.Values['USER NAME']    := Edit3.Text;
    Database1.Params.Values['PASSWORD']     := Edit4.Text;//BLOB SIZE:=32
//    Database1.Params.Values['BLOB SIZE']    := '10240';//=5M
    Database1.Params.Values['BLOB SIZE']    := IntToStr( 1024*8 );
    Database1.Connected := true;
        
  except
    exit;
  end;

  if Database1.Connected = true then
  begin
    slt := TStringList.Create();
    //Database1.Session.GetTableNames(Database1.DatabaseName,'',False,False,slt);//A
    Database1.GetTableNames(slt,false);//B
    {
    Session1.GetTableNames(Database1.DatabaseName,'',False,False,slt);
    CheckListBox1.Items := slt;
    ListBox1.Items := slt;
    //}
    
    {查存数据库表对象的语句
    select * from sysobjects
    where xtype='U'
    order by xtype,name
    }
    //排序
    for i := 0 to slt.Count-2 do
    begin
      ss := slt.Strings[i];
      for j := i to slt.Count-1 do
      begin
        sb := slt.Strings[j];
        if LowerCase(sb) < LowerCase(ss) then
        begin
          ss := slt.Strings[j];
          slt.Strings[j] := slt.Strings[i];
          slt.Strings[i] := ss;
        end;

      end;

    end;
    
    for i := 0 to slt.Count-1 do
    begin
      ss := slt.Strings[i];
      ss := copy(ss,5,length(ss)-4);
      listbox1.Items.Add( ss ); 
    end;

    slt.Free;
    
  end;
  //}

end;

procedure TfrmView.Database1AfterConnect(Sender: TObject);
begin
  bbtLink.Enabled := false;
  bbtDisl.Enabled := true;
  ListBox1.SetFocus;
  Edit1.Enabled := false;
  Edit2.Enabled := false;
  Edit3.Enabled := false;
  Edit4.Enabled := false;
  btnSS.Enabled := bbtDisl.Enabled;
end;

procedure TfrmView.Database1AfterDisconnect(Sender: TObject);
begin
  bbtLink.Enabled := true;
  bbtDisl.Enabled := false;
  Query1.Close;
  ListBox1.Items.Clear;
  CheckListBox1.Items.Clear;
  Edit1.Enabled := true;
  Edit2.Enabled := true;
  Edit3.Enabled := true;
  Edit4.Enabled := true;
  btnSS.Enabled := bbtDisl.Enabled;
end;

procedure TfrmView.FormShow(Sender: TObject);
begin
  Database1.Connected := false;
  path:=ExtractFilePath(application.ExeName);
  ini:=TIniFile.Create(path+'config.may');
  {
  Edit1.Text := ini.ReadString('System',  'Server', 'why-08');
  Edit2.Text := ini.ReadString('System',  'Database', 'newhis');
  Edit3.Text := ini.ReadString('System',  'user', 'sa');
  Edit4.Text := ini.ReadString('System',  'pass', 'sa');
  //}
  sServer := ini.ReadString('System',  'Server', '127.0.0.1');
  sDatabase := ini.ReadString('System',  'Database', 'master');
  sUser := ini.ReadString('System',  'user', 'sa');
  sPass := ini.ReadString('System',  'pass', 'sa');

  Edit1.Text := sServer;
  Edit2.Text := sDatabase;
  Edit3.Text := sUser;
  Edit4.Text := sPass;

  mo.Align := alClient;
end;

procedure TfrmView.FormDestroy(Sender: TObject);
begin
  Database1.Connected := false;
  Database2.Connected := false;
  if CheckBox3.Checked then//退出时保存
  begin
    ini.WriteString('System',  'Server',  Edit1.Text );
    ini.WriteString('System',  'Database',Edit2.Text );
    ini.WriteString('System',  'user',    Edit3.Text );
    ini.WriteString('System',  'pass',    Edit4.Text );
  end;                                                 
  ini.Free;
end;

procedure TfrmView.bbtDislClick(Sender: TObject);
begin
  Database1.Connected := false;
end;

procedure TfrmView.BitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmView.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = vk_return then
    sendMessage(handle,wm_nextdlgctl,0,0);
end;

function getFieldType( sDPName : string ) : string;
begin
  sDPName := Trim(sDPName);
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := 'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := 'float';
  end
  else if sDPName='TCurrencyField' then
  begin
    Result := 'money';
  end
  else if sDPName='TDateTimeField' then
  begin
    Result := 'datetime';
  end
  else if sDPName='TBooleanField' then
  begin
    Result := 'bit';
  end
  else if sDPName='TBlobField' then
  begin
    Result := 'image';
  end
  else if sDPName='TAutoIncField' then
  begin
    Result := 'int (自增)';
  end
  else if sDPName='TSmallintField' then
  begin
    Result := 'smallint';
  end
  else if sDPName='TMemoField' then
  begin
    Result := 'text';
  end
  else
  begin
    Result := '--';
  end;

end;

procedure TfrmView.ListBox1Click(Sender: TObject);
var
  ss:string;
  i,a:integer;
begin

  if CheckBox1.Checked and Database1.Connected = true then
  begin

    ss := ListBox1.Items.Strings[ListBox1.ItemIndex];
    if pos('.',ss)<>0 then
    begin
      exit;
    end;
    //}
    if ListBox1.Hint = ss then
    begin
      exit;
    end;
    ListBox1.Hint := ss;

    ss := 'select * from '+ss;
    mo2.Text := ss;

    with Query1 do
    begin
      Close;
      SQL.Text := ss;
      try
        Open;
      except
        exit;
      end;

      labMSG.Caption := '记录数：'+IntToStr( Query1.RecordCount );
      Panel9.Caption := '字段数：'+IntToStr( Query1.FieldCount );
    end;

    //2006-12-12 add
    if Panel10.Visible then listField( ListBox1.Hint );
    
    a := DBGrid1.FieldCount;
    CheckListBox1.Items.Clear;
    cbxZD.Clear;
    mo2.Lines.Add( '/*' );
    for i := 0 to a-1 do
    begin
      ss := DBGrid1.Columns.Items[i].FieldName ;  
      cbxZD.Items.Add(ss);
      CheckListBox1.Items.Add( ss +' | '+getFieldType( DBGrid1.Columns.Items[i].Field.ClassName )
                                  +' 【'+IntToStr( DBGrid1.Columns.Items[i].Field.Size )+'】' );
      CheckListBox1.Checked[i] := true;
      //mo2.Lines.Add( ss+ ',' );
      if CheckBox4.Checked then//逗号前置 &Z
      begin
        if i>=1 then  
          ss := ','+ss;
      end
      else
      begin
        if i< a-1 then
          ss := ss+',';
      end;
      //ss := '<display:column sortable="true" class="center" title="'+ss+'"><c:out value="${vo.'+ss+'}"/></display:column>';
      //ss := '<tr><td class="td_tou">'+ss+'</td>'+#13#10+'<td class="td_default">&nbsp;'+#13#10+'<input class="input_text" size="20" type="text" name="'+ss+'" value="<c:out value=''${model.vo.'+ss+'}''/>"></td></tr>';
      mo2.Lines.Add( ss );
    end;
    mo2.Lines.Add( '*/' );

  end;
  cbxZD.ItemIndex := 0;

end;

function TfrmView.getExcelType( sDPName : string ) : string;
begin
  {
    Columns("B:B").Select
    Selection.NumberFormatLocal = "0.00_ "
    Range("B2").Select
    Selection.NumberFormatLocal = "G/通用格式"
    
    Range("B1").Select
    Selection.NumberFormatLocal = "0.00_ "
    Range("C1").Select
    Selection.NumberFormatLocal = "￥#,##0.00;￥-#,##0.00"
    Range("D1").Select
    Selection.NumberFormatLocal = "[DBNum1]yyyy""年""m""月""d""日"""
    Range("E1").Select
    Selection.NumberFormatLocal = "h:mm"
    Range("F1").Select
    Selection.NumberFormatLocal = "@"
    }
  sDPName := Trim(sDPName);
  Result := '';
  if sDPName='TIntegerField' then
  begin
    Result := 'G/通用格式';//'int';
  end
  else if sDPName='TStringField' then
  begin
    Result := '@';//'varchar';
  end
  else if sDPName='TFloatField' then
  begin
    Result := '0.00_ ';//'float';
  end