powered by simpleCommunicator - 2.0.52     © 2025 Programmizd 02
Форумы / Oracle [игнор отключен] [закрыт для гостей] / автоматическая передача программе новых записей
1 сообщений из 26, страница 2 из 2
автоматическая передача программе новых записей
    #32048653
Nguyen Quang Trung
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
try this, I used NCOCI8
not very good but work, U can do some more customize

******************************************
//OraAlert.pas
******************************************
unit OraAlert;

interface
uses Windows,Classes,sysutils,Db,NCOci, NCOciWrapper, NCOciDB, NCOciParams;
type

TDbmsAlertEvent = procedure(Sender: TObject; msg: string) of object;
TErrorEvent = procedure(Sender: TObject; err: exception) of object;

TOraAlert = class(TThread)
private
FOwner:TComponent;
FDatabase:TOCIDatabase;
FSPRRegister:TOCIStoredProc;
FSPRWaitone:TOCIStoredProc;
FOnAlert:TDbmsAlertEvent;
FOnTimeOut:TNotifyEvent;
FOnError:TErrorEvent;
FOnStart:TNotifyEvent;
FOnStop:TNotifyEvent;
FEventName:string;
FTimeOut:integer;
FStarted:boolean;
FServerName:string;
FUserName:string;
FPassword:string;
protected
procedure ProcessMsg;
procedure Execute;override;
procedure DoAlertEvent(msg:string);
procedure DoTimeoutEvent;
procedure DoStartEvent;
procedure DoStopEvent;
procedure DoErrorEvent(err:exception);
procedure SetEventName(ename:string);
procedure SetTimeOut(tout:integer);
procedure PrepareStoreProcs;
public
constructor Create(AOwner:TComponent;dbname:string);
destructor Destroy;override;
procedure Logon;
procedure Logoff;
procedure Start;
procedure Stop;
published
property ServerName:string read FServerName write FServerName;
property UserName:string read FUserName write FUserName;
property Password:string read FPassword write FPassword;
property EventName:string read FEventName write SetEventName;
property TimeOut:integer read FTimeOut write SetTimeOut;
property Started:boolean read FStarted write FStarted;
property OnAlert:TDbmsAlertEvent read FOnAlert write FOnAlert;
property OnStart:TNotifyEvent read FOnStart write FOnStart;
property OnStop:TNotifyEvent read FOnStop write FOnStop;
property OnTimeOut:TNotifyEvent read FOnTimeOut write FOnTimeOut;
property OnError:TErrorEvent read FOnError write FOnError;
end;

implementation

constructor TOraAlert.Create(AOwner:TComponent;dbname:string);
begin
{TODO: Create new TOraAlert instant here}
inherited Create(true);
FOwner:=AOwner;
FreeOnTerminate:=false;
Priority:=tpLower;
FDatabase:=TOCIDatabase.Create(nil);
FDatabase.Name:='odbAlert';
FDatabase.DatabaseName:=dbname;
FDatabase.LoginPrompt:=false;
FSPRRegister:=TOCIStoredProc.Create(nil);
FSPRRegister.Name:='sprRegister';
FSPRRegister.DatabaseName:=FDatabase.DatabaseName;
FSPRWaitone:=TOCIStoredProc.Create(nil);
FSPRWaitone.Name:='sprWaitone';
FSPRWaitone.DatabaseName:=FDatabase.DatabaseName;
FTimeout:=0;
FEventName:='';
end;

destructor TOraAlert.Destroy;
begin
DoStopEvent;
suspend;
FSPRRegister.Free;
FSPRWaitone.Free;
FDatabase.Free;
inherited Destroy;
end;

procedure TOraAlert.Logon;
begin
FDatabase.UserName:=FUserName;
FDatabase.ServerName:=FServerName;
FDatabase.Password:=FPassword;
FDatabase.Connected:=true;
if not FDatabase.Connected then exit;
PrepareStoreProcs;
end;

procedure TOraAlert.Logoff;
begin
DoStopEvent;
suspend;
FDatabase.Connected:=false;
end;

procedure TOraAlert.PrepareStoreProcs;
begin
FSPRRegister.StoredProcName:='DBMS_ALERT.REGISTER';
FSPRRegister.Params.Clear;
FSPRRegister.Params.CreateParam(ftString,'NAME',ptInput);
FSPRRegister.ParamByName('NAME').Value:=FEventName;
FSPRRegister.Prepare;
FSPRRegister.ExecProc;
FSPRWaitone.StoredProcName:='DBMS_ALERT.WAITONE';
FSPRWaitone.Params.Clear;
FSPRWaitone.Params.CreateParam(ftString,'NAME',ptInput);
FSPRWaitone.ParamByName('NAME').Value:=FEventName;
FSPRWaitone.Params.CreateParam(ftString,'MESSAGE',ptOutput);
FSPRWaitone.Params.CreateParam(ftString,'STATUS',ptOutput);
FSPRWaitone.Params.CreateParam(ftInteger,'TIMEOUT',ptInput);
FSPRWaitone.ParamByName('TIMEOUT').Value:=FTimeOut;
FSPRWaitone.Prepare;
end;

procedure TOraAlert.Start;
begin
{TODO:Start TOraAlert here}
DoStartEvent;
resume;
end;

procedure TOraAlert.Stop;
begin
{TODO:Stop TOraAlert here}
DoStopEvent;
suspend;
end;

procedure TOraAlert.ProcessMsg;
begin
if FDatabase.Connected then
begin
try
{
with FSPRRegister do
begin
ExecProc;
end;
}
with FSPRWaitone do
begin
ExecProc;
if ParamByName('STATUS').Value=0 then
DoAlertEvent(ParamByName('MESSAGE').Value)
else
DoTimeoutEvent;
end;
except on e:exception do
DoErrorEvent(e);
end;
end;
end;

procedure TOraAlert.Execute;
begin
{TODO: Execute TOraAlert here}
while not Terminated do
begin
ProcessMsg;
sleepex(1,true);
end;
end;

procedure TOraAlert.DoAlertEvent(msg:string);
begin
{TODO:}
if Assigned(FOnAlert) then
FOnAlert(nil,msg);
end;

procedure TOraAlert.DoTimeoutEvent;
begin
{TODO:}
if Assigned(FOnTimeout) then
FOnTimeout(nil);
end;

procedure TOraAlert.DoStartEvent;
begin
{TODO:}
if Assigned(FOnStart) then
FOnStart(nil);
end;

procedure TOraAlert.DoStopEvent;
begin
{TODO:}
if Assigned(FOnStop) then
FOnStop(nil);
end;

procedure TOraAlert.DoErrorEvent(err:exception);
begin
{TODO:}
if Assigned(FOnError) then
FOnError(nil,err);
end;

procedure TOraAlert.SetEventName(ename:string);
begin
{TODO:}
FEventName:=ename;
end;

procedure TOraAlert.SetTimeOut(tout:integer);
begin
{TODO:}
if tout>=0 then
FTimeOut:=tout;
end;


end.

******************************************
//OraAlertDemoMain.pas
******************************************
unit OraAlertDemoMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, StdCtrls, NCOci, NCOciWrapper, NCOciDB, OraAlert,
ExtCtrls;

type
TfrmMain = class(TForm)
mmoAlerts: TMemo;
pnlBottom: TPanel;
bttnStart: TButton;
edtEventname: TEdit;
Label1: TLabel;
Label2: TLabel;
edtServername: TEdit;
Label3: TLabel;
edtUsername: TEdit;
Label4: TLabel;
edtPassword: TEdit;
procedure bttnStartClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
oa:TOraAlert;
iCounter:integer;
procedure PaintMemo(Sender: TObject; msg: string);
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.PaintMemo(Sender: TObject; msg: string);
begin
inc(iCounter);
mmoAlerts.Lines.Add(inttostr(iCounter)+'> '+msg);
end;

procedure TfrmMain.bttnStartClick(Sender: TObject);
begin
bttnStart.Enabled:=false;
oa:=TOraAlert.Create(self,'dba1');
oa.ServerName:=edtServername.Text;
oa.UserName:=edtUsername.Text;
oa.Password:=edtPassword.Text;
oa.EventName:=edtEventname.Text;
oa.TimeOut:=10000;
oa.OnAlert:=PaintMemo;
oa.Logon;
oa.Start;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
iCounter:=0;
end;

end.
...
Рейтинг: 0 / 0
1 сообщений из 26, страница 2 из 2
Форумы / Oracle [игнор отключен] [закрыт для гостей] / автоматическая передача программе новых записей
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]