Form S_157FSS/3: Super-Server Connector
Name: S_157FSS
Description: RDMLX Standalone Demonstration Harness
Please note that this is a demonstration harness. Refer to VL_SAM003 for the actual general-purpose connector program.
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM BORDERICONS(Maximize+Minimize+SystemMenu) HEIGHT(385) LEFT(390) TOP(136) WIDTH(284);
DEFINE_COM CLASS(#VL_SAM003) NAME(#SERVER) BORDERICONS(Maximize+Minimize+SystemMenu) CAPTION('Connect to Server') FORMPOSITION(ScreenCenter) HEIGHT(225) LEFT(356) TOP(221) WIDTH(347);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_1) CAPTION(Connect) DISPLAYPOSITION(1) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(12) WIDTH(117);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_2) CAPTION(ConnectModal) DISPLAYPOSITION(2) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(2) TOP(47) WIDTH(117);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_3) CAPTION(Disconnect) DISPLAYPOSITION(3) HEIGHT(27) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(3) TOP(82) WIDTH(117);
DEFINE_COM CLASS(#STD_TEXTS.Visual) NAME(#GETSSN) CAPTION(uUsingSSN) DISPLAYPOSITION(4) HEIGHT(19) LABELTYPE(Caption) LEFT(136) MARGINLEFT(70) PARENT(#COM_OWNER) TABPOSITION(4) TOP(112) WIDTH(137);
DEFINE_COM CLASS(#STD_TEXTS.Visual) NAME(#GETCON) CAPTION(uConnected) DISPLAYPOSITION(5) HEIGHT(19) LABELTYPE(Caption) LEFT(136) MARGINLEFT(70) PARENT(#COM_OWNER) TABPOSITION(5) TOP(136) WIDTH(137);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_4) CAPTION('Refresh Properties') DISPLAYPOSITION(6) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(6) TOP(120) WIDTH(117);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#LTVW_1) DISPLAYPOSITION(7) HEIGHT(169) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(7) TOP(184) WIDTH(265);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) DISPLAYPOSITION(2) MINIMUMWIDTH(1) PARENT(#LTVW_1) SOURCE(#DEPTDESC) WIDTH(20) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) CAPTION(Code) CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#LTVW_1) SOURCE(#DEPTMENT) WIDTH(20);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_5) CAPTION('(Re)Load Departments') DISPLAYPOSITION(8) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(8) TOP(152) WIDTH(117);
* Form initialization;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
ENDROUTINE ;
* Demonstrate the uConnect method;
EVTROUTINE HANDLING(#PHBN_1.Click);
invoke #Server.UConnect;
ENDROUTINE ;
* Demonstrate the uConnectModal method;
EVTROUTINE HANDLING(#PHBN_2.Click);
invoke #Server.UConnectModal;
ENDROUTINE ;
* Demonstrate the uDisconnect method;
EVTROUTINE HANDLING(#PHBN_3.Click #com_owner.Closing);
invoke #Server.UDisconnect;
ENDROUTINE ;
* Demonstrate getting the uUsingSSN and uConnected properties;
EVTROUTINE HANDLING(#PHBN_4.Click);
set #getssn value(#Server.UUsingSSN);
set #getcon value(#Server.UConnected);
ENDROUTINE ;
* Demonstrate and indicate receiving a uConnectionCreated event ;
evtroutine handling(#Server.UConnectionCreated);
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK QUESTION *COMPONENT 'uConnectionCreated was signalled');
endroutine ;
* Demonstrate and indicate receiving a uConnectionDestroyed event ;
evtroutine handling(#Server.UConnectionDestroyed);
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK QUESTION *COMPONENT 'uConnectionDestroyed was signalled');
endroutine ;
* Clear and reload the department list view. DBMS access should route to currently connected server. ;
EVTROUTINE HANDLING(#PHBN_5.Click);
clr_list #ltvw_1;
select (#deptment #deptdesc) from_file(deptab);
add_entry #ltvw_1;
endselect;
ENDROUTINE;
END_COM ;
Name: VL_SAM003
Description: RDMLX General Purpose Super-Server Connector
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM CAPTION('Connect to Server') FORMPOSITION(ScreenCenter) HEIGHT(355) LAYOUTMANAGER(#ATLM_1) LEFT(355) TOP(146) VISUALSTYLE(#VS_NORM) WIDTH(317);
;
DEFINE_COM CLASS(#PRIM_TAB) NAME(#TAB_1) DISPLAYPOSITION(1) HEIGHT(328) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TOP(0) WIDTH(309);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_1) CAPTION('Connect') DISPLAYPOSITION(1) HEIGHT(302) LAYOUTMANAGER(#ATLM_4) LEFT(4) PARENT(#TAB_1) TABPOSITION(1) TOP(22) WIDTH(301);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_2) CAPTION('Options') DISPLAYPOSITION(2) HEIGHT(302) LAYOUTMANAGER(#FWLM_1) LEFT(4) PARENT(#TAB_1) TABPOSITION(2) TOP(22) WIDTH(301);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_3) CAPTION('Messages') DISPLAYPOSITION(3) HEIGHT(302) LAYOUTMANAGER(#ATLM_3) LEFT(4) PARENT(#TAB_1) TABPOSITION(3) TOP(22) WIDTH(301);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_6) CAPTION(' Operating System User ') DISPLAYPOSITION(1) HEIGHT(69) LEFT(0) PARENT(#TBSH_1) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(301);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_7) CAPTION(' Server ') DISPLAYPOSITION(2) HEIGHT(233) LEFT(0) PARENT(#TBSH_1) TABPOSITION(2) TABSTOP(False) TOP(69) WIDTH(301);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_USER) DISPLAYPOSITION(5) HEIGHT(19) LEFT(64) MAXLENGTH(10) PARENT(#GPBX_6) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(93);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_PASSW) DISPLAYPOSITION(1) HEIGHT(19) LEFT(64) MAXLENGTH(10) PARENT(#GPBX_6) PASSWORDCHAR('*') SHOWSELECTION(False) TABPOSITION(2) TOP(39) WIDTH(93);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('Profile') DISPLAYPOSITION(6) HEIGHT(17) LEFT(8) PARENT(#GPBX_6) TABPOSITION(6) TABSTOP(False) TOP(18) WIDTH(44);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('Password') DISPLAYPOSITION(2) HEIGHT(19) LEFT(8) PARENT(#GPBX_6) TABPOSITION(3) TABSTOP(False) TOP(39) WIDTH(51);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#CONMSG1) CAPTION('Connection in Progress') DISPLAYPOSITION(3) HEIGHT(20) LEFT(160) PARENT(#GPBX_6) TABPOSITION(4) TABSTOP(False) TOP(16) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(136);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#CONMSG2) CAPTION('Please Wait') DISPLAYPOSITION(4) HEIGHT(22) LEFT(188) PARENT(#GPBX_6) TABPOSITION(5) TABSTOP(False) TOP(38) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(81);
;
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CNL_BTN) BUTTONCANCEL(True) CAPTION('Cancel') DISPLAYPOSITION(2) LEFT(188) PARENT(#GPBX_7) TABPOSITION(6) TOP(80);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#ADM_BTN) CAPTION('Adminstration') DISPLAYPOSITION(6) LEFT(188) PARENT(#GPBX_7) TABPOSITION(5) TOP(49);
;
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_SERVR) CHARACTERCASE(Upper) DISPLAYPOSITION(3) HEIGHT(20) LEFT(64) MAXLENGTH(10) PARENT(#GPBX_7) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(88);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('Name ') DISPLAYPOSITION(5) HEIGHT(20) PARENT(#GPBX_7) TABPOSITION(7) TABSTOP(False) TOP(18) WIDTH(39);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) CAPTION(' Type ') DISPLAYPOSITION(1) HEIGHT(55) LEFT(6) PARENT(#GPBX_7) TABPOSITION(2) TABSTOP(False) TOP(47) WIDTH(151);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VIS_AS400) CAPTION('iSeries') DISPLAYPOSITION(1) HEIGHT(16) LEFT(8) PARENT(#GPBX_1) TABPOSITION(1) TOP(15);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VIS_OTHER) CAPTION('Other (eg: Windows NT)') DISPLAYPOSITION(2) HEIGHT(20) LEFT(8) PARENT(#GPBX_1) TABPOSITION(2) TOP(31) WIDTH(137);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CON_BTN) BUTTONDEFAULT(True) CAPTION('Connect') DISPLAYPOSITION(4) LEFT(188) PARENT(#GPBX_7) TABPOSITION(4) TOP(16);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) CAPTION(' Options ') DISPLAYPOSITION(2) HEIGHT(105) LEFT(0) PARENT(#TBSH_2) TABPOSITION(1) TABSTOP(False) TOP(88) WIDTH(126);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_COMIT) CAPTION('Commitment Control') DISPLAYPOSITION(2) HEIGHT(17) LEFT(7) PARENT(#GPBX_3) TABPOSITION(1) TOP(16) WIDTH(113);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_DBCS) CAPTION('DBCS Capable') DISPLAYPOSITION(4) HEIGHT(23) LEFT(7) PARENT(#GPBX_3) TABPOSITION(2) TOP(34) WIDTH(110);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_LOCKS) CAPTION('Divert Locks') DISPLAYPOSITION(3) HEIGHT(23) LEFT(7) PARENT(#GPBX_3) TABPOSITION(3) TOP(53) WIDTH(109);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_SHOWM) CAPTION('Startup Message') DISPLAYPOSITION(1) HEIGHT(23) LEFT(6) PARENT(#GPBX_3) TABPOSITION(4) TOP(74) WIDTH(106);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) CAPTION(' Conversion Tables ') DISPLAYPOSITION(1) HEIGHT(73) LEFT(0) PARENT(#TBSH_2) TABPOSITION(2) TABSTOP(False) WIDTH(191);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_CTAB) CHARACTERCASE(Upper) DISPLAYPOSITION(1) HEIGHT(19) LEFT(96) MAXLENGTH(10) PARENT(#GPBX_2) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(86);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_STAB) CHARACTERCASE(Upper) DISPLAYPOSITION(2) HEIGHT(19) LEFT(96) MAXLENGTH(10) PARENT(#GPBX_2) SHOWSELECTION(False) TABPOSITION(2) TOP(39) WIDTH(86);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_4) CAPTION('Client to Server') DISPLAYPOSITION(3) HEIGHT(25) LEFT(15) PARENT(#GPBX_2) TABPOSITION(4) TABSTOP(False) TOP(16) WIDTH(81);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_5) CAPTION('Server to Client') DISPLAYPOSITION(4) HEIGHT(26) LEFT(16) PARENT(#GPBX_2) TABPOSITION(3) TABSTOP(False) TOP(40) WIDTH(81);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_4) CAPTION(' Other Server Override Options ') DISPLAYPOSITION(3) HEIGHT(44) LEFT(0) PARENT(#TBSH_2) TABPOSITION(3) TABSTOP(False) TOP(198) WIDTH(291);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_XRUN) DISPLAYPOSITION(1) HEIGHT(19) LEFT(6) MAXLENGTH(150) PARENT(#GPBX_4) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(277);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_5) CAPTION('Messages') DISPLAYPOSITION(1) HEIGHT(302) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#TBSH_3) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(301);
DEFINE_COM CLASS(#PRIM_LTBX) NAME(#MESSAGES) DISPLAYPOSITION(1) HEIGHT(277) LEFT(4) PARENT(#GPBX_5) TABPOSITION(1) TOP(13) WIDTH(293);
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_1) DISPLAYPOSITION(1) PARENT(#MESSAGES) SOURCE(#STD_TEXTL) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_8) CAPTION(' Remote Database Details ') DISPLAYPOSITION(7) HEIGHT(116) LEFT(6) PARENT(#GPBX_7) TABPOSITION(3) TABSTOP(False) TOP(108) WIDTH(283);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_6) CAPTION('User Profile (if different to above)') DISPLAYPOSITION(1) HEIGHT(15) LEFT(9) PARENT(#GPBX_8) TABPOSITION(3) TABSTOP(False) TOP(20) WIDTH(159);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_7) CAPTION('Password (if different to above)') DISPLAYPOSITION(2) HEIGHT(17) LEFT(9) PARENT(#GPBX_8) TABPOSITION(5) TABSTOP(False) TOP(43) WIDTH(153);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_RUSER) DISPLAYPOSITION(3) HEIGHT(19) LEFT(168) MAXLENGTH(10) PARENT(#GPBX_8) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(108);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_RPASS) DISPLAYPOSITION(4) HEIGHT(20) LEFT(168) MAXLENGTH(10) PARENT(#GPBX_8) PASSWORDCHAR('*') SHOWSELECTION(False) TABPOSITION(2) TOP(40) WIDTH(108);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#CMBX_1) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(5) HEIGHT(22) LEFT(168) PARENT(#GPBX_8) TABPOSITION(4) TOP(62) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(109);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_8) CAPTION('Database Type') DISPLAYPOSITION(6) HEIGHT(17) PARENT(#GPBX_8) TABPOSITION(6) TABSTOP(False) TOP(67) WIDTH(145);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_1) DISPLAYPOSITION(1) PARENT(#CMBX_1) SOURCE(#STD_TEXTS) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_2) PARENT(#CMBX_1) SOURCE(#STD_TEXT) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_9) CAPTION('Database Name ') DISPLAYPOSITION(7) HEIGHT(17) LEFT(9) PARENT(#GPBX_8) TABPOSITION(8) TABSTOP(False) TOP(86) WIDTH(89);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_RDBID) DISPLAYPOSITION(8) HEIGHT(20) LEFT(168) MAXLENGTH(10) PARENT(#GPBX_8) SHOWSELECTION(False) TABPOSITION(7) TOP(86) WIDTH(108);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Center) MANAGE(#TAB_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#MESSAGES) PARENT(#ATLM_2);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Center) MANAGE(#GPBX_5) PARENT(#ATLM_3);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) MARGINTOP(10) SPACINGITEMS(5);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) MANAGE(#GPBX_3) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) MANAGE(#GPBX_2) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#GPBX_4) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_2) DIRECTION(TopToBottom);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#GPBX_6) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_5) MANAGE(#GPBX_7) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Top) MANAGE(#GPBX_6) PARENT(#ATLM_4);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#GPBX_7) PARENT(#ATLM_4);
;
* Local definitions. These could be placed into dictionary ;
;
define #use_type *char 1 default(A);
define #use_servr *char 10 default(*blanks);
define #use_comit *char 1 default(N);
define #use_dbcs *char 1 default(N);
define #use_locks *char 1 default(N);
define #use_showm *char 1 default(Y);
define #use_ctab *char 10 default(QEBCDIC);
define #use_stab *char 10 default(QASCII);
define #use_xrun *char 150 default(*blanks);
define #use_passw *char 10 default(*blanks);
define #uc_passw reffld(#use_passw);
define #use_user *char 10 default(*user);
define #uc_user reffld(#use_user);
define #use_RDBUT *char 20 default(SQLANYWHERE);
define #vis_rdbut reffld(#use_rdbut);
define #use_ruser *char 10;
define #use_rpass *char 10;
define #use_rdbid *char 10 default(LX_LANSA);
define #use_retc *char 2 ;
;
* Published Properties : uUsingSSN and uConnected;
;
define_pty name(uUsingSSN) get(GetuUsingSSN);
define_pty name(uConnected) get(GetuConnected);
;
* Published Events: uConnectionCreated and uConnectionDestoyed;
;
define_evt name(uConnectionCreated);
define_evt name(uConnectionDestroyed);
;
PTYROUTINE NAME(GetuConnected);
DEFINE_MAP FOR(*OUTPUT) CLASS(#STD_TEXTS) NAME(#GET_conn);
if '*sserver_connected = Y';
set #get_conn value(TRUE);
else ;
set #get_conn value(FALSE);
endif ;
endroutine ;
;
PTYROUTINE NAME(GetuUsingSSN);
DEFINE_MAP FOR(*OUTPUT) CLASS(#STD_TEXTS) NAME(#GET_SSN);
set #get_ssn value(*sserver_ssn);
endroutine ;
;
* Published Method : uConnect;
;
mthroutine uConnect ;
if '*sserver_connected = N';
invoke #com_owner.RestoreForm;
set #TBSH_1 Opened(True);
invoke #com_owner.ShowForm;
endif ;
endroutine ;
;
* Published Method : uConnectModal;
;
mthroutine uConnectModal ;
if '*sserver_connected = N';
invoke #com_owner.RestoreForm;
set #TBSH_1 Opened(True);
invoke #com_owner.ShowModalForm;
endif ;
endroutine ;
;
* Published Method : uDisconnect;
;
mthroutine uDisConnect ;
execute disconnect;
invoke #com_owner.CloseForm ;
endroutine ;
;
* Cancel button Handling;
;
evtroutine handling(#cnl_btn.Click);
execute disconnect;
invoke #com_owner.CloseForm ;
endroutine ;
;
* Connect Button Handling ;
;
EVTROUTINE HANDLING(#CON_BTN.Click);
execute connect;
ENDROUTINE ;
;
* Adminstrator Button Handling ;
;
EVTROUTINE HANDLING(#ADM_BTN.Click);
define #ov_retc *char 2;
use ov_system_service (start LCOADM32) to_get(#ov_retc);
if '#ov_retc *ne OK';
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK ERROR *COMPONENT 'Adminstrator (LCOADM32.EXE) could not be started');
endif ;
ENDROUTINE ;
;
* Form Initialization;
;
EVTROUTINE handling(#com_owner.Initialize);
execute Initialize;
ENDROUTINE ;
;
* Form Closing;
;
EVTROUTINE handling(#com_owner.closing);
execute getinput ;
endroutine ;
;
* Options Tab sheet being opened ;
;
evtroutine #TBSH_2.opening;
execute getinput;
if '#use_type = A';
set #GPBX_2 visible(true);
set #vis_dbcs enabled(true) ;
set (#vis_xrun #gpbx_4) visible(false);
else ;
set #GPBX_2 visible(false) ;
set #vis_dbcs enabled(false) ;
set (#vis_xrun #gpbx_4) visible(true);
endif ;
endroutine ;
;
* Message Tab Sheet being Opened ;
;
EVTROUTINE HANDLING(#TBSH_3.Opening);
if '*sserver_connected = Y';
message 'You are currently connected to a remote server';
else ;
message 'You are NOT currently connected to a remote server';
endif ;
Execute RouteMsgs;
ENDROUTINE ;
;
* Message Tab Sheet being Closed ;
;
EVTROUTINE HANDLING(#TBSH_3.Closing);
CLR_LIST NAMED(#MESSAGES);
ENDROUTINE ;
;
* Selection of iSeries or Other type of server by radio button;
;
EVTROUTINE HANDLING(#VIS_AS400.Click #VIS_OTHER.Click);
if '#vis_as400.buttonchecked = True';
set #gpbx_8 visible(false);
else ;
set #gpbx_8 visible(true);
endif ;
ENDROUTINE ;
;
* Item selected from the DBMS types combo box;
;
EVTROUTINE HANDLING(#CMBX_1.ItemGotFocus);
change #vis_rdbut #std_text;
change #use_rdbut #std_text;
ENDROUTINE ;
;
* Extracts all messages from queue and adds to list shown on messages tab;
;
Subroutine RouteMsgs;
DEFINE FIELD(#MSG_RETC) REFFLD(#USE_RETC);
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#MSG_RETC #STD_TEXTL);
DOWHILE COND('#msg_retc = OK');
ADD_ENTRY TO_LIST(#MESSAGES);
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#MSG_RETC #STD_TEXTL);
ENDWHILE ;
endroutine ;
;
* General purpose initializtion of component (rather than just form) ;
;
subroutine initialize;
define #initdone *char 1 default(N);
if '#initdone *ne Y';
set #com_owner CAPTION('Connect to Server') HEIGHT(364) WIDTH(349);
change (#use_rdbut #use_rdbid #use_type #use_servr #use_comit #use_dbcs #use_locks #use_showm #use_ctab #use_stab #use_xrun) *remembered_value_for_function;
execute addcmbx_1 ('SQL Anywhere' 'SQLANYWHERE') ;
execute addcmbx_1 ('SQL Server' 'MSSQLS') ;
execute addcmbx_1 ('Oracle (NT)' 'ODBCORACLE') ;
execute addcmbx_1 ('Oracle (Unix)' 'ORACLE') ;
execute setoutput;
change #initdone Y;
endif ;
endroutine ;
;
* Add a new entry to the DBMS types combo-box and set current selection;
;
subroutine addcmbx_1 ((#std_texts *received)(#std_text *received));
add_entry #cmbx_1;
if '#std_text = #use_rdbut';
SET #cmbx_1.CurrentItem Focus(True) ;
endif ;
endroutine ;
;
* Build additional X_RUN command details for non-AS400 type of sever;
;
subroutine addxrun((#wrk_key *received) (#wrk_str1 *received)(#wrk_str2 *received));
define #wrk_key *char 10;
define #wrk_str1 *char 50;
define #wrk_str2 *char 50;
if_null (#wrk_str1 #wrk_str2);
else ;
use bconcat(#full_xrun #wrk_key) (#full_xrun);
if_null #wrk_str1;
use tconcat (#full_xrun #wrk_str2) (#full_xrun);
else ;
use tconcat (#full_xrun #wrk_str1) (#full_xrun);
endif ;
endif ;
endroutine ;
;
* Attempt to establish a connection and handle error display;
;
subroutine connect;
define #sav_user reffld(#use_user);
execute initialize ;
execute getinput;
if '*sserver_connected = N';
set (#conmsg1 #conmsg2) visible(true) ;
USE BUILTIN(UPPERCASE) WITH_ARGS(#USE_USER) TO_GET(#UC_USER);
USE BUILTIN(UPPERCASE) WITH_ARGS(#USE_PASSW) TO_GET(#UC_PASSW);
CHANGE FIELD(#SAV_USER) TO(*USER);
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS(USER #UC_USER);
if '#use_type = A';
USE BUILTIN(DEFINE_OS_400_SERVER) WITH_ARGS(AS400 #USE_SERVR #USE_COMIT #USE_DBCS #USE_LOCKS #USE_SHOWM '20' #USE_CTAB #USE_STAB) TO_GET(#USE_RETC);
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(AS400 #UC_PASSW) TO_GET(#USE_RETC);
else ;
define #full_xrun *char 256 ;
change #full_xrun *blanks ;
execute addxrun ('DBUS=' #use_ruser #use_user) ;
execute addxrun ('PSWD=' #use_rpass #use_passw) ;
execute addxrun ('DBID=' #use_rdbid *blanks) ;
execute addxrun ('DBII=' #use_rdbid *blanks) ;
execute addxrun ('DBUT=' #use_rdbut *blanks) ;
use bconcat(#full_xrun #use_xrun) (#full_xrun);
USE BUILTIN(DEFINE_OTHER_SERVER) WITH_ARGS(OTHER #USE_SERVR #USE_LOCKS #USE_SHOWM #FULL_XRUN) to_get(#use_RETC);
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(OTHER #USE_PASSW) TO_GET(#USE_RETC);
endif ;
if '*sserver_connected = Y';
USE BUILTIN(CONNECT_FILE) WITH_ARGS('*' *sserver_ssn);
Invoke #com_owner.CloseForm;
Signal uConnectionCreated;
else ;
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS(USER #SAV_USER);
Execute RouteMsgs;
set #TBSH_3 opened(True);
endif ;
set (#conmsg1 #conmsg2) visible(False) ;
endif ;
endroutine ;
;
* Attempt to disconnect from current connection ;
;
subroutine disconnect;
execute initialize ;
execute getinput;
if '*sserver_connected = Y';
USE BUILTIN(DISCONNECT_FILE) WITH_ARGS('*' *sserver_ssn);
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS( *sserver_ssn) TO_GET(#USE_RETC);
Signal uConnectionDestroyed;
endif ;
ENDROUTINE ;
;
* Map from remembered fields/values into visual entities ;
;
subroutine setoutput;
set #vis_passw value(#use_passw) ;
set #vis_user value(#use_user);
if '#use_type = A';
set #vis_as400 buttonchecked(true);
set #gpbx_8 visible(false);
else ;
set #vis_other buttonchecked(true);
set #gpbx_8 visible(true);
endif ;
set #vis_servr value(#use_servr);
if '#use_comit = Y';
set #vis_comit buttonstate(checked);
else ;
set #vis_comit buttonstate(unchecked);
endif ;
if '#use_dbcs = Y';
set #vis_dbcs buttonstate(checked);
else ;
set #vis_dbcs buttonstate(unchecked);
endif ;
if '#use_locks = Y';
set #vis_locks buttonstate(checked);
else ;
set #vis_locks buttonstate(unchecked);
endif ;
if '#use_showm = Y';
set #vis_showm buttonstate(checked);
else ;
set #vis_showm buttonstate(unchecked);
endif ;
set #vis_ctab value(#use_ctab);
set #vis_stab value(#use_stab);
set #vis_xrun value(#use_xrun);
set #vis_ruser value(#use_ruser);
set #vis_rpass value(#use_rpass);
change #vis_rdbut #use_rdbut;
set #vis_rdbid value(#use_rdbid);
endroutine ;
;
* Map from visual entities into remembered fields/values ;
;
subroutine getinput;
change #use_passw #vis_passw.value;
change #use_user #vis_user.value;
if '#vis_as400.buttonchecked = True';
change #use_type A;
else ;
change #use_type O;
endif ;
change #use_servr #vis_servr.value;
if '#vis_comit.buttonstate = checked';
change #use_comit Y;
else ;
change #use_comit N;
endif ;
if '#vis_dbcs.buttonstate = checked';
change #use_dbcs Y;
else ;
change #use_dbcs N;
endif ;
if '#vis_locks.buttonstate = checked';
change #use_locks Y;
else ;
change #use_locks N;
endif ;
if '#vis_showm.buttonstate = checked';
change #use_showm Y;
else ;
change #use_showm N;
endif ;
change #use_ctab #vis_ctab.value;
change #use_stab #vis_stab.value;
change #use_xrun #vis_xrun.value;
change #use_ruser #vis_ruser.value;
change #use_rpass #vis_rpass.value;
change #use_rdbut #vis_rdbut;
change #use_rdbid #vis_rdbid.value;
endroutine ;
;
END_COM ;
Name: S_157FSS
Description: RDMLX Standalone Demonstration Harness
Please note that this is a demonstration harness. Refer to VL_SAM003 for the actual general-purpose connector program.
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM BORDERICONS(Maximize+Minimize+SystemMenu) HEIGHT(385) LEFT(390) TOP(136) WIDTH(284);
DEFINE_COM CLASS(#VL_SAM003) NAME(#SERVER) BORDERICONS(Maximize+Minimize+SystemMenu) CAPTION('Connect to Server') FORMPOSITION(ScreenCenter) HEIGHT(225) LEFT(356) TOP(221) WIDTH(347);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_1) CAPTION(Connect) DISPLAYPOSITION(1) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(1) TOP(12) WIDTH(117);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_2) CAPTION(ConnectModal) DISPLAYPOSITION(2) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(2) TOP(47) WIDTH(117);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_3) CAPTION(Disconnect) DISPLAYPOSITION(3) HEIGHT(27) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(3) TOP(82) WIDTH(117);
DEFINE_COM CLASS(#STD_TEXTS.Visual) NAME(#GETSSN) CAPTION(uUsingSSN) DISPLAYPOSITION(4) HEIGHT(19) LABELTYPE(Caption) LEFT(136) MARGINLEFT(70) PARENT(#COM_OWNER) TABPOSITION(4) TOP(112) WIDTH(137);
DEFINE_COM CLASS(#STD_TEXTS.Visual) NAME(#GETCON) CAPTION(uConnected) DISPLAYPOSITION(5) HEIGHT(19) LABELTYPE(Caption) LEFT(136) MARGINLEFT(70) PARENT(#COM_OWNER) TABPOSITION(5) TOP(136) WIDTH(137);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_4) CAPTION('Refresh Properties') DISPLAYPOSITION(6) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(6) TOP(120) WIDTH(117);
DEFINE_COM CLASS(#PRIM_LTVW) NAME(#LTVW_1) DISPLAYPOSITION(7) HEIGHT(169) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(7) TOP(184) WIDTH(265);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_1) DISPLAYPOSITION(2) MINIMUMWIDTH(1) PARENT(#LTVW_1) SOURCE(#DEPTDESC) WIDTH(20) WIDTHTYPE(Remainder);
DEFINE_COM CLASS(#PRIM_LVCL) NAME(#LVCL_2) CAPTION(Code) CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#LTVW_1) SOURCE(#DEPTMENT) WIDTH(20);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#PHBN_5) CAPTION('(Re)Load Departments') DISPLAYPOSITION(8) LEFT(8) PARENT(#COM_OWNER) TABPOSITION(8) TOP(152) WIDTH(117);
* Form initialization;
EVTROUTINE handling(#com_owner.Initialize);
SET #com_owner caption(*component_desc);
ENDROUTINE ;
* Demonstrate the uConnect method;
EVTROUTINE HANDLING(#PHBN_1.Click);
invoke #Server.UConnect;
ENDROUTINE ;
* Demonstrate the uConnectModal method;
EVTROUTINE HANDLING(#PHBN_2.Click);
invoke #Server.UConnectModal;
ENDROUTINE ;
* Demonstrate the uDisconnect method;
EVTROUTINE HANDLING(#PHBN_3.Click #com_owner.Closing);
invoke #Server.UDisconnect;
ENDROUTINE ;
* Demonstrate getting the uUsingSSN and uConnected properties;
EVTROUTINE HANDLING(#PHBN_4.Click);
set #getssn value(#Server.UUsingSSN);
set #getcon value(#Server.UConnected);
ENDROUTINE ;
* Demonstrate and indicate receiving a uConnectionCreated event ;
evtroutine handling(#Server.UConnectionCreated);
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK QUESTION *COMPONENT 'uConnectionCreated was signalled');
endroutine ;
* Demonstrate and indicate receiving a uConnectionDestroyed event ;
evtroutine handling(#Server.UConnectionDestroyed);
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK QUESTION *COMPONENT 'uConnectionDestroyed was signalled');
endroutine ;
* Clear and reload the department list view. DBMS access should route to currently connected server. ;
EVTROUTINE HANDLING(#PHBN_5.Click);
clr_list #ltvw_1;
select (#deptment #deptdesc) from_file(deptab);
add_entry #ltvw_1;
endselect;
ENDROUTINE;
END_COM ;
Name: VL_SAM003
Description: RDMLX General Purpose Super-Server Connector
FUNCTION OPTIONS(*DIRECT);
BEGIN_COM CAPTION('Connect to Server') FORMPOSITION(ScreenCenter) HEIGHT(355) LAYOUTMANAGER(#ATLM_1) LEFT(355) TOP(146) VISUALSTYLE(#VS_NORM) WIDTH(317);
;
DEFINE_COM CLASS(#PRIM_TAB) NAME(#TAB_1) DISPLAYPOSITION(1) HEIGHT(328) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(1) TOP(0) WIDTH(309);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_1) CAPTION('Connect') DISPLAYPOSITION(1) HEIGHT(302) LAYOUTMANAGER(#ATLM_4) LEFT(4) PARENT(#TAB_1) TABPOSITION(1) TOP(22) WIDTH(301);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_2) CAPTION('Options') DISPLAYPOSITION(2) HEIGHT(302) LAYOUTMANAGER(#FWLM_1) LEFT(4) PARENT(#TAB_1) TABPOSITION(2) TOP(22) WIDTH(301);
DEFINE_COM CLASS(#PRIM_TBSH) NAME(#TBSH_3) CAPTION('Messages') DISPLAYPOSITION(3) HEIGHT(302) LAYOUTMANAGER(#ATLM_3) LEFT(4) PARENT(#TAB_1) TABPOSITION(3) TOP(22) WIDTH(301);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_6) CAPTION(' Operating System User ') DISPLAYPOSITION(1) HEIGHT(69) LEFT(0) PARENT(#TBSH_1) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(301);
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_7) CAPTION(' Server ') DISPLAYPOSITION(2) HEIGHT(233) LEFT(0) PARENT(#TBSH_1) TABPOSITION(2) TABSTOP(False) TOP(69) WIDTH(301);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_USER) DISPLAYPOSITION(5) HEIGHT(19) LEFT(64) MAXLENGTH(10) PARENT(#GPBX_6) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(93);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_PASSW) DISPLAYPOSITION(1) HEIGHT(19) LEFT(64) MAXLENGTH(10) PARENT(#GPBX_6) PASSWORDCHAR('*') SHOWSELECTION(False) TABPOSITION(2) TOP(39) WIDTH(93);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_1) CAPTION('Profile') DISPLAYPOSITION(6) HEIGHT(17) LEFT(8) PARENT(#GPBX_6) TABPOSITION(6) TABSTOP(False) TOP(18) WIDTH(44);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_2) CAPTION('Password') DISPLAYPOSITION(2) HEIGHT(19) LEFT(8) PARENT(#GPBX_6) TABPOSITION(3) TABSTOP(False) TOP(39) WIDTH(51);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#CONMSG1) CAPTION('Connection in Progress') DISPLAYPOSITION(3) HEIGHT(20) LEFT(160) PARENT(#GPBX_6) TABPOSITION(4) TABSTOP(False) TOP(16) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(136);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#CONMSG2) CAPTION('Please Wait') DISPLAYPOSITION(4) HEIGHT(22) LEFT(188) PARENT(#GPBX_6) TABPOSITION(5) TABSTOP(False) TOP(38) VISIBLE(False) VISUALSTYLE(#VS_WARN) WIDTH(81);
;
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CNL_BTN) BUTTONCANCEL(True) CAPTION('Cancel') DISPLAYPOSITION(2) LEFT(188) PARENT(#GPBX_7) TABPOSITION(6) TOP(80);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#ADM_BTN) CAPTION('Adminstration') DISPLAYPOSITION(6) LEFT(188) PARENT(#GPBX_7) TABPOSITION(5) TOP(49);
;
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_SERVR) CHARACTERCASE(Upper) DISPLAYPOSITION(3) HEIGHT(20) LEFT(64) MAXLENGTH(10) PARENT(#GPBX_7) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(88);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_3) CAPTION('Name ') DISPLAYPOSITION(5) HEIGHT(20) PARENT(#GPBX_7) TABPOSITION(7) TABSTOP(False) TOP(18) WIDTH(39);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_1) CAPTION(' Type ') DISPLAYPOSITION(1) HEIGHT(55) LEFT(6) PARENT(#GPBX_7) TABPOSITION(2) TABSTOP(False) TOP(47) WIDTH(151);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VIS_AS400) CAPTION('iSeries') DISPLAYPOSITION(1) HEIGHT(16) LEFT(8) PARENT(#GPBX_1) TABPOSITION(1) TOP(15);
DEFINE_COM CLASS(#PRIM_RDBN) NAME(#VIS_OTHER) CAPTION('Other (eg: Windows NT)') DISPLAYPOSITION(2) HEIGHT(20) LEFT(8) PARENT(#GPBX_1) TABPOSITION(2) TOP(31) WIDTH(137);
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#CON_BTN) BUTTONDEFAULT(True) CAPTION('Connect') DISPLAYPOSITION(4) LEFT(188) PARENT(#GPBX_7) TABPOSITION(4) TOP(16);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_3) CAPTION(' Options ') DISPLAYPOSITION(2) HEIGHT(105) LEFT(0) PARENT(#TBSH_2) TABPOSITION(1) TABSTOP(False) TOP(88) WIDTH(126);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_COMIT) CAPTION('Commitment Control') DISPLAYPOSITION(2) HEIGHT(17) LEFT(7) PARENT(#GPBX_3) TABPOSITION(1) TOP(16) WIDTH(113);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_DBCS) CAPTION('DBCS Capable') DISPLAYPOSITION(4) HEIGHT(23) LEFT(7) PARENT(#GPBX_3) TABPOSITION(2) TOP(34) WIDTH(110);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_LOCKS) CAPTION('Divert Locks') DISPLAYPOSITION(3) HEIGHT(23) LEFT(7) PARENT(#GPBX_3) TABPOSITION(3) TOP(53) WIDTH(109);
DEFINE_COM CLASS(#PRIM_CKBX) NAME(#VIS_SHOWM) CAPTION('Startup Message') DISPLAYPOSITION(1) HEIGHT(23) LEFT(6) PARENT(#GPBX_3) TABPOSITION(4) TOP(74) WIDTH(106);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_2) CAPTION(' Conversion Tables ') DISPLAYPOSITION(1) HEIGHT(73) LEFT(0) PARENT(#TBSH_2) TABPOSITION(2) TABSTOP(False) WIDTH(191);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_CTAB) CHARACTERCASE(Upper) DISPLAYPOSITION(1) HEIGHT(19) LEFT(96) MAXLENGTH(10) PARENT(#GPBX_2) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(86);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_STAB) CHARACTERCASE(Upper) DISPLAYPOSITION(2) HEIGHT(19) LEFT(96) MAXLENGTH(10) PARENT(#GPBX_2) SHOWSELECTION(False) TABPOSITION(2) TOP(39) WIDTH(86);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_4) CAPTION('Client to Server') DISPLAYPOSITION(3) HEIGHT(25) LEFT(15) PARENT(#GPBX_2) TABPOSITION(4) TABSTOP(False) TOP(16) WIDTH(81);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_5) CAPTION('Server to Client') DISPLAYPOSITION(4) HEIGHT(26) LEFT(16) PARENT(#GPBX_2) TABPOSITION(3) TABSTOP(False) TOP(40) WIDTH(81);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_4) CAPTION(' Other Server Override Options ') DISPLAYPOSITION(3) HEIGHT(44) LEFT(0) PARENT(#TBSH_2) TABPOSITION(3) TABSTOP(False) TOP(198) WIDTH(291);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_XRUN) DISPLAYPOSITION(1) HEIGHT(19) LEFT(6) MAXLENGTH(150) PARENT(#GPBX_4) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(277);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_5) CAPTION('Messages') DISPLAYPOSITION(1) HEIGHT(302) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#TBSH_3) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(301);
DEFINE_COM CLASS(#PRIM_LTBX) NAME(#MESSAGES) DISPLAYPOSITION(1) HEIGHT(277) LEFT(4) PARENT(#GPBX_5) TABPOSITION(1) TOP(13) WIDTH(293);
DEFINE_COM CLASS(#PRIM_LBCL) NAME(#LBCL_1) DISPLAYPOSITION(1) PARENT(#MESSAGES) SOURCE(#STD_TEXTL) WIDTH(20);
;
DEFINE_COM CLASS(#PRIM_GPBX) NAME(#GPBX_8) CAPTION(' Remote Database Details ') DISPLAYPOSITION(7) HEIGHT(116) LEFT(6) PARENT(#GPBX_7) TABPOSITION(3) TABSTOP(False) TOP(108) WIDTH(283);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_6) CAPTION('User Profile (if different to above)') DISPLAYPOSITION(1) HEIGHT(15) LEFT(9) PARENT(#GPBX_8) TABPOSITION(3) TABSTOP(False) TOP(20) WIDTH(159);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_7) CAPTION('Password (if different to above)') DISPLAYPOSITION(2) HEIGHT(17) LEFT(9) PARENT(#GPBX_8) TABPOSITION(5) TABSTOP(False) TOP(43) WIDTH(153);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_RUSER) DISPLAYPOSITION(3) HEIGHT(19) LEFT(168) MAXLENGTH(10) PARENT(#GPBX_8) SHOWSELECTION(False) TABPOSITION(1) TOP(16) WIDTH(108);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_RPASS) DISPLAYPOSITION(4) HEIGHT(20) LEFT(168) MAXLENGTH(10) PARENT(#GPBX_8) PASSWORDCHAR('*') SHOWSELECTION(False) TABPOSITION(2) TOP(40) WIDTH(108);
DEFINE_COM CLASS(#PRIM_CMBX) NAME(#CMBX_1) COMBOBOXSTYLE(DropDownList) DISPLAYPOSITION(5) HEIGHT(22) LEFT(168) PARENT(#GPBX_8) TABPOSITION(4) TOP(62) VALUE('aAbBcCdDeEfFgGhHiIjJkKlLmMnNoO') WIDTH(109);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_8) CAPTION('Database Type') DISPLAYPOSITION(6) HEIGHT(17) PARENT(#GPBX_8) TABPOSITION(6) TABSTOP(False) TOP(67) WIDTH(145);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_1) DISPLAYPOSITION(1) PARENT(#CMBX_1) SOURCE(#STD_TEXTS) WIDTH(20);
DEFINE_COM CLASS(#PRIM_CBCL) NAME(#CBCL_2) PARENT(#CMBX_1) SOURCE(#STD_TEXT) VISIBLE(False) WIDTH(20);
DEFINE_COM CLASS(#PRIM_LABL) NAME(#LABL_9) CAPTION('Database Name ') DISPLAYPOSITION(7) HEIGHT(17) LEFT(9) PARENT(#GPBX_8) TABPOSITION(8) TABSTOP(False) TOP(86) WIDTH(89);
DEFINE_COM CLASS(#PRIM_EDIT) NAME(#VIS_RDBID) DISPLAYPOSITION(8) HEIGHT(20) LEFT(168) MAXLENGTH(10) PARENT(#GPBX_8) SHOWSELECTION(False) TABPOSITION(7) TOP(86) WIDTH(108);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Center) MANAGE(#TAB_1) PARENT(#ATLM_1);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Center) MANAGE(#MESSAGES) PARENT(#ATLM_2);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_3);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_3) ATTACHMENT(Center) MANAGE(#GPBX_5) PARENT(#ATLM_3);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_1) DIRECTION(TopToBottom) MARGINTOP(10) SPACINGITEMS(5);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_1) MANAGE(#GPBX_3) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_2) MANAGE(#GPBX_2) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_3) MANAGE(#GPBX_4) PARENT(#FWLM_1);
DEFINE_COM CLASS(#PRIM_FWLM) NAME(#FWLM_2) DIRECTION(TopToBottom);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_4) MANAGE(#GPBX_6) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_FWLI) NAME(#FWLI_5) MANAGE(#GPBX_7) PARENT(#FWLM_2);
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_4);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Top) MANAGE(#GPBX_6) PARENT(#ATLM_4);
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#GPBX_7) PARENT(#ATLM_4);
;
* Local definitions. These could be placed into dictionary ;
;
define #use_type *char 1 default(A);
define #use_servr *char 10 default(*blanks);
define #use_comit *char 1 default(N);
define #use_dbcs *char 1 default(N);
define #use_locks *char 1 default(N);
define #use_showm *char 1 default(Y);
define #use_ctab *char 10 default(QEBCDIC);
define #use_stab *char 10 default(QASCII);
define #use_xrun *char 150 default(*blanks);
define #use_passw *char 10 default(*blanks);
define #uc_passw reffld(#use_passw);
define #use_user *char 10 default(*user);
define #uc_user reffld(#use_user);
define #use_RDBUT *char 20 default(SQLANYWHERE);
define #vis_rdbut reffld(#use_rdbut);
define #use_ruser *char 10;
define #use_rpass *char 10;
define #use_rdbid *char 10 default(LX_LANSA);
define #use_retc *char 2 ;
;
* Published Properties : uUsingSSN and uConnected;
;
define_pty name(uUsingSSN) get(GetuUsingSSN);
define_pty name(uConnected) get(GetuConnected);
;
* Published Events: uConnectionCreated and uConnectionDestoyed;
;
define_evt name(uConnectionCreated);
define_evt name(uConnectionDestroyed);
;
PTYROUTINE NAME(GetuConnected);
DEFINE_MAP FOR(*OUTPUT) CLASS(#STD_TEXTS) NAME(#GET_conn);
if '*sserver_connected = Y';
set #get_conn value(TRUE);
else ;
set #get_conn value(FALSE);
endif ;
endroutine ;
;
PTYROUTINE NAME(GetuUsingSSN);
DEFINE_MAP FOR(*OUTPUT) CLASS(#STD_TEXTS) NAME(#GET_SSN);
set #get_ssn value(*sserver_ssn);
endroutine ;
;
* Published Method : uConnect;
;
mthroutine uConnect ;
if '*sserver_connected = N';
invoke #com_owner.RestoreForm;
set #TBSH_1 Opened(True);
invoke #com_owner.ShowForm;
endif ;
endroutine ;
;
* Published Method : uConnectModal;
;
mthroutine uConnectModal ;
if '*sserver_connected = N';
invoke #com_owner.RestoreForm;
set #TBSH_1 Opened(True);
invoke #com_owner.ShowModalForm;
endif ;
endroutine ;
;
* Published Method : uDisconnect;
;
mthroutine uDisConnect ;
execute disconnect;
invoke #com_owner.CloseForm ;
endroutine ;
;
* Cancel button Handling;
;
evtroutine handling(#cnl_btn.Click);
execute disconnect;
invoke #com_owner.CloseForm ;
endroutine ;
;
* Connect Button Handling ;
;
EVTROUTINE HANDLING(#CON_BTN.Click);
execute connect;
ENDROUTINE ;
;
* Adminstrator Button Handling ;
;
EVTROUTINE HANDLING(#ADM_BTN.Click);
define #ov_retc *char 2;
use ov_system_service (start LCOADM32) to_get(#ov_retc);
if '#ov_retc *ne OK';
USE BUILTIN(MESSAGE_BOX_SHOW) WITH_ARGS(OK OK ERROR *COMPONENT 'Adminstrator (LCOADM32.EXE) could not be started');
endif ;
ENDROUTINE ;
;
* Form Initialization;
;
EVTROUTINE handling(#com_owner.Initialize);
execute Initialize;
ENDROUTINE ;
;
* Form Closing;
;
EVTROUTINE handling(#com_owner.closing);
execute getinput ;
endroutine ;
;
* Options Tab sheet being opened ;
;
evtroutine #TBSH_2.opening;
execute getinput;
if '#use_type = A';
set #GPBX_2 visible(true);
set #vis_dbcs enabled(true) ;
set (#vis_xrun #gpbx_4) visible(false);
else ;
set #GPBX_2 visible(false) ;
set #vis_dbcs enabled(false) ;
set (#vis_xrun #gpbx_4) visible(true);
endif ;
endroutine ;
;
* Message Tab Sheet being Opened ;
;
EVTROUTINE HANDLING(#TBSH_3.Opening);
if '*sserver_connected = Y';
message 'You are currently connected to a remote server';
else ;
message 'You are NOT currently connected to a remote server';
endif ;
Execute RouteMsgs;
ENDROUTINE ;
;
* Message Tab Sheet being Closed ;
;
EVTROUTINE HANDLING(#TBSH_3.Closing);
CLR_LIST NAMED(#MESSAGES);
ENDROUTINE ;
;
* Selection of iSeries or Other type of server by radio button;
;
EVTROUTINE HANDLING(#VIS_AS400.Click #VIS_OTHER.Click);
if '#vis_as400.buttonchecked = True';
set #gpbx_8 visible(false);
else ;
set #gpbx_8 visible(true);
endif ;
ENDROUTINE ;
;
* Item selected from the DBMS types combo box;
;
EVTROUTINE HANDLING(#CMBX_1.ItemGotFocus);
change #vis_rdbut #std_text;
change #use_rdbut #std_text;
ENDROUTINE ;
;
* Extracts all messages from queue and adds to list shown on messages tab;
;
Subroutine RouteMsgs;
DEFINE FIELD(#MSG_RETC) REFFLD(#USE_RETC);
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#MSG_RETC #STD_TEXTL);
DOWHILE COND('#msg_retc = OK');
ADD_ENTRY TO_LIST(#MESSAGES);
USE BUILTIN(GET_MESSAGE) WITH_ARGS(Y) TO_GET(#MSG_RETC #STD_TEXTL);
ENDWHILE ;
endroutine ;
;
* General purpose initializtion of component (rather than just form) ;
;
subroutine initialize;
define #initdone *char 1 default(N);
if '#initdone *ne Y';
set #com_owner CAPTION('Connect to Server') HEIGHT(364) WIDTH(349);
change (#use_rdbut #use_rdbid #use_type #use_servr #use_comit #use_dbcs #use_locks #use_showm #use_ctab #use_stab #use_xrun) *remembered_value_for_function;
execute addcmbx_1 ('SQL Anywhere' 'SQLANYWHERE') ;
execute addcmbx_1 ('SQL Server' 'MSSQLS') ;
execute addcmbx_1 ('Oracle (NT)' 'ODBCORACLE') ;
execute addcmbx_1 ('Oracle (Unix)' 'ORACLE') ;
execute setoutput;
change #initdone Y;
endif ;
endroutine ;
;
* Add a new entry to the DBMS types combo-box and set current selection;
;
subroutine addcmbx_1 ((#std_texts *received)(#std_text *received));
add_entry #cmbx_1;
if '#std_text = #use_rdbut';
SET #cmbx_1.CurrentItem Focus(True) ;
endif ;
endroutine ;
;
* Build additional X_RUN command details for non-AS400 type of sever;
;
subroutine addxrun((#wrk_key *received) (#wrk_str1 *received)(#wrk_str2 *received));
define #wrk_key *char 10;
define #wrk_str1 *char 50;
define #wrk_str2 *char 50;
if_null (#wrk_str1 #wrk_str2);
else ;
use bconcat(#full_xrun #wrk_key) (#full_xrun);
if_null #wrk_str1;
use tconcat (#full_xrun #wrk_str2) (#full_xrun);
else ;
use tconcat (#full_xrun #wrk_str1) (#full_xrun);
endif ;
endif ;
endroutine ;
;
* Attempt to establish a connection and handle error display;
;
subroutine connect;
define #sav_user reffld(#use_user);
execute initialize ;
execute getinput;
if '*sserver_connected = N';
set (#conmsg1 #conmsg2) visible(true) ;
USE BUILTIN(UPPERCASE) WITH_ARGS(#USE_USER) TO_GET(#UC_USER);
USE BUILTIN(UPPERCASE) WITH_ARGS(#USE_PASSW) TO_GET(#UC_PASSW);
CHANGE FIELD(#SAV_USER) TO(*USER);
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS(USER #UC_USER);
if '#use_type = A';
USE BUILTIN(DEFINE_OS_400_SERVER) WITH_ARGS(AS400 #USE_SERVR #USE_COMIT #USE_DBCS #USE_LOCKS #USE_SHOWM '20' #USE_CTAB #USE_STAB) TO_GET(#USE_RETC);
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(AS400 #UC_PASSW) TO_GET(#USE_RETC);
else ;
define #full_xrun *char 256 ;
change #full_xrun *blanks ;
execute addxrun ('DBUS=' #use_ruser #use_user) ;
execute addxrun ('PSWD=' #use_rpass #use_passw) ;
execute addxrun ('DBID=' #use_rdbid *blanks) ;
execute addxrun ('DBII=' #use_rdbid *blanks) ;
execute addxrun ('DBUT=' #use_rdbut *blanks) ;
use bconcat(#full_xrun #use_xrun) (#full_xrun);
USE BUILTIN(DEFINE_OTHER_SERVER) WITH_ARGS(OTHER #USE_SERVR #USE_LOCKS #USE_SHOWM #FULL_XRUN) to_get(#use_RETC);
USE BUILTIN(CONNECT_SERVER) WITH_ARGS(OTHER #USE_PASSW) TO_GET(#USE_RETC);
endif ;
if '*sserver_connected = Y';
USE BUILTIN(CONNECT_FILE) WITH_ARGS('*' *sserver_ssn);
Invoke #com_owner.CloseForm;
Signal uConnectionCreated;
else ;
USE BUILTIN(SET_SESSION_VALUE) WITH_ARGS(USER #SAV_USER);
Execute RouteMsgs;
set #TBSH_3 opened(True);
endif ;
set (#conmsg1 #conmsg2) visible(False) ;
endif ;
endroutine ;
;
* Attempt to disconnect from current connection ;
;
subroutine disconnect;
execute initialize ;
execute getinput;
if '*sserver_connected = Y';
USE BUILTIN(DISCONNECT_FILE) WITH_ARGS('*' *sserver_ssn);
USE BUILTIN(DISCONNECT_SERVER) WITH_ARGS( *sserver_ssn) TO_GET(#USE_RETC);
Signal uConnectionDestroyed;
endif ;
ENDROUTINE ;
;
* Map from remembered fields/values into visual entities ;
;
subroutine setoutput;
set #vis_passw value(#use_passw) ;
set #vis_user value(#use_user);
if '#use_type = A';
set #vis_as400 buttonchecked(true);
set #gpbx_8 visible(false);
else ;
set #vis_other buttonchecked(true);
set #gpbx_8 visible(true);
endif ;
set #vis_servr value(#use_servr);
if '#use_comit = Y';
set #vis_comit buttonstate(checked);
else ;
set #vis_comit buttonstate(unchecked);
endif ;
if '#use_dbcs = Y';
set #vis_dbcs buttonstate(checked);
else ;
set #vis_dbcs buttonstate(unchecked);
endif ;
if '#use_locks = Y';
set #vis_locks buttonstate(checked);
else ;
set #vis_locks buttonstate(unchecked);
endif ;
if '#use_showm = Y';
set #vis_showm buttonstate(checked);
else ;
set #vis_showm buttonstate(unchecked);
endif ;
set #vis_ctab value(#use_ctab);
set #vis_stab value(#use_stab);
set #vis_xrun value(#use_xrun);
set #vis_ruser value(#use_ruser);
set #vis_rpass value(#use_rpass);
change #vis_rdbut #use_rdbut;
set #vis_rdbid value(#use_rdbid);
endroutine ;
;
* Map from visual entities into remembered fields/values ;
;
subroutine getinput;
change #use_passw #vis_passw.value;
change #use_user #vis_user.value;
if '#vis_as400.buttonchecked = True';
change #use_type A;
else ;
change #use_type O;
endif ;
change #use_servr #vis_servr.value;
if '#vis_comit.buttonstate = checked';
change #use_comit Y;
else ;
change #use_comit N;
endif ;
if '#vis_dbcs.buttonstate = checked';
change #use_dbcs Y;
else ;
change #use_dbcs N;
endif ;
if '#vis_locks.buttonstate = checked';
change #use_locks Y;
else ;
change #use_locks N;
endif ;
if '#vis_showm.buttonstate = checked';
change #use_showm Y;
else ;
change #use_showm N;
endif ;
change #use_ctab #vis_ctab.value;
change #use_stab #vis_stab.value;
change #use_xrun #vis_xrun.value;
change #use_ruser #vis_ruser.value;
change #use_rpass #vis_rpass.value;
change #use_rdbut #vis_rdbut;
change #use_rdbid #vis_rdbid.value;
endroutine ;
;
END_COM ;