📄 alerter.pas
字号:
unit Alerter;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, Buttons,
OdacVcl, DBAccess, Ora, OraAlerter, Db, OdacDemoForm, OdacDemoFrame;
type
TAlerterFrame = class(TOdacDemoFrame)
Panel2: TPanel;
meLog1: TMemo;
OraAlerter1: TOraAlerter;
Panel4: TPanel;
meLog2: TMemo;
OraAlerter2: TOraAlerter;
sqMultiSend: TOraSQL;
Panel6: TPanel;
Panel3: TPanel;
rbPipes: TRadioButton;
rbAlerts: TRadioButton;
Splitter1: TSplitter;
Panel12: TPanel;
Panel11: TPanel;
Label7: TLabel;
Panel1: TPanel;
btStart1: TSpeedButton;
btStop1: TSpeedButton;
btSend1: TSpeedButton;
Panel13: TPanel;
Label3: TLabel;
Label9: TLabel;
Label5: TLabel;
Label1: TLabel;
edEvent1: TEdit;
edTimeOut1: TEdit;
edMessage1: TEdit;
edInterval1: TEdit;
Label8: TLabel;
Panel5: TPanel;
btStart2: TSpeedButton;
btStop2: TSpeedButton;
btSend2: TSpeedButton;
btMultiSend: TSpeedButton;
Panel14: TPanel;
Label2: TLabel;
Label4: TLabel;
Label6: TLabel;
Label10: TLabel;
Delay: TLabel;
edMessage2: TEdit;
edTimeOut2: TEdit;
edInterval2: TEdit;
edEvent2: TEdit;
edDelay: TEdit;
OraSession2: TOraSession;
procedure btStart1Click(Sender: TObject);
procedure btStop1Click(Sender: TObject);
procedure btSend1Click(Sender: TObject);
procedure OraAlerter1Event(Sender: TObject; Event, Message: String);
procedure OraAlerter1TimeOut(Sender: TObject; var Continue: Boolean);
procedure btStart2Click(Sender: TObject);
procedure btStop2Click(Sender: TObject);
procedure btSend2Click(Sender: TObject);
procedure OraAlerter2Event(Sender: TObject; Event, Message: String);
procedure OraAlerter2TimeOut(Sender: TObject; var Continue: Boolean);
procedure rbAlertsClick(Sender: TObject);
procedure edTimeOut1Exit(Sender: TObject);
procedure edTimeOut2Exit(Sender: TObject);
procedure edInterval1Exit(Sender: TObject);
procedure edInterval2Exit(Sender: TObject);
procedure btMultiSendClick(Sender: TObject);
private
{ Private declarations }
public
procedure AssignConnection2;
procedure CheckEventType;
procedure Initialize; override;
procedure SetDirect(Value: boolean); override;
end;
implementation
uses
OraCall;
{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
procedure TAlerterFrame.AssignConnection2;
begin // to prevent double popping up of connect dialog
if not OdacForm.OraSession.Connected and OraSession2.Connected then
exit;
if not OdacForm.OraSession.Connected then
OdacForm.OraSession.Connect;
if not OdacForm.OraSession.Connected then
exit;
OraSession2.Disconnect;
OraSession2.AssignConnect(OdacForm.OraSession);
OraSession2.ConnectPrompt := False;
OraSession2.Connect;
end;
procedure TAlerterFrame.Initialize;
begin
inherited;
OraAlerter1.Session := Connection as TOraSession;
rbAlerts.Checked := OraAlerter1.EventType = etAlert;
rbPipes.Checked := OraAlerter1.EventType = etPipe;
edTimeOut1.Text := IntToStr(OraAlerter1.TimeOut);
edInterval1.Text := IntToStr(OraAlerter1.Interval);
edTimeOut2.Text := IntToStr(OraAlerter2.TimeOut);
edInterval2.Text := IntToStr(OraAlerter2.Interval);
edDelay.Text := FloatToStr(0.1);
CheckEventType;
end;
procedure TAlerterFrame.SetDirect(Value: boolean);
begin
OraSession2.Options.Direct := Value;
end;
procedure TAlerterFrame.CheckEventType;
begin
if rbAlerts.Checked then begin
OraAlerter1.EventType := etAlert;
OraAlerter2.EventType := etAlert;
end
else begin
OraAlerter1.EventType := etPipe;
OraAlerter2.EventType := etPipe;
end;
end;
procedure TAlerterFrame.btStart1Click(Sender: TObject);
begin
if not OraAlerter1.Active then begin
OraAlerter1.Start;
meLog1.Lines.Add('Started...');
end;
end;
procedure TAlerterFrame.btStop1Click(Sender: TObject);
begin
if OraAlerter1.Active then begin
OraAlerter1.Stop;
meLog1.Lines.Add('Stoped');
end;
end;
procedure TAlerterFrame.btSend1Click(Sender: TObject);
begin
OraAlerter1.SendEvent(edEvent1.Text, edMessage1.Text + ' at ' + TimeToStr(Time));
end;
procedure TAlerterFrame.OraAlerter1Event(Sender: TObject; Event, Message: String);
begin
meLog1.Lines.Add('Event ' + Event + ' (' + Message + ')');
// MessageBeep(0);
end;
procedure TAlerterFrame.OraAlerter1TimeOut(Sender: TObject;
var Continue: Boolean);
begin
meLog1.Lines.Add('TimeOut');
MessageBeep(0);
end;
procedure TAlerterFrame.btStart2Click(Sender: TObject);
begin
AssignConnection2;
if not OraAlerter2.Active then begin
OraAlerter2.Start;
meLog2.Lines.Add('Started...');
end;
end;
procedure TAlerterFrame.btStop2Click(Sender: TObject);
begin
if OraAlerter2.Active then begin
OraAlerter2.Stop;
meLog2.Lines.Add('Stoped');
end;
end;
procedure TAlerterFrame.btSend2Click(Sender: TObject);
begin
AssignConnection2;
OraAlerter2.SendEvent(edEvent2.Text, edMessage2.Text + ' at ' + TimeToStr(Time));
end;
procedure TAlerterFrame.OraAlerter2Event(Sender: TObject; Event, Message: String);
begin
meLog2.Lines.Add('Event ' + Event + ' (' + Message + ')');
MessageBeep(0);
end;
procedure TAlerterFrame.OraAlerter2TimeOut(Sender: TObject;
var Continue: Boolean);
begin
meLog2.Lines.Add('TimeOut');
MessageBeep(0);
end;
procedure TAlerterFrame.rbAlertsClick(Sender: TObject);
begin
CheckEventType;
end;
procedure TAlerterFrame.edTimeOut1Exit(Sender: TObject);
begin
try
OraAlerter1.TimeOut := StrToInt(edTimeOut1.Text);
except
edTimeOut1.Text := IntToStr(OraAlerter1.TimeOut);
raise;
end;
end;
procedure TAlerterFrame.edTimeOut2Exit(Sender: TObject);
begin
try
OraAlerter2.TimeOut := StrToInt(edTimeOut2.Text);
except
edTimeOut2.Text := IntToStr(OraAlerter2.TimeOut);
raise;
end;
end;
procedure TAlerterFrame.edInterval1Exit(Sender: TObject);
begin
try
OraAlerter1.Interval := StrToInt(edInterval1.Text);
except
edInterval1.Text := IntToStr(OraAlerter1.Interval);
raise;
end;
end;
procedure TAlerterFrame.edInterval2Exit(Sender: TObject);
begin
try
OraAlerter2.Interval := StrToInt(edInterval2.Text);
except
edInterval2.Text := IntToStr(OraAlerter2.Interval);
raise;
end;
end;
procedure TAlerterFrame.btMultiSendClick(Sender: TObject);
begin
AssignConnection2;
with sqMultiSend do begin
ParamByName('Name').AsString := edEvent2.Text;
ParamByName('Msg').AsString := edMessage2.Text;
try
ParamByName('Delay').AsFloat := StrToFloat(edDelay.Text);
except
on EComponentError do begin
MessageDlg('Please set correct Delay value.', mtError, [mbOK], 0);
exit;
end;
end;
Execute;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -