sqlqry.pas

仿sql查询分析器

  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.