main.pas

在SQLSERVER数据库查找任一表中的任意数据

Unit Main;

Interface

Uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AutoGrpBox, Buttons, ExtCtrls, AutoPnl,
  CheckLst, DB, ADODB, ComCtrls, Clipbrd, cxControls, cxContainer, cxEdit,
  cxTextEdit;

Type
  TFrmMain = Class(TForm)
    Grp1: TAutoGrpBox;
    Label1: TLabel;
    SetBtn: TSpeedButton;
    Grp2: TAutoGrpBox;
    Label2: TLabel;
    SeeBtn: TSpeedButton;
    LinkBtn: TSpeedButton;
    Pnl1: TAutoPanel;
    MsgPnl: TAutoPanel;
    ListGrp: TAutoGrpBox;
    ChkTblList: TCheckListBox;
    AutoGrpBox4: TAutoGrpBox;
    Memo1: TMemo;
    ADOC: TADOConnection;
    Lbl3: TLabel;
    Msg3: TLabel;
    Lbl1: TLabel;
    Lbl2: TLabel;
    Bar1: TProgressBar;
    Bar2: TProgressBar;
    Bevel1: TBevel;
    StopBtn: TSpeedButton;
    ListBox1: TListBox;
    SBar1: TStatusBar;
    LinkBox: TcxTextEdit;
    TxtBox: TcxTextEdit;
    Procedure LinkBtnClick(Sender: TObject);
    Procedure ADOCBeforeConnect(Sender: TObject);
    Procedure ADOCAfterConnect(Sender: TObject);
    Procedure ADOCAfterDisconnect(Sender: TObject);
    Procedure ADOCConnectComplete(Connection: TADOConnection;
      Const Error: Error; Var EventStatus: TEventStatus);
    Procedure FormShow(Sender: TObject);
    Procedure FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
    Procedure SeeBtnClick(Sender: TObject);
    procedure SetBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure TxtBoxPropertiesValidate(Sender: TObject;
      var DisplayValue: Variant; var ErrorText: TCaption;
      var Error: Boolean);
    procedure TxtBoxPropertiesChange(Sender: TObject);
  Private
    { Private declarations }
    FQry, QryF: TAdoQuery;
    isExiting: Boolean;
    TblCnt: Integer;
    ConnStr: String;
    MustStop:Boolean;

    Procedure FreshTblList; //刷新数据库中用户表列表

    Procedure ShowMsgV(Typ {类型}: Integer); //显示MsgPnl
    Procedure ShowMsg(Msg: String = ''; Pos1: Integer = -1; Pos2: Integer = -1);
    Procedure HideMsg; //隐藏MsgPnl

    Function GetConnStr: Boolean; //获取连接设置
    Procedure SplitStr(S: String);

    Procedure FindText(Txt: String);
    Function ChkTbl(Tbl, Txt: String): Boolean;
  Public
    { Public declarations }
  End;

Var
  FrmMain: TFrmMain;

Implementation

Uses Set_Color, MyPublic, DataView;

{$R *.dfm}

Function TFrmMain.GetConnStr: Boolean; //获取连接设置
Var
  Cs: String;
  Ts: TStrings;
Begin
  Cs := 'Persist Security Info=True;';
  Cs := Cs + 'Provider=' + 'SQLOLEDB.1' + ';'; //数据库种类
  Cs := Cs + 'Password=;'; //密码
  Cs := Cs + 'User ID=SA;'; //操作员
  Cs := Cs + 'Initial Catalog=;'; //数据库名
  Cs := Cs + 'Data Source='; //服务器名称
  If ConnStr = '' Then ConnStr := Cs;
  Cs := ConnStr;
  ConnStr := trim(PromptDataSource(Handle, CS));
  If Trim(UpperCase(ConnStr)) = Trim(UpperCase(Cs)) Then Begin
    Result := False;
    LinkBtn.Enabled := True;
    sBar1.Panels[6].Text := '没有连接配置!';
  End
  Else Begin
    Result := True;
    sBar1.Panels[6].Text := '您已经改变了连接设置...';
    Cs := ConnStr;
    //    If GetConnKeyValue(Connstr,'Password')<>'' Then
    Cs := EnCode(ConnStr);
    Ts := TStringList.Create;
    Ts.Text := Cs;
    Ts.SaveToFile('Connect.Dll');
    Ts.Free;
  End;
  SplitStr(ConnStr);
End;

Procedure TFrmMain.SplitStr(S: String);
Var
  SvName, DBMan, Pass, DBName: String; //DbCate,

  Function GetKey(Sou: String; Sub: String): String;
  Var
    i, At: Integer;
    bg: Boolean;
    Us, Key: String;
  Begin
    Us := UpperCase(Sou);
    Bg := False;
    At := Pos(UpperCase(Sub), Us);
    Key := '';
    If at > 0 Then Begin
      For i := At To Length(sou) Do Begin
        If Sou[i] = '=' Then Begin
          Bg := True;
          Continue;
        End;
        If Sou[i] = ';' Then Break;
        If Bg Then Key := Key + Sou[i];
      End;
      Key := Trim(Key);
    End;
    Result := Key;
  End;
Begin
  If Trim(s) = '' Then Exit;
  SvName := GetKey(s, 'Data Source'); //检查服务器名称
  //  DbCate:=GetKey(s,'Provider');           //检查数据种类
  DbMan := GetKey(s, 'User ID'); //检查管理员名称
  Pass := GetKey(s, 'Password'); //检查数据库密码
  DbName := GetKey(s, 'Initial Catalog'); //检查数据库名称
  sBar1.Panels[1].Text := SvName;
  sBar1.Panels[2].Text := DBMan;
  sBar1.Panels[4].Text := DBName;
  sBar1.Panels[3].Text := '******';

End;


Procedure TFrmMain.ShowMsgV(Typ {类型}: Integer); //显示MsgPnl
Begin
  MsgPnl.Visible := True;
  MsgPnl.BringToFront;
  Lbl1.Visible := True;
  Bar1.Visible := True;
  Lbl2.Visible := Typ > 1;
  Bar2.Visible := Typ > 1;
  MsgPnl.Left := (Width - MsgPnl.Width) Div 2;
  MsgPnl.Top := (Height - MsgPnl.Height) Div 2;
  Application.ProcessMessages;
End;

Procedure TFrmMain.ShowMsg(Msg: String = ''; Pos1: Integer = -1; Pos2: Integer = -1);
Begin
  If Msg <> '' Then
    Msg3.Caption := Msg;
  If Pos1 <> -1 Then
    Bar1.Position := Pos1;
  If Pos2 <> -1 Then
    Bar2.Position := Pos2;
  Application.ProcessMessages;
End;

Procedure TFrmMain.HideMsg; //隐藏MsgPnl
Begin
  MsgPnl.Visible := False;
  MsgPnl.SendToBack;
  Application.ProcessMessages;
End;

Procedure TFrmMain.FreshTblList; //刷新数据库中用户表列表
Var
  Qry: TAdoQuery;
  sName: String;
Begin
  ShowMsgV(1); //显示MsgPnl
  Bar1.Position := 0;
  Application.ProcessMessages;
  SleepEx(10, False);
  Qry := TAdoQuery.Create(Self);
  ChkTblList.Items.BeginUpdate;
  TblCnt := 0;
  Try
    ChkTblList.Items.Clear;
    With Qry Do Begin
      Connection := ADOC;
      SQL.Text := 'select name from dbo.sysobjects';
      SQL.Add('where OBJECTPROPERTY(id, N''IsUserTable'') = 1');
      SQL.Add('order by name');
      Open;
      Bar1.Max := RecordCount;
      First;
      While Not Eof Do Begin
        Inc(TblCnt);
        Bar1.Position := TblCnt;
        Application.ProcessMessages;
        sName := Trim(FieldByName('Name').AsString);
        ChkTblList.Items.Add(sName);
        Next;
      End;
      Close;
    End;
  Finally
    HideMsg; //隐藏MsgPnl
    ListGrp.Caption := '数据表列表 (' + InttoStr(Tblcnt) + ')';
    ChkTblList.Items.EndUpdate;
    Qry.Free;
  End;

End;

Procedure TFrmMain.LinkBtnClick(Sender: TObject);
Begin
  Adoc.Open;
  FreshTblList; //刷新数据库中用户表列表
End;

Procedure TFrmMain.ADOCBeforeConnect(Sender: TObject);
Begin
  Msg3.Caption := '正在连接数据库,请等待...';
  Application.ProcessMessages;
End;

Procedure TFrmMain.ADOCAfterConnect(Sender: TObject);
Begin
  SetColor(Grp2, True);
  SetColor(Pnl1, True);
  SeeBtn.Enabled := (Length(Trim(TxtBox.Text))>0) And Adoc.Connected;
  Msg3.Caption := '连接成功.';
  Application.ProcessMessages;
End;

Procedure TFrmMain.ADOCAfterDisconnect(Sender: TObject);
Begin
  If isExiting Then Exit;
  SetColor(Grp2, False);
  SetColor(Pnl1, False);
End;

Procedure TFrmMain.ADOCConnectComplete(Connection: TADOConnection;
  Const Error: Error; Var EventStatus: TEventStatus);
Begin
  If isExiting Then Exit;
  SetColor(Grp2, Connection.Connected);
  SetColor(Pnl1, Connection.Connected);
  SeeBtn.Enabled := (Length(Trim(TxtBox.Text))>0) And Adoc.Connected;
End;

Procedure TFrmMain.FormShow(Sender: TObject);
Begin
  SetColor(Grp2, False);
  SetColor(Pnl1, False);
  ListBox1.Clear;
  ListBox1.Visible := False;
  Memo1.Visible := True;
  Memo1.Align := alClient;
  If FileExists('TxtBox.His') Then
    TxtBox.Properties.LookupItems.LoadFromFile('TxtBox.His');
End;

Procedure TFrmMain.FormCloseQuery(Sender: TObject; Var CanClose: Boolean);
Begin
  isExiting := True;
End;

Function TFrmMain.ChkTbl(Tbl, Txt: String): Boolean;
Var
  Find: Boolean;
  Idx: Integer;
  Fld: String;
Begin
  Bar2.Position := 0;
  ShowMsg('检索:[' + Tbl + ']');
  Result := False;
  Find := False;
  If FQry.Active Then FQry.Close;
  If QryF.Active Then QryF.Close;
  FQry.SQL.Text := 'Select Top 0 * From ' + Tbl;
  Try
    FQry.Open;
    Bar2.Max := FQry.FieldCount;
    Application.ProcessMessages;
    For Idx := 0 To FQry.FieldCount - 1 Do Begin
      If MustStop Then Break;
      Fld := FQry.Fields[Idx].FullName;
      ShowMsg('检索:[' + Tbl + '] --->' + Fld, -1, Idx);
      If FQry.Fields[Idx].DataType In
        [ftString, ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency,
        ftBCD, ftDate, ftTime, ftDateTime, ftMemo, ftFmtMemo] Then Begin
        If QryF.Active Then QryF.Close;
        QryF.SQL.Clear;
        Case FQry.Fields[Idx].DataType Of
          ftString: Begin
              QryF.SQL.Text := 'Select Count(' + Fld + ') As Cnt From ' + Tbl;
              QryF.SQL.Add('Where ' + Fld + ' Like ''%' + Txt + '%''');
            End;
          ftMemo, ftFmtMemo: Begin
              QryF.SQL.Text := 'Select Count(*) As Cnt From ' + Tbl;
              QryF.SQL.Add('Where PATINDEX(''%' + Txt + '%'',' + Fld + ')>0');
            End;
          Else Begin
              QryF.SQL.Text := 'Select Count(' + Fld + ') As Cnt From ' + Tbl;
              QryF.SQL.Add('Where Cast(' + Fld + ' As VarChar(2000)) Like ''%' + Txt + '%''');
            End;
        End;
        Try
          QryF.Open;
          If QryF.FieldByName('Cnt').AsInteger > 0 Then Begin
            ListBox1.Items.Add(Tbl + '  --->   ' + Fld);
            Find := True;
            Break;
            If QryF.Active Then QryF.Close;
          End;
        Except
          Clipboard.AsText := QryF.SQL.Text;
          If QryF.Active Then QryF.Close;
        End;
      End;
    End;
    Result := Find;
  Except

  End;

End;

Procedure TFrmMain.FindText(Txt: String);
Var
  OnlyChk: Boolean; //是否仅仅检查选择的表
  Tbl: String;
  Idx: Integer;
Begin
  Bar1.Position := 0;
  Bar1.Position := 0;
  Bar1.Max := TblCnt;
  ShowMsgV(2);
  FQry := TAdoQuery.Create(Self);
  QryF := TAdoQuery.Create(Self);
  FQry.Connection := ADoc;
  QryF.Connection := ADoc;
  Memo1.Visible := False;
  Memo1.Align := alNone;
  ListBox1.Visible := True;
  ListBox1.Align := alClient;
  ListBox1.Items.Clear;
  Application.ProcessMessages;
  Try
    OnlyChk := False;
    For Idx := 0 To ChkTblList.Items.Count - 1 Do Begin
      If ChkTblList.Checked[Idx] Then Begin
        OnlyChk := True;
        Break;
      End;
    End;
    For Idx := 0 To ChkTblList.Items.Count - 1 Do Begin
      If MustStop Then Break;
      Tbl := ChkTblList.Items[Idx];
      If OnlyChk And (ChkTblList.Checked[Idx] = False) Then Begin
        ShowMsg('检索:' + Tbl, Idx);
        Continue;
      End;
      ShowMsg('检索:' + Tbl, Idx);
      ChkTbl(Tbl, Txt);
    End;
  Finally
    HideMsg; //隐藏MsgPnl
    FQry.Free;
    QryF.Free;
    ShowMessage('检索完毕!包含内容的表有' + Inttostr(ListBox1.Count) + '个');
  End;
End;

Procedure TFrmMain.SeeBtnClick(Sender: TObject);
Begin
  MustStop:=False;
  FindText(TxtBox.Text);
End;

procedure TFrmMain.SetBtnClick(Sender: TObject);
begin
  If GetConnStr then Begin //获取连接设置
    LinkBtn.Enabled := True ;
    LinkBox.Text := ConnStr ;
    If Adoc.Connected Then Adoc.Close ;
    Adoc.ConnectionString := ConnStr ;
  End;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
Var
  ts: TStrings;
  ConfigFile:String;
Begin
  //CoInitialize(Nil);
  If ADOC.Connected Then
    AdoC.Close;
  ConfigFile := 'Connect.Dll';
  ConnStr := '';
  If FileExists(ConfigFile) Then Begin
    ts := TStringList.Create;
    ts.LoadFromFile(ConfigFile);
    Connstr := ts.Text;
    Ts.Free;
    Connstr := Decode(Connstr);
  End;
  LinkBox.Text := Connstr;
  Adoc.ConnectionString := ConnStr;
  SplitStr(ConnStr);
  If ConnStr = '' Then Begin
    LinkBtn.Enabled := False;
  End;
end;

procedure TFrmMain.StopBtnClick(Sender: TObject);
begin
  If MessageDlg('您确实想终止搜索吗?',MtWarning,[MbYes,MbCancel],0)=MrYes Then Begin
    MustStop:=True;
  End;
end;

procedure TFrmMain.ListBox1DblClick(Sender: TObject);
Var
  Txt,LkTxt:String;
begin
  If ListBox1.ItemIndex=-1 Then Exit;
  Txt:=ListBox1.Items[ListBox1.ItemIndex];
  LkTxt:=Trim(TxtBox.Text);
  ViewData(Txt,LkTxt); 
end;

procedure TFrmMain.TxtBoxPropertiesValidate(Sender: TObject;
  var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
Var
  ss:String;
begin
  If VarType(DisplayValue)=VarNull Then Exit;
  ss:=VarAsType(DisplayValue,VarString);
  SeeBtn.Enabled := (Length(Trim(ss))>0) And Adoc.Connected;
  If ss='' Then Exit;
  If TxtBox.Properties.LookupItems.IndexOf(ss)=-1 Then
    TxtBox.Properties.LookupItems.Add(ss);
  TxtBox.Properties.LookupItems.SaveToFile('TxtBox.His');

end;

procedure TFrmMain.TxtBoxPropertiesChange(Sender: TObject);
begin
  SeeBtn.Enabled := (Length(Trim(TxtBox.Text))>0) And Adoc.Connected;
end;

End.