?? main.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -