📄 main.pas
字号:
unit Main;
interface
uses
{$IFDEF LINUX}
SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
QDBCtrls, QComCtrls, QExtCtrls, QGrids, QDBGrids, OdacClx, DBAccess, Ora,
OraAlerter, OdacVcl, DB, StdCtrls, Controls, ExtCtrls
{$ELSE}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, OdacVcl,
{$ENDIF}
DBAccess, Ora, OraAlerter, Db;
type
TfmMain = class(TForm)
OraSession1: TOraSession;
OraAlerter1: TOraAlerter;
btSend1: TButton;
btStart1: TButton;
meLog1: TMemo;
meLog2: TMemo;
edMessage1: TEdit;
Label1: TLabel;
Label2: TLabel;
edMessage2: TEdit;
btStop1: TButton;
btStart2: TButton;
btStop2: TButton;
btSend2: TButton;
OraSession2: TOraSession;
OraAlerter2: TOraAlerter;
ConnectDialog: TConnectDialog;
btClear1: TButton;
btClear2: TButton;
rbPipes: TRadioButton;
rbAlerts: TRadioButton;
Label3: TLabel;
edTimeOut1: TEdit;
Label4: TLabel;
edTimeOut2: TEdit;
Label5: TLabel;
edInterval1: TEdit;
Label6: TLabel;
edInterval2: TEdit;
Label7: TLabel;
Label8: TLabel;
Bevel1: TBevel;
Label9: TLabel;
edEvent1: TEdit;
Label10: TLabel;
edEvent2: TEdit;
btMultiSend: TButton;
sqMultiSend: TOraSQL;
edDelay: TEdit;
Label11: TLabel;
Delay: TLabel;
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 btClear1Click(Sender: TObject);
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 btClear2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure rbAlertsClick(Sender: TObject);
procedure edTimeOut1Exit(Sender: TObject);
procedure edTimeOut2Exit(Sender: TObject);
procedure edInterval1Exit(Sender: TObject);
procedure edInterval2Exit(Sender: TObject);
procedure OraSession1ConnectChange(Sender: TObject;
Connected: Boolean);
procedure btMultiSendClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fmMain: TfmMain;
implementation
uses
OraCall;
{$R *.nfm}
procedure TfmMain.btStart1Click(Sender: TObject);
begin
if not OraAlerter1.Active then begin
OraAlerter1.Start;
meLog1.Lines.Add('Started...');
end;
end;
procedure TfmMain.btStop1Click(Sender: TObject);
begin
if OraAlerter1.Active then begin
OraAlerter1.Stop;
meLog1.Lines.Add('Stoped');
end;
end;
procedure TfmMain.btSend1Click(Sender: TObject);
begin
OraAlerter1.SendEvent(edEvent1.Text, edMessage1.Text + ' at ' + TimeToStr(Time));
end;
procedure TfmMain.OraAlerter1Event(Sender: TObject; Event, Message: String);
begin
meLog1.Lines.Add('Event ' + Event + ' (' + Message + ')');
// MessageBeep(0);
end;
procedure TfmMain.OraAlerter1TimeOut(Sender: TObject;
var Continue: Boolean);
begin
meLog1.Lines.Add('TimeOut');
{$IFDEF MSWINDOWS}
MessageBeep(0);
{$ENDIF}
end;
procedure TfmMain.btClear1Click(Sender: TObject);
begin
meLog1.Lines.Clear;
end;
procedure TfmMain.btStart2Click(Sender: TObject);
begin
if not OraAlerter2.Active then begin
OraAlerter2.Start;
meLog2.Lines.Add('Started...');
end;
end;
procedure TfmMain.btStop2Click(Sender: TObject);
begin
if OraAlerter2.Active then begin
OraAlerter2.Stop;
meLog2.Lines.Add('Stoped');
end;
end;
procedure TfmMain.btSend2Click(Sender: TObject);
begin
OraAlerter2.SendEvent(edEvent2.Text, edMessage2.Text + ' at ' + TimeToStr(Time));
end;
procedure TfmMain.OraAlerter2Event(Sender: TObject; Event, Message: String);
begin
meLog2.Lines.Add('Event ' + Event + ' (' + Message + ')');
{$IFDEF MSWINDOWS}
MessageBeep(0);
{$ENDIF}
end;
procedure TfmMain.OraAlerter2TimeOut(Sender: TObject;
var Continue: Boolean);
begin
meLog2.Lines.Add('TimeOut');
{$IFDEF MSWINDOWS}
MessageBeep(0);
{$ENDIF}
end;
procedure TfmMain.btClear2Click(Sender: TObject);
begin
meLog2.Lines.Clear;
end;
procedure TfmMain.FormCreate(Sender: TObject);
begin
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);
end;
procedure TfmMain.rbAlertsClick(Sender: TObject);
begin
if rbAlerts.Checked then begin
OraAlerter1.EventType := etAlert;
OraAlerter2.EventType := etAlert;
end
else begin
OraAlerter1.EventType := etPipe;
OraAlerter2.EventType := etPipe;
end;
end;
procedure TfmMain.edTimeOut1Exit(Sender: TObject);
begin
try
OraAlerter1.TimeOut := StrToInt(edTimeOut1.Text);
except
edTimeOut1.Text := IntToStr(OraAlerter1.TimeOut);
raise;
end;
end;
procedure TfmMain.edTimeOut2Exit(Sender: TObject);
begin
try
OraAlerter2.TimeOut := StrToInt(edTimeOut2.Text);
except
edTimeOut2.Text := IntToStr(OraAlerter2.TimeOut);
raise;
end;
end;
procedure TfmMain.edInterval1Exit(Sender: TObject);
begin
try
OraAlerter1.Interval := StrToInt(edInterval1.Text);
except
edInterval1.Text := IntToStr(OraAlerter1.Interval);
raise;
end;
end;
procedure TfmMain.edInterval2Exit(Sender: TObject);
begin
try
OraAlerter2.Interval := StrToInt(edInterval2.Text);
except
edInterval2.Text := IntToStr(OraAlerter2.Interval);
raise;
end;
end;
procedure TfmMain.OraSession1ConnectChange(Sender: TObject;
Connected: Boolean);
begin
if Connected and not OraSession2.Connected then begin
OraSession2.Assign(OraSession1);
OraSession2.ConnectPrompt := False;
end;
end;
procedure TfmMain.btMultiSendClick(Sender: TObject);
begin
with sqMultiSend do begin
ParamByName('Name').AsString := edEvent2.Text;
ParamByName('Msg').AsString := edMessage2.Text;
ParamByName('Delay').AsFloat := StrToFloat(edDelay.Text);
Execute;
end;
end;
initialization
OCIThreaded := False; // bug in Oracle 8.1.5
OCIMutexed := False;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -