frmmonitoru.pas

Delphi_7.0数据库开发源代码。有内容十一章节

unit frmMonitorU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, IBSQLMonitor, ComCtrls, ExtCtrls;

type
  TfrmMonitor = class(TForm)
    Memo1: TMemo;
    MainMenu1: TMainMenu;
    SQLMonitor1: TMenuItem;
    Monitoring1: TMenuItem;
    Flags1: TMenuItem;
    Clear2: TMenuItem;
    ListView1: TListView;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    procedure IBSQLMonitor1SQL(EventText: String; EventTime : TDateTime);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Clear1Click(Sender: TObject);
    procedure Monitoring1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Flags1Click(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
  private
    mon : TIBSQLMonitor;
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

uses IBDatabase, frmTraceFlagsU;

{$R *.dfm}

procedure TfrmMonitor.IBSQLMonitor1SQL(EventText: String; EventTime : TDateTime);
var
  s : String;
  Start, Ending, len : Integer;
  FBuffer : PChar;
begin
  with ListView1.Items.Add do
  begin
    Caption := FormatDateTime('hh:nn:ss.zzz', EventTime);//格式化事件触发时间
    Start := Pos(']', EventText) + 3;//定位']'在字符串中的位置
    len := Length(EventText);//返回字符串长度
    Ending := Pos(']', Copy(EventText, Start, len)); //定位']'在字符串中的位置
    s := Copy(EventText, Start,Ending);
    GetMem(FBuffer, len + SizeOf(Integer));//动态分配内存空间
    Move(len, FBuffer[0], Sizeof(Integer));//复制指定长度的字符串
    Move(EventText[1], FBuffer[SizeOf(Integer)], len);
    Data := FBuffer;
    SubItems.Add(s);//添加表项
  end;
end;

procedure TfrmMonitor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Clear1Click(nil);  //清除所有和LsitView相关的内存
  Action := caFree;
end;

procedure TfrmMonitor.Clear1Click(Sender: TObject);
var
  i : Integer;
begin
  Memo1.Lines.Clear;
  ListView1.Items.BeginUpdate;//开始更新，更新中在VCL组件上无变化
  for i := 0 to Pred(ListView1.Items.Count) do
  begin
    FreeMem(ListView1.Items[i].Data);//释放动态申请的内存空间
    ListView1.Items[i].Data := nil;
  end;
  ListView1.Items.Clear;
  ListView1.Items.EndUpdate;//结束更新，在VCL组件上显示变化
end;

procedure TfrmMonitor.Monitoring1Click(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;//原选择框的状态取反
    mon.Enabled := Checked;
  end;
end;

procedure TfrmMonitor.FormCreate(Sender: TObject);
begin
  mon := TIBSQLMonitor.Create(self);//在窗体创建的同时创建组件本身
  mon.OnSQL := IBSQLMonitor1SQL;
end;

procedure TfrmMonitor.Flags1Click(Sender: TObject);
begin
  with TfrmTraceFlags.Create(self) do
  try
    SetTraceFlags(mon.TraceFlags);//设置标志
    if ShowModal = IDOK then
      mon.TraceFlags := GetTraceFlags;
  finally
    Free;
  end;
end;

procedure TfrmMonitor.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  st : String;
begin
  if Selected then
  begin
    Memo1.Clear;
    SetString(st, PChar(Item.Data) + SizeOf(Integer), PInteger(Item.Data)^);//字符串复制
    Memo1.Lines.Add(st);
  end;
end;

end.