l,ve run into same the same issue, active link tables that need to connected to different SQL sources. The following function will update the named connection string used by a list of active link tables. The function looks up the named connection from table where the user can save a number of connection strings you will need to edit this part of the code.
Code:
'Date Created: 22-Sep-2016 08:07:27 PM
'Last Updated: 27-Sep-2016 10:43:01 AM
'Created By : verboopa2
'Updated By : verboopa2
'------------
'zLNKadjust
'------------
'Function to adjust the NAMED CONNECTION string in a list of Active Link Tables.
'Tables must be defined with a named connection when creating the Active link tables
'Script searches the *.DBP file for the following string and updates it.
'<ConnectionString="::Name::NSES_Test_Site1">
'The path to the files are hard coded in the *.DBP file but do not appear to be consulted
'
'DialogTtl - Tital for Dialogs produced by this function reflects what Active Line Tables are being adjusted
'TableList - List of Active Link Tables to Update Named Connection In
'SiteSys - The Connection Type Site or System that Active Link Tables are connecting to
'RETURNS - nothing and errors are handled by this function, calling function is just expected to provide list of tables
FUNCTION zLNKadjust AS C (DialogTtl as C, TableList AS C, SiteSys as C)
'FOR DEBUGGING
'DialogTtl = "Set ADT edit Site (ADT-EditSite)"
'TableList =<<%txt%
'l_hisorders
'l_hispatients
'l_hisvisits
'%txt%
'SiteSys = "Site"
'---------------------
'// Set Debug Flags --
'---------------------
DIM Debug as C = "t" 'use following statement to check for debug flag: if ("m" $ Debug)
DbgSet(type::xbasicmodule.get_current(),Debug) 'set debug values in deployed enviroments
's - skip checking existing Named Connections, used force reset of Named Connections
'u - Error out if Named Connection is not recognised NOT recommended once deployed
't - trace out the Connect string lines as it is altered
'w - skip rewritting the Altered .DBP files
'------------------------------
'// Set up for Error handler --
'------------------------------
ON ERROR GOTO ERRORHANDLER
'------------------------------------
'// Get existing Named Connections --
'------------------------------------
'Section gets the Named connection used on the Local or Shadowed
'and Master copies of Tables if they exist does sveral checks to verify
'Named Connections are cosistant and exist.
DIM LclCnct as C 'Connection used by this Local installation
DIM Master as L = .F. 'Master copy and Shadow copy situation
DIM MstCnct as C 'Connection used in MAster table if Shadowed install
DIM FileName as C 'The Link Table Data Base Pointer File
DIM InstallType as C 'Installation Connection being adjusted in
DIM Temp as C 'Temporary string
Master = .NOT. isnull(a5.Get_Master_Name()) 'Set falg for Master Shadow situation
IF .NOT. ("s" $ Debug)
IF Master 'There is a master get its Connection Names from it
InstallType = "Master"
FOR EACH Line in TableList 'Check connenction used for each Link Table in list
FileName = file.filename_parse(a5.Get_Master_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,"",Debug)
IF isnull(Temp)
error_generate("Unable to determine Named Connection")
ELSEIF (MstCnct <> Temp) .AND. (MstCnct <> "")
error_generate("Mismatched Named Connections")
ELSE
MstCnct = Temp
end if
ELSE
error_generate("File missing")
end if
NEXT
MstSiteName = lookup(zGetTblName("a-config"),"Connectionstring =" + Quote(MstCnct),"Name")
IF isnull(MstSiteName)
IF ("u" $ Debug)
error_generate("Unrecognized Named Connection: " + MstCnct)
ELSE
MstSiteName = "<< Requires Reset >>"
end if
end if
InstallType = "Shadow" 'We have checked master install Connections
ELSE 'so local is really shadow copy
InstallType = "Local" 'No master not a shadow copy
end if
'Check connection for each Link Table in
FOR EACH Line in TableList 'Local table which can be shadowed table
FileName = file.filename_parse(a5.Get_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,"",Debug)
IF isnull(Temp)
error_generate("Unable to determine Named Connection")
ELSEIF (LclCnct <> Temp) .AND. (LclCnct <> "")
error_generate("Mismatched Named Connections")
ELSE
LclCnct = Temp
end if
ELSE
error_generate("File missing")
end if
NEXT
LclSiteName = lookup(zGetTblName("a-config"),"Connectionstring =" + Quote(LclCnct),"Name")
IF ("u" $ Debug) .AND. isnull(LclSiteName)
IF ("u" $ Debug)
error_generate(*concat_lines("Unrecognized Named Connection",LclCnct))
ELSE
LclSiteName = "<< Requires Reset >>"
end if
end if
end if
'------------------------------------
'// Let User Select Site or System --
'------------------------------------
DIM MstUpdate as L
DIM Result as C
DIM Connection as C
ConnectionList = table.external_record_content_get("a-config","Name","","type = " + Quote(SiteSys))
Dialog =<<%dlg%
{region}
{wrap=80}
If you are using a Shadow installation you can optionally update the master installation.;
Additional shadow installations must use this same script to updated selected installation. The Refresh Shadow Installation can be used to get updates from the Master Installation.
All forms using these Connections must be closed and reopened before changes take effect.
{endregion};
{region}
{staticConditionalSection:1:Master}
Shadow Installation {Insert_SiteSys}:| [%r%.40LclSiteName];
Master Installation {Insert_SiteSys}:| [%r%.40MstSiteName];
Update Master Installation:| (5MstUpdate);
{end_staticConditionalSection:1}
{staticConditionalSection:2:.NOT.Master}
Local Installation {Insert_SiteSys}:| [%r%.40LclSiteName];
{end_staticConditionalSection:2}
Set Installation\(s) to {Insert_SiteSys}:| [.40,5Connection^#ConnectionList];
{endregion};
{line=1,0};
{region}
<*15&Proceed!Proceed> <15&Exit!exit>
{endregion};
%dlg%
DIM sr as C 'control what gets subsituted
sr =<<%txt%
{Insert_SiteSys} = SiteSys
%txt%
Dialog = stritran_multi_expressions(Dialog,sr) 'Subsitute in some variables
Code =<<%code%
if a_dlg_button = "proceed" then 'Used to proceed after dialog
Mess = ""
IF isnull(Connection)
Mess = *concat_lines(Mess,"A " + SiteSys + "Connection Must be selected")
end if
'..... more checks here ...
IF .NOT. isnull(Mess)
ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK)
a_dlg_button = ""
end if
end if
%code%
Result = ui_dlg_box(DialogTtl,Dialog,Code) 'present Dialog
if Result <>"Proceed" then 'do we proceed
end
end if
'-----------------------------
'// Update Named Connection --
'-----------------------------
InstallType = "Both"
FileName = ""
NewConnection = alltrim(lookup(zGetTblName("a-config"),"Name =" + Quote(Connection),"Connectionstring"))
IF isnull(NewConnection)
error_generate(*concat_lines("Unrecognized Connection selected",Connection))
end if
IF Master .AND. MstUpdate 'Do we updtae Named Connections in master files
InstallType = "Master"
FOR EACH Line in TableList 'Update Name Connection in each file
FileName = file.filename_parse(a5.Get_Master_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,NewConnection,Debug)
IF isnull(Temp)
error_generate("Unable to set new Named Connection")
end if
ELSE
error_generate("File missing")
end if
NEXT
InstallType = "Shadow" 'We have updated master install Named Connections
ELSE 'So local is really shadow copy
InstallType = "Local" 'No master not a shadow copy but just local
end if
'Update Named Connection in each
FOR EACH Line in TableList 'Local table which can be shadowed table
FileName = file.filename_parse(a5.Get_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,NewConnection,Debug)
IF isnull(Temp)
error_generate("Unable to set new Named Connection")
end if
ELSE
error_generate("File missing")
end if
NEXT
END FUNCTION
'FOR DEBUGGING
'END
'----------------------
'// Support Function --
'----------------------
'Locate and optionally replace Named Connection in Active Link Table
'Debug - Debug flag set in calling script/function
'FileName - Name of file must include full path and .DBP extension
'NewConnection - Optional new Named Connection to install if null just return existing named connection
'RETURNS - Existing named connection NULL if unable to determine Named Connection
'
'When debugging scripts that use String Scanner Objects
' the following watch variable is very useful
'SS.GetToOffset() + "*" + SS.GetRemainder()
FUNCTION CnctName as C(Debug as C, FileName as C, NewConnection as C = "")
DIM txt as C
DIM SS as P
txt = GET_FROM_FILE(FileName)
SS = stringscanner.create(txt)
IF SS.SkiptoString("<ConnectionString=\"::Name::")
SS.ScanOverSmatch("<ConnectionString=\"::Name::")
CnctName = SS.ScanToString("\"")
IF .NOT.(isnull(CnctName).OR.isnull(NewConnection)) 'Do we place in a new Named Connection
IF ("t" $ Debug) 'Trace the Connection line before rename
zTraceStamp(type::xbasicmodule.get_current())
trace.WriteLn("File: " + FileName)
trace.WriteLn("Orginal Named Connection Line")
txt = SS.GetLineText()
trace.WriteLn(txt)
end if
SS.SkipOver(-1 * LEN(CnctName)) 'Move back over the Named Connection found
SS.Replace(NewConnection,LEN(CnctName)) 'New Named Connection replaced charcters
IF ("t" $ Debug) 'Trace the Connection line after rename
zTraceStamp(type::xbasicmodule.get_current())
trace.WriteLn("File: " + FileName)
trace.WriteLn("Altered Named Connection Line")
txt = SS.GetLineText()
trace.WriteLn(txt)
end if
SS.Reset() 'Get the modified file and rewrite it
txt = SS.GetRemainder()
SAVE_TO_FILE(txt,FileName,.F.)
end if
ELSE
CnctName = ""
end if
END FUNCTION
'-------------------
'// ERROR Handler --
'-------------------
ERRORHANDLER:
ON ERROR GOTO 0 'No more special error traps that continue the code
Mess =<<%txt%
ERROR
{error_text_get()}
FileName: {FileName}
Install Type: {InstallType}
Script: {error_script_get()}
Line: {error_line_number_get()}
%txt%
Mess = Evaluate_String(Mess)
ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK)
zLogAdd(Mess)
END
The above function makes use of following function.
Code:
'Date Created: 22-Sep-2016 08:07:27 PM
'Last Updated: 27-Sep-2016 10:43:01 AM
'Created By : verboopa2
'Updated By : verboopa2
'------------
'zLNKadjust
'------------
'Function to adjust the NAMED CONNECTION string in a list of Active Link Tables.
'Tables must be defined with a named connection when creating the Active link tables
'Script searches the *.DBP file for the following string and updates it.
'<ConnectionString="::Name::NSES_Test_Site1">
'The path to the files are hard coded in the *.DBP file but do not appear to be consulted
'
'DialogTtl - Tital for Dialogs produced by this function reflects what Active Line Tables are being adjusted
'TableList - List of Active Link Tables to Update Named Connection In
'SiteSys - The Connection Type Site or System that Active Link Tables are connecting to
'RETURNS - nothing and errors are handled by this function, calling function is just expected to provide list of tables
FUNCTION zLNKadjust AS C (DialogTtl as C, TableList AS C, SiteSys as C)
'FOR DEBUGGING
'DialogTtl = "Set ADT edit Site (ADT-EditSite)"
'TableList =<<%txt%
'l_hisorders
'l_hispatients
'l_hisvisits
'%txt%
'SiteSys = "Site"
'---------------------
'// Set Debug Flags --
'---------------------
DIM Debug as C = "t" 'use following statement to check for debug flag: if ("m" $ Debug)
DbgSet(type::xbasicmodule.get_current(),Debug) 'set debug values in deployed enviroments
's - skip checking existing Named Connections, used force reset of Named Connections
'u - Error out if Named Connection is not recognised NOT recommended once deployed
't - trace out the Connect string lines as it is altered
'w - skip rewritting the Altered .DBP files
'------------------------------
'// Set up for Error handler --
'------------------------------
ON ERROR GOTO ERRORHANDLER
'------------------------------------
'// Get existing Named Connections --
'------------------------------------
'Section gets the Named connection used on the Local or Shadowed
'and Master copies of Tables if they exist does sveral checks to verify
'Named Connections are cosistant and exist.
DIM LclCnct as C 'Connection used by this Local installation
DIM Master as L = .F. 'Master copy and Shadow copy situation
DIM MstCnct as C 'Connection used in MAster table if Shadowed install
DIM FileName as C 'The Link Table Data Base Pointer File
DIM InstallType as C 'Installation Connection being adjusted in
DIM Temp as C 'Temporary string
Master = .NOT. isnull(a5.Get_Master_Name()) 'Set falg for Master Shadow situation
IF .NOT. ("s" $ Debug)
IF Master 'There is a master get its Connection Names from it
InstallType = "Master"
FOR EACH Line in TableList 'Check connenction used for each Link Table in list
FileName = file.filename_parse(a5.Get_Master_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,"",Debug)
IF isnull(Temp)
error_generate("Unable to determine Named Connection")
ELSEIF (MstCnct <> Temp) .AND. (MstCnct <> "")
error_generate("Mismatched Named Connections")
ELSE
MstCnct = Temp
end if
ELSE
error_generate("File missing")
end if
NEXT
MstSiteName = lookup(zGetTblName("a-config"),"Connectionstring =" + Quote(MstCnct),"Name")
IF isnull(MstSiteName)
IF ("u" $ Debug)
error_generate("Unrecognized Named Connection: " + MstCnct)
ELSE
MstSiteName = "<< Requires Reset >>"
end if
end if
InstallType = "Shadow" 'We have checked master install Connections
ELSE 'so local is really shadow copy
InstallType = "Local" 'No master not a shadow copy
end if
'Check connection for each Link Table in
FOR EACH Line in TableList 'Local table which can be shadowed table
FileName = file.filename_parse(a5.Get_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,"",Debug)
IF isnull(Temp)
error_generate("Unable to determine Named Connection")
ELSEIF (LclCnct <> Temp) .AND. (LclCnct <> "")
error_generate("Mismatched Named Connections")
ELSE
LclCnct = Temp
end if
ELSE
error_generate("File missing")
end if
NEXT
LclSiteName = lookup(zGetTblName("a-config"),"Connectionstring =" + Quote(LclCnct),"Name")
IF ("u" $ Debug) .AND. isnull(LclSiteName)
IF ("u" $ Debug)
error_generate(*concat_lines("Unrecognized Named Connection",LclCnct))
ELSE
LclSiteName = "<< Requires Reset >>"
end if
end if
end if
'------------------------------------
'// Let User Select Site or System --
'------------------------------------
DIM MstUpdate as L
DIM Result as C
DIM Connection as C
ConnectionList = table.external_record_content_get("a-config","Name","","type = " + Quote(SiteSys))
Dialog =<<%dlg%
{region}
{wrap=80}
If you are using a Shadow installation you can optionally update the master installation.;
Additional shadow installations must use this same script to updated selected installation. The Refresh Shadow Installation can be used to get updates from the Master Installation.
All forms using these Connections must be closed and reopened before changes take effect.
{endregion};
{region}
{staticConditionalSection:1:Master}
Shadow Installation {Insert_SiteSys}:| [%r%.40LclSiteName];
Master Installation {Insert_SiteSys}:| [%r%.40MstSiteName];
Update Master Installation:| (5MstUpdate);
{end_staticConditionalSection:1}
{staticConditionalSection:2:.NOT.Master}
Local Installation {Insert_SiteSys}:| [%r%.40LclSiteName];
{end_staticConditionalSection:2}
Set Installation\(s) to {Insert_SiteSys}:| [.40,5Connection^#ConnectionList];
{endregion};
{line=1,0};
{region}
<*15&Proceed!Proceed> <15&Exit!exit>
{endregion};
%dlg%
DIM sr as C 'control what gets subsituted
sr =<<%txt%
{Insert_SiteSys} = SiteSys
%txt%
Dialog = stritran_multi_expressions(Dialog,sr) 'Subsitute in some variables
Code =<<%code%
if a_dlg_button = "proceed" then 'Used to proceed after dialog
Mess = ""
IF isnull(Connection)
Mess = *concat_lines(Mess,"A " + SiteSys + "Connection Must be selected")
end if
'..... more checks here ...
IF .NOT. isnull(Mess)
ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK)
a_dlg_button = ""
end if
end if
%code%
Result = ui_dlg_box(DialogTtl,Dialog,Code) 'present Dialog
if Result <>"Proceed" then 'do we proceed
end
end if
'-----------------------------
'// Update Named Connection --
'-----------------------------
InstallType = "Both"
FileName = ""
NewConnection = alltrim(lookup(zGetTblName("a-config"),"Name =" + Quote(Connection),"Connectionstring"))
IF isnull(NewConnection)
error_generate(*concat_lines("Unrecognized Connection selected",Connection))
end if
IF Master .AND. MstUpdate 'Do we updtae Named Connections in master files
InstallType = "Master"
FOR EACH Line in TableList 'Update Name Connection in each file
FileName = file.filename_parse(a5.Get_Master_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,NewConnection,Debug)
IF isnull(Temp)
error_generate("Unable to set new Named Connection")
end if
ELSE
error_generate("File missing")
end if
NEXT
InstallType = "Shadow" 'We have updated master install Named Connections
ELSE 'So local is really shadow copy
InstallType = "Local" 'No master not a shadow copy but just local
end if
'Update Named Connection in each
FOR EACH Line in TableList 'Local table which can be shadowed table
FileName = file.filename_parse(a5.Get_Name(),"dp")+Line+".DBP"
IF File.Exists(FileName)
Temp = zLnkSetCnnct(FileName,NewConnection,Debug)
IF isnull(Temp)
error_generate("Unable to set new Named Connection")
end if
ELSE
error_generate("File missing")
end if
NEXT
END FUNCTION
'FOR DEBUGGING
'END
'----------------------
'// Support Function --
'----------------------
'Locate and optionally replace Named Connection in Active Link Table
'Debug - Debug flag set in calling script/function
'FileName - Name of file must include full path and .DBP extension
'NewConnection - Optional new Named Connection to install if null just return existing named connection
'RETURNS - Existing named connection NULL if unable to determine Named Connection
'
'When debugging scripts that use String Scanner Objects
' the following watch variable is very useful
'SS.GetToOffset() + "*" + SS.GetRemainder()
FUNCTION CnctName as C(Debug as C, FileName as C, NewConnection as C = "")
DIM txt as C
DIM SS as P
txt = GET_FROM_FILE(FileName)
SS = stringscanner.create(txt)
IF SS.SkiptoString("<ConnectionString=\"::Name::")
SS.ScanOverSmatch("<ConnectionString=\"::Name::")
CnctName = SS.ScanToString("\"")
IF .NOT.(isnull(CnctName).OR.isnull(NewConnection)) 'Do we place in a new Named Connection
IF ("t" $ Debug) 'Trace the Connection line before rename
zTraceStamp(type::xbasicmodule.get_current())
trace.WriteLn("File: " + FileName)
trace.WriteLn("Orginal Named Connection Line")
txt = SS.GetLineText()
trace.WriteLn(txt)
end if
SS.SkipOver(-1 * LEN(CnctName)) 'Move back over the Named Connection found
SS.Replace(NewConnection,LEN(CnctName)) 'New Named Connection replaced charcters
IF ("t" $ Debug) 'Trace the Connection line after rename
zTraceStamp(type::xbasicmodule.get_current())
trace.WriteLn("File: " + FileName)
trace.WriteLn("Altered Named Connection Line")
txt = SS.GetLineText()
trace.WriteLn(txt)
end if
SS.Reset() 'Get the modified file and rewrite it
txt = SS.GetRemainder()
SAVE_TO_FILE(txt,FileName,.F.)
end if
ELSE
CnctName = ""
end if
END FUNCTION
'-------------------
'// ERROR Handler --
'-------------------
ERRORHANDLER:
ON ERROR GOTO 0 'No more special error traps that continue the code
Mess =<<%txt%
ERROR
{error_text_get()}
FileName: {FileName}
Install Type: {InstallType}
Script: {error_script_get()}
Line: {error_line_number_get()}
%txt%
Mess = Evaluate_String(Mess)
ui_msg_box(DialogTtl,Mess,UI_ATTENTION_SYMBOL+UI_OK)
zLogAdd(Mess)
END
The named connection strings can are edited in the Alpha5 enviroment they can also be edited in runtime using the following function
a5_ado_connectionstrings("","cs")
Bookmarks