Application Delivery Management
Application Modernization & Connectivity
CyberRes
IT Operations Management
PROBLEM:
An ACUCOBOL-GT application can be executed as-it-is in multiple modes, such as a standalone runtime installation, an AcuConnect Thin Client environment, the newest AcuToWeb mode.
The developer can anyway decide that some piece of code can be optimized for each of these environments.
Is there a way to identify the mode the program is executed in, so that a different branch of code can be run?
RESOLUTION:
Starting with AcuToWeb 10.2.0, the runtime can return more information when executing
ACCEPT TERMINAL-ABILITIES FROM TERMINAL-INFO.
The known TERMINAL-NAME field has now been improved to contain "AcuToWeb" when the program is executed in this environment. This, used together with the IS-REMOTE field, can help to develop an optimized code.
For example:
IF IS-REMOTE AND TERMINAL-NAME = "AcuToWeb" ...
Moreover, the TERMINAL-ABILITIES group now contains these new fields (immediately
following CLIENT-USER-ID):
03 ATW-BROWSER-NAME PIC X(30). 03 ATW-BROWSER-VERSION PIC X(10). 03 ATW-ENGINE-NAME PIC X(30). 03 ATW-ENGINE-VERSION PIC X(10). 03 ATW-CLIENT-OS-NAME PIC X(30). 03 ATW-CLIENT-OS-VERSION PIC X(10). 03 ATW-CLIENT-DEVICE-TYPE PIC X(30). 03 ATW-CLIENT-DEVICE-VENDOR PIC X(30). 03 ATW-CLIENT-DEVICE-MODEL PIC X(30).
These information are provided by AcuToWeb. If you are not using AcuToWeb, these fields will remain blank.
Be sure to use the latest version of the "acucobol.def" copy file provided within the 10.2.x installations.
Here's a snippet of code which can show in detail how to use these new information:
ACCEPT TERMINAL-ABILITIES FROM TERMINAL-INFO. IF NOT IS-REMOTE | wrun32.exe mode ... ELSE IF TERMINAL-NAME = "AcuToWeb" | AcuToWeb mode EVALUATE ATW-CLIENT-OS-NAME WHEN "Windows" EVALUATE ATW-BROWSER-NAME WHEN "Chrome" display message box "AcuToWeb on Windows" x"0a" "using " ATW-BROWSER-VERSION x"0a" "vers. " ATW-BROWSER-VERSION TITLE "Device and Browser Information" ... WHEN "Edge" ... WHEN OTHER ... END-EVALUATE ... WHEN "Android" ... WHEN "iOS" ... WHEN OTHER ... END-EVALUATE ELSE | AcuConnect Thin Client mode ... END-IF END-IF
Claudio Contardi
Product Support Engineer, Senior
Micro Focus