Le forum (ô combien francophone) des utilisateurs de Powerbuilder.
Pages: 1
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
$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
$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
$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
$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
$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
$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
$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
$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
$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
$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
$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
$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
$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
$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)
Hors ligne
merci encore de participer au bon fonctionnement de ce petit forum 50
Hors ligne
Pages: 1