Pas d'inquiétude, avec PBAdonf, c'est dans la poche ! ^^

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