Répétez apres moi :J'aime PBAdonf. J'aime PBAdonf. J'aime PBAdonf.

Le forum (ô combien francophone) des utilisateurs de Powerbuilder.

Recherche rapide

Annonce

Certaines rubriques, dont des cours, sont uniquement visibles par les membres du forum ^^.
Dans la rubrique Liens & Références, vous avez accès à un sommaire de téléchargement, profitez-en !
Il existe maintenant un nouveau TOPIC "Votre CV en Ligne" accessible uniquement par demande.

#1 21-06-2007 12:34:17

JCZ  
Builder Power
Award: bf
Lieu: 75019 paris
Date d'inscription: 21-05-2007
Messages: 1724
Pépites: 496,453,703,213
Banque: 9,223,372,036,854,776,000

[SOURCE] Multi thread & recup des messages ( alerte Oracle )

Exemple : j'ai une appli.
          Je veux communiquer avec l'utilisateur connecté à oracle en lui envoyant un message en passant par la base de donnée à laquelle il est connecté
Source en pb 10.2.0
1 . Appli <alert>

s_register.srs

Code: pb

$PBExportHeader$s_register.srs
global type s_register from structure
  string    dbms
  string    login
  string    mdp
  string    servername
  string    register
end type



w_register.srw

Code: pb

$PBExportHeader$w_register.srw
forward
global type w_register from window
end type
type cb_1 from commandbutton within w_register
end type
type st_4 from statictext within w_register
end type
type sle_alert from singlelineedit within w_register
end type
type st_3 from statictext within w_register
end type
type st_2 from statictext within w_register
end type
type st_1 from statictext within w_register
end type
type sle_servername from singlelineedit within w_register
end type
type sle_pwd from singlelineedit within w_register
end type
type sle_login from singlelineedit within w_register
end type
end forward

global type w_register from window
integer width = 1925
integer height = 1452
boolean titlebar = true
string title = "Création d~'émetteur d~'alerte "
boolean controlmenu = true
boolean minbox = true
boolean maxbox = true
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
cb_1 cb_1
st_4 st_4
sle_alert sle_alert
st_3 st_3
st_2 st_2
st_1 st_1
sle_servername sle_servername
sle_pwd sle_pwd
sle_login sle_login
end type
global w_register w_register

on w_register.create
this.cb_1=create cb_1
this.st_4=create st_4
this.sle_alert=create sle_alert
this.st_3=create st_3
this.st_2=create st_2
this.st_1=create st_1
this.sle_servername=create sle_servername
this.sle_pwd=create sle_pwd
this.sle_login=create sle_login
this.Control[]={this.cb_1,&
this.st_4,&
this.sle_alert,&
this.st_3,&
this.st_2,&
this.st_1,&
this.sle_servername,&
this.sle_pwd,&
this.sle_login}
end on

on w_register.destroy
destroy(this.cb_1)
destroy(this.st_4)
destroy(this.sle_alert)
destroy(this.st_3)
destroy(this.st_2)
destroy(this.st_1)
destroy(this.sle_servername)
destroy(this.sle_pwd)
destroy(this.sle_login)
end on

type cb_1 from commandbutton within w_register
integer x = 681
integer y = 1092
integer width = 1038
integer height = 112
integer taborder = 50
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "Enregister"
end type

event clicked;s_register sr

sr.dbms = "O84"
sr.login = sle_login.text
sr.mdp  = sle_pwd.text
sr.servername = sle_servername.text
sr.register = sle_alert.text

w_alert lw_alert

OpenWithParm(lw_alert, sr)
end event

type st_4 from statictext within w_register
integer x = 146
integer y = 872
integer width = 402
integer height = 64
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Type Alerte :"
boolean focusrectangle = false
end type

type sle_alert from singlelineedit within w_register
integer x = 677
integer y = 848
integer width = 1038
integer height = 112
integer taborder = 40
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

type st_3 from statictext within w_register
integer x = 151
integer y = 660
integer width = 402
integer height = 84
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Serveur :"
boolean focusrectangle = false
end type

type st_2 from statictext within w_register
integer x = 155
integer y = 452
integer width = 402
integer height = 64
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Mdp :"
boolean focusrectangle = false
end type

type st_1 from statictext within w_register
integer x = 155
integer y = 244
integer width = 402
integer height = 64
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Login :"
boolean focusrectangle = false
end type

type sle_servername from singlelineedit within w_register
integer x = 677
integer y = 636
integer width = 1038
integer height = 112
integer taborder = 30
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

type sle_pwd from singlelineedit within w_register
integer x = 677
integer y = 428
integer width = 1038
integer height = 112
integer taborder = 20
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
boolean password = true
borderstyle borderstyle = stylelowered!
end type

type sle_login from singlelineedit within w_register
integer x = 677
integer y = 224
integer width = 1038
integer height = 112
integer taborder = 10
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type


w_alert.srw

Code: pb

$PBExportHeader$w_alert.srw
forward
global type w_alert from window
end type
type cb_send from commandbutton within w_alert
end type
type sle_message from singlelineedit within w_alert
end type
type st_alert from statictext within w_alert
end type
end forward

global type w_alert from window
integer width = 2496
integer height = 812
boolean titlebar = true
string title = "Envoi par type d~'alerte"
boolean controlmenu = true
boolean minbox = true
boolean maxbox = true
boolean resizable = true
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
event ue_postopen ( )
cb_send cb_send
sle_message sle_message
st_alert st_alert
end type
global w_alert w_alert

type variables
u_trans it_sqlca
string    is_register
end variables

event ue_postopen();st_alert.text  = is_register


IF it_sqlca.SQLCODE <> 0 THEN
  MessageBox ( "Register", it_sqlca.SQLErrText )
END IF

Commit using it_sqlca;


end event

on w_alert.create
this.cb_send=create cb_send
this.sle_message=create sle_message
this.st_alert=create st_alert
this.Control[]={this.cb_send,&
this.sle_message,&
this.st_alert}
end on

on w_alert.destroy
destroy(this.cb_send)
destroy(this.sle_message)
destroy(this.st_alert)
end on

event open;s_register lstr_register
lstr_register = Message.PowerObjectParm

it_sqlca = create u_trans

it_sqlca.DBMS          = lstr_register.dbms
it_sqlca.Database     = lstr_register.servername
it_sqlca.LogID            = lstr_register.login 
it_sqlca.LogPass         = lstr_register.mdp
it_sqlca.ServerName   = lstr_register.servername
it_sqlca.UserID         = lstr_register.login
it_sqlca.DBPass       = lstr_register.mdp
is_register                  = lstr_register.register



CONNECT Using it_sqlca ;
IF it_sqlca.SQLCODE <> 0 THEN
  MessageBox ( "Connect Error", it_sqlca.SQLErrText )
  Return
END IF

PostEvent ("ue_postopen")
end event

event close;destroy it_sqlca
end event

event closequery;destroy it_sqlca
end event

type cb_send from commandbutton within w_alert
integer x = 969
integer y = 508
integer width = 457
integer height = 128
integer taborder = 20
integer textsize = -9
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "Envoyer"
end type

event clicked;string ls_message

ls_message = sle_message.text
this.enabled = FALSE
it_sqlca.Signal (is_register+" ", ls_message+" " )

IF NOT it_sqlca.SQLCODE = 0 THEN
  MessageBox ( "Envoi Alerte", it_sqlca.SQLErrText )
END IF

//Commit obligatoire
COMMIT Using it_sqlca;
this.enabled = TRUE
end event

type sle_message from singlelineedit within w_alert
integer x = 32
integer y = 272
integer width = 2368
integer height = 128
integer taborder = 10
integer textsize = -12
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

type st_alert from statictext within w_alert
integer x = 32
integer y = 32
integer width = 2382
integer height = 168
integer textsize = -24
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 16777215
long backcolor = 268435456
boolean focusrectangle = false
end type


u_trans.sru

Code: pb

$PBExportHeader$u_trans.sru
forward
global type u_trans from transaction
end type
end forward

global type u_trans from transaction
end type
global u_trans u_trans

type prototypes
subroutine REGISTER(string ALERTNAME) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"REGISTER~""
subroutine SIGNAL(string ALERTNAME, string ALERTMESSAGE) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"SIGNAL~""
subroutine WAITANY(ref string ALERTNAME, ref string ALERTMESSAGE, ref integer STATUS, long TIMEOUT) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"WAITANY~""
subroutine WAITONE(string ALERTNAME, ref string ALERTMESSAGE, ref integer STATUS, long TIMEOUT) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"WAITONE~""
subroutine REMOVE(string ALERTNAME) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"REMOVE~""
subroutine SET_DEFAULTS(integer POLLINGINTERVAL) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"SET_DEFAULTS~""
end prototypes
on u_trans.create
call super::create
TriggerEvent( this, "constructor" )
end on

on u_trans.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on



2 . Appli <Thread>
w_threads.srw

Code: pb

$PBExportHeader$w_threads.srw
forward
global type w_threads from window
end type
type cbx_threads from checkbox within w_threads
end type
type cb_connexion from commandbutton within w_threads
end type
type cbx_alerte7 from checkbox within w_threads
end type
type cbx_alerte6 from checkbox within w_threads
end type
type cbx_alerte5 from checkbox within w_threads
end type
type cbx_alerte4 from checkbox within w_threads
end type
type cbx_alerte3 from checkbox within w_threads
end type
type cbx_alerte2 from checkbox within w_threads
end type
type cbx_alerte1 from checkbox within w_threads
end type
type cb_stop from commandbutton within w_threads
end type
type dw_1 from datawindow within w_threads
end type
type cb_start from commandbutton within w_threads
end type
type gb_1 from groupbox within w_threads
end type
end forward

global type w_threads from window
integer width = 3950
integer height = 1412
boolean titlebar = true
string title = "Thread manager"
boolean controlmenu = true
boolean minbox = true
boolean maxbox = true
boolean resizable = true
long backcolor = 67108864
event ue_message ( string as_message )
event ue_connection ( )
cbx_threads cbx_threads
cb_connexion cb_connexion
cbx_alerte7 cbx_alerte7
cbx_alerte6 cbx_alerte6
cbx_alerte5 cbx_alerte5
cbx_alerte4 cbx_alerte4
cbx_alerte3 cbx_alerte3
cbx_alerte2 cbx_alerte2
cbx_alerte1 cbx_alerte1
cb_stop cb_stop
dw_1 dw_1
cb_start cb_start
gb_1 gb_1
end type
global w_threads w_threads

type variables
Integer              ii_threads
n_cst_comm          inv_comm
n_cst_alert            inv_alerts[]
n_cst_threadmanager   tmgr
s_register                      istr_register

end variables

event ue_message(string as_message);Long  ll_row

Yield()
IF as_message = "--Terminé --" THEN
  ii_threads --
ELSE
  ll_row = dw_1.InsertRow( 0 )
  dw_1.ScrollToRow( ll_row )
  dw_1.SetItem( ll_row, "text", as_message )
END IF
Yield()
IF ii_threads <= 1 THEN cb_start.Enabled = TRUE
end event

event ue_connection();Open(w_login)
istr_register = Message.PowerObjectParm

cb_start.enabled = FALSE
cb_stop.enabled  = FALSE

sqlca.DBMS          = istr_register.dbms
sqlca.Database     = istr_register.servername
sqlca.LogID            = istr_register.login 
sqlca.LogPass         = istr_register.mdp
sqlca.ServerName = istr_register.servername
sqlca.UserID       = istr_register.login
sqlca.DBPass       = istr_register.mdp



CONNECT;
IF sqlca.SQLCODE = 0 THEN
  cb_start.enabled = TRUE
ELSE
  MessageBox ( "Connect Error", sqlca.SQLErrText )
  Return
END IF
DISCONNECT;

end event

on w_threads.create
this.cbx_threads=create cbx_threads
this.cb_connexion=create cb_connexion
this.cbx_alerte7=create cbx_alerte7
this.cbx_alerte6=create cbx_alerte6
this.cbx_alerte5=create cbx_alerte5
this.cbx_alerte4=create cbx_alerte4
this.cbx_alerte3=create cbx_alerte3
this.cbx_alerte2=create cbx_alerte2
this.cbx_alerte1=create cbx_alerte1
this.cb_stop=create cb_stop
this.dw_1=create dw_1
this.cb_start=create cb_start
this.gb_1=create gb_1
this.Control[]={this.cbx_threads,&
this.cb_connexion,&
this.cbx_alerte7,&
this.cbx_alerte6,&
this.cbx_alerte5,&
this.cbx_alerte4,&
this.cbx_alerte3,&
this.cbx_alerte2,&
this.cbx_alerte1,&
this.cb_stop,&
this.dw_1,&
this.cb_start,&
this.gb_1}
end on

on w_threads.destroy
destroy(this.cbx_threads)
destroy(this.cb_connexion)
destroy(this.cbx_alerte7)
destroy(this.cbx_alerte6)
destroy(this.cbx_alerte5)
destroy(this.cbx_alerte4)
destroy(this.cbx_alerte3)
destroy(this.cbx_alerte2)
destroy(this.cbx_alerte1)
destroy(this.cb_stop)
destroy(this.dw_1)
destroy(this.cb_start)
destroy(this.gb_1)
end on

event close;IF isValid( tmgr ) THEN DESTROY tmgr

end event

event open;PostEvent("ue_connection")
end event

type cbx_threads from checkbox within w_threads
integer x = 1632
integer y = 40
integer width = 1317
integer height = 80
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Un Thread par type d~'alerte"
end type

type cb_connexion from commandbutton within w_threads
integer x = 1001
integer y = 36
integer width = 485
integer height = 92
integer taborder = 20
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "&Connexion"
end type

event clicked;Integer li_index

ii_threads = upperBound( inv_alerts )
FOR li_index = 1 TO ii_threads
  IF isValid( inv_alerts[li_index] ) THEN
    inv_alerts[li_index].POST of_stopalert()
  END IF
NEXT

Parent.TriggerEvent("ue_connection")
end event

type cbx_alerte7 from checkbox within w_threads
integer x = 3136
integer y = 856
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte7"
end type

type cbx_alerte6 from checkbox within w_threads
integer x = 3136
integer y = 772
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte6"
end type

type cbx_alerte5 from checkbox within w_threads
integer x = 3136
integer y = 684
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte5"
end type

type cbx_alerte4 from checkbox within w_threads
integer x = 3136
integer y = 592
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte4"
end type

type cbx_alerte3 from checkbox within w_threads
integer x = 3136
integer y = 500
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte3"
end type

type cbx_alerte2 from checkbox within w_threads
integer x = 3136
integer y = 408
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte2"
end type

type cbx_alerte1 from checkbox within w_threads
integer x = 3136
integer y = 316
integer width = 343
integer height = 64
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alerte1"
end type

type cb_stop from commandbutton within w_threads
integer x = 517
integer y = 36
integer width = 485
integer height = 92
integer taborder = 20
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "S&top"
end type

event clicked;Integer li_index

tmgr.of_stopThreads()

ii_threads = upperBound( inv_alerts )
FOR li_index = 1 TO ii_threads
  IF isValid( inv_alerts[li_index] ) THEN
    inv_alerts[li_index].POST of_stopalert()
  END IF
NEXT
cb_start.enabled = TRUE
end event

type dw_1 from datawindow within w_threads
integer x = 32
integer y = 160
integer width = 2935
integer height = 1060
integer taborder = 50
string title = "none"
string dataobject = "d_output"
boolean hscrollbar = true
boolean vscrollbar = true
boolean livescroll = true
borderstyle borderstyle = stylelowered!
end type

type cb_start from commandbutton within w_threads
integer x = 32
integer y = 36
integer width = 485
integer height = 92
integer taborder = 10
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
string text = "&Start"
end type

event clicked;Integer      li_index, li_index2, li_rc
Long        ll_maxprimes
String              ls_alert[7]
Integer      li_alerttype


li_alerttype = 0
ii_threads   = 0

If cbx_alerte1.checked Then 
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte1"
End If
If cbx_Alerte2.checked Then   
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte2"
End If

If cbx_Alerte3.checked Then 
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte3"
End If

If cbx_Alerte4.checked Then 
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte4"
End If

If cbx_Alerte5.checked Then 
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte5"
End If

If cbx_Alerte6.checked Then 
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte6"
End If

If cbx_Alerte7.checked Then 
  li_alerttype ++
  ls_alert[li_alerttype] = "Alerte7"
End If

If cbx_threads.checked Then
  ii_threads = li_alerttype
Else
  If li_alerttype > 0 Then ii_threads = 1
End If

IF NOT isValid( tmgr ) THEN
  tmgr = CREATE n_cst_threadmanager
END IF
tmgr.of_init( "n_cst_alert" )

IF NOT IsValid( inv_comm ) THEN
  inv_comm = CREATE n_cst_comm
  inv_comm.of_SetRequestor( Parent )
END IF

FOR li_index = 1 TO ii_threads
  li_rc = tmgr.of_getThread( inv_alerts[li_index] )
  IF li_rc <= 0 THEN
    MessageBox( "Thread Manager", "impossible de créer le thread N°" + &
      String( li_index )  )
    EXIT
  END IF
  IF isValid( inv_alerts[li_index] ) THEN
    inv_alerts[li_index].of_SetComm( inv_comm )
    inv_alerts[li_index].of_SetID( li_index )
  END IF
NEXT

dw_1.Reset()
Parent.EVENT ue_message( "Initialisation des threads... veuillez patienter" )
this.Enabled = FALSE

//ii_threads = upperBound( inv_alerts )
FOR li_index = 1 TO ii_threads
  IF isValid( inv_alerts[li_index] ) THEN
    IF cbx_threads.checked THEN
          inv_alerts[li_index].POST of_initalert(ls_alert[li_index], istr_register)
    ELSE
          FOR li_index2 = 1 TO li_alerttype
          IF li_index2 = 1 Then 
            inv_alerts[li_index].POST of_initalert(istr_register)
          END IF
          inv_alerts[li_index].POST of_addalerttype(ls_alert[li_index2])
          NEXT
    END IF
          
  END IF
NEXT

cb_stop.enabled = TRUE

end event

type gb_1 from groupbox within w_threads
integer x = 3049
integer y = 136
integer width = 736
integer height = 1088
integer taborder = 50
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 33554432
long backcolor = 67108864
string text = "Alertes"
end type


n_cst_threadmanager.sru

Code: pb

$PBExportHeader$n_cst_threadmanager.sru
forward
global type n_cst_threadmanager from nonvisualobject
end type
end forward

global type n_cst_threadmanager from nonvisualobject
end type
global n_cst_threadmanager n_cst_threadmanager

type variables
Boolean      ib_init = FALSE
Boolean      ib_running = TRUE
n_cst_thread  inv_threads[]
String           is_classname

Integer      ii_maxThreads = 10  
end variables

forward prototypes
public function integer of_getthread (ref n_cst_thread anv_thread)
public function boolean of_isrunning ()
public function integer of_stopthreads ()
private function integer of_createthread ()
public function integer of_init (string as_classname)
public subroutine of_cleanthreads ()
end prototypes

public function integer of_getthread (ref n_cst_thread anv_thread);
Integer li_threads

li_threads = upperBound( inv_threads )
IF li_threads >= ii_maxThreads THEN
  RETURN 0    
ELSE
  Integer  li_index
  Boolean  lb_allBusy = TRUE
  
  FOR li_index = 1 TO li_threads
    IF inv_threads[li_index].of_busy() THEN
      CONTINUE
    ELSE
      lb_allBusy = FALSE
      EXIT
    END IF
  NEXT
  
  IF lb_allBusy THEN
    li_index = of_createThread()
    IF li_index < 0 THEN RETURN li_index
  END IF
  
  anv_thread = inv_threads[li_index]
  anv_thread.of_init()  
  anv_thread.of_setBusy( TRUE )
END IF

RETURN 1
end function

public function boolean of_isrunning ();RETURN ib_running
end function

public function integer of_stopthreads ();ib_running = FALSE
RETURN 1
end function

private function integer of_createthread ();ErrorReturn    err
Integer      li_new

li_new = upperBound( inv_threads ) + 1
err = SharedObjectRegister( "n_cst_alert", "Thread" + String( li_new ) )
IF err <> Success! THEN RETURN -1

SharedObjectGet( "Thread" + String( li_new ), inv_threads[li_new] )
inv_threads[li_new].of_setmanager( this )

RETURN li_new
end function

public function integer of_init (string as_classname);

ib_running = TRUE

IF ib_init THEN RETURN 0  
is_className = as_classname

ib_init = TRUE
RETURN 1

end function

public subroutine of_cleanthreads ();
Integer  li_index, li_threads

li_threads = upperBound( inv_threads )
FOR li_index = 1 TO li_threads
  SharedObjectUnRegister( "Thread" + String( li_index ) )
  SetNull( inv_threads[li_index] )
NEXT


end subroutine

on n_cst_threadmanager.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_cst_threadmanager.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

event destructor;of_cleanThreads()
end event

w_login.srw

Code: pb

$PBExportHeader$w_login.srw
forward
global type w_login from window
end type
type cb_1 from commandbutton within w_login
end type
type st_3 from statictext within w_login
end type
type st_2 from statictext within w_login
end type
type st_1 from statictext within w_login
end type
type sle_servername from singlelineedit within w_login
end type
type sle_pwd from singlelineedit within w_login
end type
type sle_login from singlelineedit within w_login
end type
end forward

global type w_login from window
integer width = 1751
integer height = 960
boolean titlebar = true
string title = "Login"
windowtype windowtype = response!
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
cb_1 cb_1
st_3 st_3
st_2 st_2
st_1 st_1
sle_servername sle_servername
sle_pwd sle_pwd
sle_login sle_login
end type
global w_login w_login

on w_login.create
this.cb_1=create cb_1
this.st_3=create st_3
this.st_2=create st_2
this.st_1=create st_1
this.sle_servername=create sle_servername
this.sle_pwd=create sle_pwd
this.sle_login=create sle_login
this.Control[]={this.cb_1,&
this.st_3,&
this.st_2,&
this.st_1,&
this.sle_servername,&
this.sle_pwd,&
this.sle_login}
end on

on w_login.destroy
destroy(this.cb_1)
destroy(this.st_3)
destroy(this.st_2)
destroy(this.st_1)
destroy(this.sle_servername)
destroy(this.sle_pwd)
destroy(this.sle_login)
end on

type cb_1 from commandbutton within w_login
integer x = 1207
integer y = 712
integer width = 443
integer height = 112
integer taborder = 50
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "&Ok"
boolean default = true
end type

event clicked;s_register sr

sr.login = sle_login.text
sr.mdp  = sle_pwd.text
sr.servername = sle_servername.text
sr.dbms = "O84"


CloseWithReturn( parent, sr)
end event

type st_3 from statictext within w_login
integer x = 82
integer y = 520
integer width = 402
integer height = 84
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Serveur :"
boolean focusrectangle = false
end type

type st_2 from statictext within w_login
integer x = 87
integer y = 312
integer width = 402
integer height = 64
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Mdp :"
boolean focusrectangle = false
end type

type st_1 from statictext within w_login
integer x = 87
integer y = 104
integer width = 402
integer height = 64
integer textsize = -10
integer weight = 700
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
string text = "Login :"
boolean focusrectangle = false
end type

type sle_servername from singlelineedit within w_login
integer x = 608
integer y = 496
integer width = 1038
integer height = 112
integer taborder = 30
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

type sle_pwd from singlelineedit within w_login
integer x = 608
integer y = 288
integer width = 1038
integer height = 112
integer taborder = 20
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
boolean password = true
borderstyle borderstyle = stylelowered!
end type

type sle_login from singlelineedit within w_login
integer x = 608
integer y = 84
integer width = 1038
integer height = 112
integer taborder = 10
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
borderstyle borderstyle = stylelowered!
end type

u_trans.sru

Code: pb

$PBExportHeader$u_trans.sru
forward
global type u_trans from transaction
end type
end forward

global type u_trans from transaction
end type
global u_trans u_trans

type prototypes
subroutine REGISTER(string ALERTNAME) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"REGISTER~""
subroutine SIGNAL(string ALERTNAME, string ALERTMESSAGE) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"SIGNAL~""
subroutine WAITANY(ref string ALERTNAME, ref string ALERTMESSAGE, ref integer STATUS, long TIMEOUT) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"WAITANY~""
subroutine WAITONE(string ALERTNAME, ref string ALERTMESSAGE, ref integer STATUS, long TIMEOUT) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"WAITONE~""
subroutine REMOVE(string ALERTNAME) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"REMOVE~""
subroutine SET_DEFAULTS(integer POLLINGINTERVAL) RPCFUNC ALIAS FOR "~"SYS~".~"DBMS_ALERT~".~"SET_DEFAULTS~""
end prototypes
on u_trans.create
call super::create
TriggerEvent( this, "constructor" )
end on

on u_trans.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on


s_register.srs

Code: pb

$PBExportHeader$s_register.srs
global type s_register from structure
  string    dbms
  string    login
  string    mdp
  string    servername
  string    register
end type

n_cst_timer.sru

Code: pb

$PBExportHeader$n_cst_timer.sru
forward
global type n_cst_timer from timing
end type
end forward

global type n_cst_timer from timing
end type
global n_cst_timer n_cst_timer

type variables
n_cst_thread it_thread
end variables

forward prototypes
public subroutine uf_setthread (readonly n_cst_thread at_thread)
end prototypes

public subroutine uf_setthread (readonly n_cst_thread at_thread);it_thread = at_thread
end subroutine

on n_cst_timer.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_cst_timer.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

event timer;
If Not IsNull(it_thread ) Then
  it_thread.TriggerEvent("ue_timer")
End If
end event

d_output.srd

Code: pb

$PBExportHeader$d_output.srd
release 10;
datawindow(units=0 timer_interval=0 color=1090519039 processing=0 HTMLDW=no print.printername="" print.documentname="" print.orientation = 0 print.margin.left = 110 print.margin.right = 110 print.margin.top = 96 print.margin.bottom = 96 print.paper.source = 0 print.paper.size = 0 print.canusedefaultprinter=yes print.prompt=no print.buttons=no print.preview.buttons=no print.cliptext=no print.overrideprintjob=no print.collate=yes hidegrayline=no )
summary(height=0 color="536870912" )
footer(height=0 color="536870912" )
detail(height=84 color="536870912" )
table(column=(type=char(50) updatewhereclause=yes name=text dbname="text" )
 )
column(band=detail id=1 alignment="0" tabsequence=32766 border="0" color="33554432" x="5" y="4" height="76" width="5088" format="[general]" html.valueishtml="0"  name=text visible="1" edit.limit=0 edit.case=any edit.autoselect=yes edit.autohscroll=yes  font.face="Tahoma" font.height="-10" font.weight="400~tif( pos( text, ~"found~" ) > 0, 700, 400 )"  font.family="2" font.pitch="2" font.charset="0" background.mode="1" background.color="536870912" )
htmltable(border="1" )
htmlgen(clientevents="1" clientvalidation="1" clientcomputedfields="1" clientformatting="0" clientscriptable="0" generatejavascript="1" encodeselflinkargs="1" netscapelayers="0" )
xhtmlgen() cssgen(sessionspecific="0" )
xmlgen()
xsltgen()
jsgen()
export.xml(headgroups="1" includewhitespace="0" metadatatype=0 savemetadata=0 )
import.xml()
export.pdf(method=0 distill.custompostscript="0" xslfop.print="0" )
export.xhtml()


n_cst_thread.sru

Code: pb

$PBExportHeader$n_cst_thread.sru
$PBExportComments$Basic thread class
forward
global type n_cst_thread from nonvisualobject
end type
end forward

global type n_cst_thread from nonvisualobject
end type
global n_cst_thread n_cst_thread

type variables
Protected:
Boolean          ib_busy = FALSE
n_cst_threadmanager  inv_mgr
end variables

forward prototypes
public function boolean of_busy ()
public function integer of_setBusy (boolean ab_switch)
public function integer of_init ()
public function boolean of_isrunning ()
public function integer of_setmanager (readonly n_cst_threadmanager anv_mgr)
end prototypes

public function boolean of_busy ();RETURN ib_busy
end function

public function integer of_setBusy (boolean ab_switch);ib_busy = ab_switch
RETURN 1
end function

public function integer of_init ();
of_SetBusy( FALSE )
RETURN 1
end function

public function boolean of_isrunning ();RETURN inv_mgr.of_isRunning( )
end function

public function integer of_setmanager (readonly n_cst_threadmanager anv_mgr);inv_mgr = anv_mgr
RETURN 1
end function

on n_cst_thread.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_cst_thread.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on

n_cst_comm.sru

Code: pb

$PBExportHeader$n_cst_comm.sru
forward
global type n_cst_comm from nonvisualobject
end type
end forward

global type n_cst_comm from nonvisualobject
end type
global n_cst_comm n_cst_comm

type variables
Window  iw_requestor
end variables

forward prototypes
public subroutine of_sendmessage (string as_message)
public function integer of_setrequestor (window aw_reqwestor)
end prototypes

public subroutine of_sendmessage (string as_message);iw_requestor.EVENT DYNAMIC ue_message( as_message )
end subroutine

public function integer of_setrequestor (window aw_reqwestor);IF NOT IsValid( aw_reqwestor ) THEN
  RETURN -1
ELSE
  iw_requestor= aw_reqwestor
  RETURN 1
END IF
end function

on n_cst_comm.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_cst_comm.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on


n_cst_alert.sru

Code: pb

$PBExportHeader$n_cst_alert.sru
forward
global type n_cst_alert from n_cst_thread
end type
end forward

global type n_cst_alert from n_cst_thread
event ue_timer pbm_timer
end type
global n_cst_alert n_cst_alert

type variables
NonVisualObject  inv_comm
Integer        ii_id

protected:


boolean  ib_timer = FALSE

integer  in_timeout = 5

n_cst_timer it_timer

u_trans      it_threads_sqlca
string       is_alerttype
end variables

forward prototypes
public subroutine of_setcomm (nonvisualobject anv_comm)
public subroutine of_setid (integer ai_id)
private subroutine of_alert ()
public subroutine of_initalert (string as_alerttype, s_register as_register)
public subroutine of_deconnection ()
public subroutine of_stopalert ()
public subroutine of_initalert (s_register as_register)
public subroutine of_addalerttype (string as_alerttype)
public subroutine of_removealerttype (string as_alerttype)
end prototypes

event ue_timer;of_alert()

end event

public subroutine of_setcomm (nonvisualobject anv_comm);inv_comm = anv_comm
end subroutine

public subroutine of_setid (integer ai_id);ii_id = ai_id
end subroutine

private subroutine of_alert ();integer  ln_status
string  lt_alert_name = Space ( 40 )
string  lt_alert_message = Space ( 100 )

it_threads_sqlca.waitany ( lt_alert_name, lt_alert_message, ln_status, in_timeout )
COMMIT using it_threads_sqlca ;

CHOOSE CASE ln_status
    CASE 0
      inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + " : Type d'alerte: "+Upper ( lt_alert_name ) +" -> Message: "+ lt_alert_message )
    CASE 1
    CASE ELSE
      inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ": Status: " + String ( ln_status ))
END CHOOSE


end subroutine

public subroutine of_initalert (string as_alerttype, s_register as_register);it_threads_sqlca = create u_trans
it_threads_sqlca.DBMS          = as_register.dbms
it_threads_sqlca.Database     = as_register.servername
it_threads_sqlca.LogID          = as_register.login
it_threads_sqlca.LogPass       = as_register.mdp
it_threads_sqlca.ServerName   = as_register.servername
it_threads_sqlca.UserID         = as_register.login
it_threads_sqlca.DBPass       = as_register.mdp
is_alerttype        = as_alerttype

CONNECT Using it_threads_sqlca ;

it_threads_sqlca.Register ( as_alerttype+" ")
it_threads_sqlca.set_defaults( 1)

IF it_threads_sqlca.SQLCODE = 0 THEN
  inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ": Initialisé avec le type d'alerte : "+is_alerttype )
Else
  inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ":  Register" + it_threads_sqlca.SQLErrText )
END IF

COMMIT using it_threads_sqlca;


IF ib_timer THEN
  it_timer.stop( )
ELSE
  it_timer.start(10)
END IF

ib_timer = NOT ib_timer
  


end subroutine

public subroutine of_deconnection ();IF DBHandle ( it_threads_sqlca ) > 0 THEN
  Disconnect Using it_threads_sqlca ;
END IF

Destroy it_threads_sqlca
end subroutine

public subroutine of_stopalert ();IF ib_timer THEN
  it_timer.stop( )
  ib_timer = FALSE
END IF
inv_comm.DYNAMIC of_SendMessage( "--Terminé --")
end subroutine

public subroutine of_initalert (s_register as_register);it_threads_sqlca = create u_trans
it_threads_sqlca.DBMS          = as_register.dbms
it_threads_sqlca.Database     = as_register.servername
it_threads_sqlca.LogID          = as_register.login
it_threads_sqlca.LogPass       = as_register.mdp
it_threads_sqlca.ServerName   = as_register.servername
it_threads_sqlca.UserID         = as_register.login
it_threads_sqlca.DBPass       = as_register.mdp

CONNECT Using it_threads_sqlca ;



IF ib_timer THEN
  it_timer.stop( )
ELSE
  it_timer.start(10)
END IF

ib_timer = NOT ib_timer
  


end subroutine

public subroutine of_addalerttype (string as_alerttype);it_threads_sqlca.Register ( as_alerttype+" ")

IF it_threads_sqlca.SQLCODE = 0 THEN
  inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ": Initialisé avec le type d'alerte : "+as_alerttype )
Else
  inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ":  Register" + it_threads_sqlca.SQLErrText )
END IF

COMMIT using it_threads_sqlca;

end subroutine

public subroutine of_removealerttype (string as_alerttype);it_threads_sqlca.Remove ( as_alerttype+" ")

IF it_threads_sqlca.SQLCODE = 0 THEN
  inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ": Le type d'alerte : "+is_alerttype +" a été supprimé")
Else
  inv_comm.DYNAMIC of_SendMessage( "T" + String( ii_id ) + ":  Register" + it_threads_sqlca.SQLErrText )
END IF

COMMIT using it_threads_sqlca;

end subroutine

on n_cst_alert.create
call super::create
end on

on n_cst_alert.destroy
call super::destroy
end on

event destructor;call super::destructor;timer(0)

IF IsValid( it_threads_sqlca ) THEN
  Disconnect Using it_threads_sqlca ;
  Destroy it_threads_sqlca
END IF


end event

event constructor;call super::constructor;it_timer = create n_cst_timer
it_timer.uf_setthread(this)
end event


3. Voici un exemple que l’on peut exécuter sous sqlplus.

Attention, il y a un bug sur la récupération des files de messages et des messages eux-mêmes. Ils sont tronqués d’un caractère. Donc je rajoute un espace à la fin de chaque champ.

exec sys.dbms_alert.signal('Alerte1 ', 'test depuis sqlplus ');
exec sys.dbms_alert.signal('Alerte7' ,  'test depuis sqlplus ');
commit;

Dernière modification par JCZ (21-06-2007 16:57:30)


Face à l'agression, la puissance de l'intelligence

Hors ligne

 

#2 21-06-2007 13:15:22

pick ouic  
La bourse ou la vie ^^
Award: gearotter
Lieu: Massy-Verrières
Date d'inscription: 29-05-2006
Messages: 4659
Pépites: 945
Banque: 2,147,483,647
Site web

Re: [SOURCE] Multi thread & recup des messages ( alerte Oracle )

merci encore de participer au bon fonctionnement de ce petit forum   50


Connaitre son ignorance est une grande part de la connaissance.
http://animegifs.free.fr/anime/mazinger/mazinger.gif

Hors ligne

 

Pied de page des forums

Propulsé par FluxBB 1.2.22