|
автоматическая передача программе новых записей
|
|||
---|---|---|---|
#18+
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. ... |
|||
:
Нравится:
Не нравится:
|
|||
06.09.2002, 10:21 |
|
|
start [/forum/topic.php?fid=52&msg=32048653&tid=1993131]: |
0ms |
get settings: |
8ms |
get forum list: |
13ms |
check forum access: |
3ms |
check topic access: |
3ms |
track hit: |
72ms |
get topic data: |
12ms |
get forum data: |
3ms |
get page messages: |
37ms |
get tp. blocked users: |
1ms |
others: | 19ms |
total: | 171ms |
0 / 0 |