⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 alerter.pas

📁 odac for oralce 8i,10g,11g easy to connect to oralce from delphi
💻 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 + -