?? sqlqry.pas
字號:
FParseOnly := False;
end;
procedure TSqlQryFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
function TSqlQryFrm.GetDatabaseList: TStringList;
const
sel_db_sql = 'exec master.dbo.sp_MShasdbaccess';
var
Rst: _Recordset;
begin
Result := nil;
ExecuteSql('set showplan_text off');
ExecuteSql('set showplan_all off');
ExecuteSql('SET NOEXEC OFF SET PARSEONLY OFF SET ROWCOUNT 0');
Rst := ExecuteRst(sel_db_sql);
if Rst <> nil then
begin
Result := TStringList.Create;
while not Rst.EOF do
begin
Result.Add(Rst.Fields['dbname'].Value);
Rst.MoveNext;
end;
end;
end;
procedure TSqlQryFrm.OnGridResize(Sender: TObject);
var
H, I: Integer;
Ctrl: TControl;
begin
if PnlResult.ControlCount = 2 then Exit;
H := 0;
for I := PnlResult.ControlCount - 1 downto 0 do
begin
Ctrl := PnlResult.Controls[I];
Inc(H, Ctrl.Height);
end;
PnlResult.Height := H + 1000;
SbxResult.VertScrollBar.Range := H + 20;
SbxResult.VertScrollBar.Visible := SbxResult.ClientHeight < (H + 20);
end;
function TSqlQryFrm.ExecuteSql(const ASql: WideString): Integer;
var
Affected: OleVariant;
hr: HResult;
Rst: _Recordset;
begin
hr := (FConnection as ConnectionStd).Execute(ASql, Affected, adExecuteNoRecords, Rst);
if hr < 0 then
ProcessResults;
Result := Affected;
end;
function TSqlQryFrm.ExecuteRst(const ASql: WideString): _Recordset;
var
Affected: OleVariant;
hr: HResult;
begin
hr := (FConnection as ConnectionStd).Execute(ASql, Affected, -1, Result);
if hr < 0 then
ProcessResults;
end;
procedure TSqlQryFrm.Initialize(Conn: _Connection);
var
Rst: _Recordset;
begin
FConnection := Conn;
FDatabase := FConnection.DefaultDatabase;
Rst := ExecuteRst('select convert(sysname, serverproperty(N''servername''))');
if not VarIsNull(Rst.Fields[0].Value) then
FServerName := Rst.Fields[0].Value;
Rst := ExecuteRst('SELECT ISNULL(SUSER_SNAME(), SUSER_NAME())');
if not VarIsNull(Rst.Fields[0].Value) then
FSUserName := Rst.Fields[0].Value;
FFileName := Format('無標題%d', [NewFileCount]);
UpdateTitle;
Inc(NewFileCount);
FPnlRate := 0.5;
PnlMainResize(PnlMain);
Visible := True;
end;
procedure TSqlQryFrm.PnlMainResize(Sender: TObject);
begin
if FPnlRate = 0 then FPnlRate := 0.5;
Pgc1.Height := Round(PnlMain.Height * FPnlRate);
end;
procedure TSqlQryFrm.Splitter1Moved(Sender: TObject);
begin
FPnlRate := Pgc1.Height / PnlMain.Height;
end;
procedure TSqlQryFrm.FormActivate(Sender: TObject);
begin
PostMessage(Application.MainForm.Handle, WM_QRYFRMACTIVATE, 0, 0);
end;
function TSqlQryFrm.GetConnectionString: string;
begin
if FConnection <> nil then
Result := FConnection.ConnectionString
else
Result := '';
end;
procedure TSqlQryFrm.SetDatabase(const Value: string);
begin
try
ExecuteSql('set showplan_text off');
ExecuteSql('set showplan_all off');
ExecuteSql('SET NOEXEC OFF SET PARSEONLY OFF SET ROWCOUNT 0');
ExecuteSql(Format('use [%s]', [Value]));
except
Application.HandleException(Self);
Exit;
end;
FDatabase := Value;
UpdateTitle;
end;
procedure TSqlQryFrm.ProcessResults;
var
err_type: Integer;
Msg: string;
begin
err_type := ProcessResult(Msg);
if Msg <> '' then AddMsg(Msg);
FConnClosed := err_type = 3;
if err_type <> 0 then Abort;
end;
procedure TSqlQryFrm.AddMsg(Msg: string);
begin
MoMsg.Lines.Add(Msg);
end;
procedure TSqlQryFrm.AddMsgs(MsgList: TStringList);
begin
MoMsg.Lines.Assign(MsgList);
end;
procedure TSqlQryFrm.AddRecordsets(DataList: TList);
var
Grd: TDataGrid;
Split: TSplitter;
I: Integer;
begin
for I := 0 to DataList.Count-1 do
begin
Grd := TDataGrid.Create(Self);
Grd.Height := 120;
Grd.Top := 65535;
Grd.Align := alTop;
Grd.Parent := PnlResult;
Grd.Flat := True;
Grd.PopupMenu := GridMenu;
Grd.SetData(TRowDataList(DataList[I]));
Grd.OnResize := OnGridResize;
Split := TSplitter.Create(Self);
Split.Parent := PnlResult;
Split.Align := alTop;
Split.Height := 2;
Split.MinSize := 10;
Split.AutoSnap := False;
end;
end;
procedure TSqlQryFrm.ClearVarRef;
begin
FExecThread := nil;
end;
procedure TSqlQryFrm.OnThreadTerminate(Sender: TObject);
var
I: Integer;
Thread: TExecuteThread;
begin
FExecuting := False;
Thread := TExecuteThread(Sender);
FConnClosed := Thread.FConnClosed;
UpdateTitle;
UpdateDatabase;
AddMsgs(Thread.FMsgList);
AddRecordsets(Thread.FDataList);
if MoMsg.Lines.Count = 0 then MoMsg.Lines.Add('命令執行成功.');
for I := 0 to Thread.FTimeCost.Count - 1 do
begin
if I = 0 then MoMsg.Lines.Add(#13#10'耗時: ');
MoMsg.Lines.Add(' ' + IntToStr(Integer(Thread.FTimeCost[I])));
end;
if Thread.FHasErrors then
SBar.SimpleText := '批查詢已完成, 但有錯誤.'
else if Thread.FCanceled then
SBar.SimpleText := '批查詢已取消.'
else
SBar.SimpleText := '批查詢已完成.';
OnGridResize(nil);
if PnlResult.ControlCount = 0 then
Pgc1.ActivePageIndex := 1
else
begin
if TExecuteThread(Sender).FHasErrors then
Pgc1.ActivePageIndex := 1
else
Pgc1.ActivePageIndex := 0;
if PnlResult.ControlCount = 2 then
begin
PnlResult.Align := alClient;
for I := 0 to PnlResult.ControlCount-1 do
if PnlResult.Controls[I] is TDataGrid then
PnlResult.Controls[I].Align := alClient
else
PnlResult.Controls[I].Visible := False;
end;
end;
end;
procedure TSqlQryFrm.UpdateTitle;
begin
Self.Caption := Format('查詢 -- %s.%s.%s -- %s',
[FServerName, FDatabase, FSUserName, FFileName]);
end;
procedure TSqlQryFrm.UpdateDatabase;
begin
if IsConnectionActive(FConnection) then
begin
Self.FDatabase := FConnection.DefaultDatabase;
PostMessage(Application.MainForm.Handle, WM_DATABASECHANGED, 0, 0);
end;
end;
procedure TSqlQryFrm.FormDestroy(Sender: TObject);
begin
PostMessage(Application.MainForm.Handle, WM_QRYFRMCLOSE, 0, 0);
end;
procedure TSqlQryFrm.LoadFile;
begin
if OpenDialog1.Execute then
begin
MoSql.Lines.LoadFromFile(OpenDialog1.FileName);
FFileName := OpenDialog1.FileName;
UpdateTitle;
end;
end;
function TSqlQryFrm.SaveFile: Boolean;
begin
if FileExists(FFileName) then
begin
if MoSql.Modified then
MoSql.Lines.SaveToFile(FFileName);
Result := True;
end
else
Result := SaveAs;
end;
function TSqlQryFrm.SaveAs: Boolean;
begin
Result := SaveDialog1.Execute;
if Result then
begin
MoSql.Lines.SaveToFile(SaveDialog1.FileName);
FFileName := SaveDialog1.FileName;
UpdateTitle;
end;
end;
procedure TSqlQryFrm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
var
Msg: string;
trans: Integer;
Rst: _Recordset;
begin
// 檢查是否正在運行.
if Self.Executing then
begin
Msg := '是否要取消此次查詢?';
case Application.MessageBox(PChar(Msg), PChar(Application.Title),
MB_YESNOCANCEL or MB_ICONWARNING) of
ID_YES:
begin
if Self.Executing then
begin
Self.CancelExecute;
repeat
CheckSynchronize; // 因為我們用了TThread.Synchronize
Sleep(50);
until not Self.Executing or Application.Terminated;
end;
end;
else
CanClose := False;
end;
end;
// 檢查是否有未完成的事務.
try
Rst := ExecuteRst('select @@trancount');
trans := Rst.Fields[0].Value;
if trans > 0 then
begin
Msg := '有未提交的事務。'#13#10#13#10'是否希望在關閉窗口之前提交這些事務?';
case Application.MessageBox(PChar(Msg), PChar(Application.Title),
MB_YESNOCANCEL or MB_ICONWARNING) of
ID_YES:
begin
try ExecuteSql('commit tran'); except end;
end;
ID_NO:
try ExecuteSql('rollback tran'); except end;
ID_CANCEL:
begin
CanClose := False;
Exit;
end;
end;
end;
except
end;
// 檢查是否需要保存文件.
if MoSql.Modified then
begin
Msg := Format('%s 中的文本已經修改'#13#10#13#10'是否保存更改?', [Self.FFileName]);
case Application.MessageBox(PChar(Msg), PChar(Application.Title),
MB_YESNOCANCEL or MB_ICONWARNING) of
ID_YES:
try
CanClose := SaveFile;
except
Application.HandleException(Self);
CanClose := False;
end;
ID_CANCEL:
CanClose := False;
end;
end;
end;
function TSqlQryFrm.GetResultBoxVisible: Boolean;
begin
Result := Pgc1.Visible;
end;
procedure TSqlQryFrm.ToggleResultBox;
begin
if Pgc1.Visible then
begin
Pgc1.Visible := False;
Splitter1.Visible := False;
end
else
begin
Pgc1.Visible := True;
Splitter1.Visible := True;
end;
end;
procedure TSqlQryFrm.MnCopyGridTextClick(Sender: TObject);
var
Grid: TDataGrid;
begin
if Self.ActiveControl is TDataGrid then
begin
Grid := TDataGrid(Self.ActiveControl);
Clipboard.AsText := Grid.SelectionText;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -