main.pas

ODAC+SDAC源代码

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.