$PBExportHeader$n_connection.sru forward global type n_connection from connection end type end forward global type n_connection from connection end type global n_connection n_connection type prototypes end prototypes type variables Boolean ib_registry = True String is_appname String is_company end variables forward prototypes public function string of_errmsg (long al_errcode) public function boolean of_connect (string as_host, string as_userid, string as_passwd) public subroutine of_disconnect () public function string of_get_ini (string as_section, string as_entry, string as_default) public function integer of_set_ini (string as_section, string as_entry, string as_value) public subroutine of_del_jagproperty (string as_entitytype, string as_entityname, string as_property) public function string of_get_jagproperty (string as_entitytype, string as_entityname, string as_property) public subroutine of_set_jagproperty (string as_entitytype, string as_entityname, string as_property, string as_value) end prototypes public function string of_errmsg (long al_errcode);// return message for the error code String ls_errmsg choose case al_errcode case 0 ls_errmsg = "" case 50 ls_errmsg = "Distributed service error" case 52 ls_errmsg = "Distributed communications error" case 53 ls_errmsg = "Requested server not active" case 54 ls_errmsg = "Server not accepting requests" case 55 ls_errmsg = "Request terminated abnormally" case 56 ls_errmsg = "Response to request incomplete" case 57 ls_errmsg = "Not connected" case 58 ls_errmsg = "Object instance does not exist" case 62 ls_errmsg = "Server busy" case 75 ls_errmsg = "Server forced client to disconnect" case 80 ls_errmsg = "Server timed out client connection" case 87 ls_errmsg = "Connection to server has been lost" case 92 ls_errmsg = "Required property is missing or invalid" case else ls_errmsg = "Unknown error: " + String(al_errcode) end choose Return ls_errmsg end function public function boolean of_connect (string as_host, string as_userid, string as_passwd);// connect to jaguar server Long ll_rc this.driver = "jaguar" this.location = "iiop://" + as_host + ":9000" this.userid = as_userid this.password = as_passwd ll_rc = this.ConnectToServer() If ll_rc <> 0 Then MessageBox("Connect to server failed!", this.of_errmsg(ll_rc)) Return False End If Return True end function public subroutine of_disconnect ();// disconnect from jaguar server this.DisconnectServer() end subroutine public function string of_get_ini (string as_section, string as_entry, string as_default);String ls_regkey, ls_regvalue, ls_filename If ib_registry Then // get value in registry ls_regkey = "HKEY_CURRENT_USER\Software\" + is_company ls_regkey += "\" + is_appname + "\" + as_section RegistryGet(ls_regkey, as_entry, ls_regvalue) If ls_regvalue = "" Then ls_regvalue = as_default End If Return ls_regvalue Else // get value in .ini file ls_filename = is_appname + ".ini" Return ProfileString(ls_filename, as_section, as_entry, as_default) End If end function public function integer of_set_ini (string as_section, string as_entry, string as_value);String ls_regkey, ls_filename If ib_registry Then // set value in registry ls_regkey = "HKEY_CURRENT_USER\Software\" + is_company ls_regkey += "\" + is_appname + "\" + as_section Return RegistrySet(ls_regkey, as_entry, as_value) Else // set value in .ini file ls_filename = is_appname + ".ini" Return SetProfileString(ls_filename, as_section, as_entry, as_value) End If end function public subroutine of_del_jagproperty (string as_entitytype, string as_entityname, string as_property);// Deletes the passed property from the Jaguar Repository Properties l_properties, l_newprops String ls_value Long ll_rc, ll_cnt, ll_max, ll_new // get all properties for the component TRY l_properties = g_repository.Lookup(as_entitytype, as_entityname) CATCH ( lookuperror lue_prp ) MessageBox(as_entitytype + " Lookup Error", & lue_prp.reason + " - " + lue_prp.text) Return END TRY // copy properties to new array ll_max = UpperBound(l_properties.Item) FOR ll_cnt = 1 TO ll_max If Lower(l_properties.Item[ll_cnt].Name) <> Lower(as_property) Then ll_new = UpperBound(l_newprops.Item) + 1 l_newprops.Item[ll_new] = l_properties.Item[ll_cnt] End If NEXT // update repository TRY g_repository.Define(as_entitytype, as_entityname, l_newprops.Item) CATCH ( updateerror lue_def ) MessageBox(as_entitytype + " Update Error", & lue_def.reason + " - " + lue_def.text) Return END TRY end subroutine public function string of_get_jagproperty (string as_entitytype, string as_entityname, string as_property);// Gets the value of the passed property from the Jaguar Repository. Properties l_properties String ls_value Long ll_rc, ll_cnt, ll_max // get all properties for the component TRY l_properties = g_repository.Lookup(as_entitytype, as_entityname) CATCH ( lookuperror lue_prp ) MessageBox(as_entitytype + " Lookup Error", & lue_prp.reason + " - " + lue_prp.text) Return "" END TRY // find the requested property ll_max = UpperBound(l_properties.Item) FOR ll_cnt = 1 TO ll_max If Lower(l_properties.Item[ll_cnt].Name) = Lower(as_property) Then ls_value = l_properties.Item[ll_cnt].Value Exit End If NEXT Return ls_value end function public subroutine of_set_jagproperty (string as_entitytype, string as_entityname, string as_property, string as_value);// Sets the value of the passed property in the Jaguar Repository Properties l_properties String ls_value Long ll_rc, ll_cnt, ll_max Boolean lb_found // get all properties for the component TRY l_properties = g_repository.Lookup(as_entitytype, as_entityname) CATCH ( lookuperror lue_prp ) MessageBox(as_entitytype + " Lookup Error", & lue_prp.reason + " - " + lue_prp.text) Return END TRY // find the requested property lb_found = False ll_max = UpperBound(l_properties.Item) FOR ll_cnt = 1 TO ll_max If Lower(l_properties.Item[ll_cnt].Name) = Lower(as_property) Then lb_found = True Exit End If NEXT // update property structure If lb_found Then l_properties.Item[ll_cnt].Value = as_value Else l_properties.Item[ll_cnt].Name = as_property l_properties.Item[ll_cnt].Value = as_value End If // update repository TRY g_repository.Define(as_entitytype, as_entityname, l_properties.Item) CATCH ( updateerror lue_def ) MessageBox(as_entitytype + " Update Error", & lue_def.reason + " - " + lue_def.text) Return END TRY end subroutine on n_connection.create call super::create TriggerEvent( this, "constructor" ) end on on n_connection.destroy TriggerEvent( this, "destructor" ) call super::destroy end on event constructor;Application la_app // default appname/company la_app = GetApplication() is_appname = la_app.AppName is_company = "TopWiz" end event
File: n_connection.sru
Size: 7114
Date: Tue, 22 Aug 2017 17:30:58 +0200
Size: 7114
Date: Tue, 22 Aug 2017 17:30:58 +0200
- connection n_connection(sru)
- of_connect (string as_host, string as_userid, string as_passwd) returns boolean
- of_del_jagproperty (string as_entitytype, string as_entityname, string as_property)
- of_disconnect ()
- of_errmsg (long al_errcode) returns string
- of_get_ini (string as_section, string as_entry, string as_default) returns string
- of_get_jagproperty (string as_entitytype, string as_entityname, string as_property) returns string
- of_set_ini (string as_section, string as_entry, string as_value) returns integer
- of_set_jagproperty (string as_entitytype, string as_entityname, string as_property, string as_value)