jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Commit inicial: fuentes MBS ERP (Genero 6) + .gitignore + docs/SETUP_PC_MBS.md

Browse Source
This commit is contained in:
jsoto
2026-08-18 20:59:52 -04:00
commit 454973e269
5978 changed files with 2664094 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
PROYECTO/otrodir/dbadministrator/bin/db_error
+130
View File
@@ -0,0 +1,130 @@
Date: 06/04/2009 Time: 20:22:23
Program error at 'dbimportExport.4gl', line number 16.
FORMS statement error number -1110.
Form file not found.
Date: 06/04/2009 Time: 20:27:57
Program error at 'dbimportExport.4gl', line number 24.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/04/2009 Time: 20:46:55
Program error at 'dbimportExport.4gl', line number 25.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/04/2009 Time: 20:49:16
Program error at 'dbimportExport.4gl', line number 34.
FORMS statement error number -1108.
Record (stablas) not in form.
Date: 06/04/2009 Time: 20:49:42
Program error at 'dbimportExport.4gl', line number 34.
FORMS statement error number -1109.
List and record field counts differ.
Date: 06/04/2009 Time: 21:32:25
Program error at 'dbimportExport.4gl', line number 36.
SQL statement error number -6372 (-53).
[Microsoft][SQL Server Native Client 10.0]Named Pipes Provider: Could not open a connection to SQL Server [53].
Date: 06/07/2009 Time: 11:44:59
Program error at 'dbimportExport.4gl', line number 16.
FORMS statement error number -6300.
Can not connect to GUI.
Date: 06/07/2009 Time: 11:47:15
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -908.
Attempt to connect to database server (ol_data) failed.
SYSTEM error number 60.
Connection timed out
Date: 06/07/2009 Time: 11:47:34
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 11:48:26
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 11:50:15
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 11:52:31
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 11:53:58
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 11:55:04
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 11:56:08
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 12:00:28
Program error at 'dbimportExport.4gl', line number 17.
FORMS statement error number -8014.
The string file 'dbstyle' can not be read.
Date: 06/07/2009 Time: 12:00:40
Program error at 'dbimportExport.4gl', line number 17.
FORMS statement error number -8014.
The string file 'dbstyle' can not be read.
Date: 06/07/2009 Time: 12:01:05
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 12:02:12
Program error at 'dbimportExport.4gl', line number 26.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 12:06:27
Program error at 'dbimportExport.4gl', line number 27.
SQL statement error number -6373 (0).
Invalid database connection string.
Date: 06/07/2009 Time: 12:07:17
Program error at 'dbimportExport.4gl', line number 27.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/07/2009 Time: 12:12:24
Program error at 'dbimportExport.4gl', line number 27.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/08/2009 Time: 15:42:18
Program error at 'dbimportExport.4gl', line number 17.
FORMS statement error number -6300.
Can not connect to GUI.
Date: 06/08/2009 Time: 15:42:44
Program error at 'dbimportExport.4gl', line number 27.
SQL statement error number -329.
Database not found or no system permission.
SYSTEM error number -111.
ISAM error: no record found.
Date: 06/08/2009 Time: 15:43:25
Program error at 'dbimportExport.4gl', line number 42.
SQL statement error number -6372 (-208).
[Microsoft][SQL Server Native Client 10.0][SQL Server]Invalid object name 'systables'.
PROYECTO/otrodir/dbadministrator/bin/dbstyle.4st
+87
View File
@@ -0,0 +1,87 @@
<?xml version="1.0" encoding="ANSI_X3.4-1968"?>
<StyleList>
<Style name="Window">
<StyleAttribute name="windowType" value="normal" />
</Style>
<Style name="Window.main">
<StyleAttribute name="windowType" value="normal" />
<StyleAttribute name="startMenuPosition" value="menu" />
</Style>
<Style name="Window.grtable">
<StyleAttribute name="position" value="center" />
<StyleAttribute name="windowType" value="normal" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
</Style>
<Style name="Window.dialog">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="no" />
<StyleAttribute name="position" value="center" />
<StyleAttribute name="actionPanelPosition" value="bottom" />
<StyleAttribute name="ringMenuPosition" value="bottom" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.dialog2">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="no" />
<StyleAttribute name="position" value="center" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.dialog3">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="yes" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.dialog4">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="yes" />
<StyleAttribute name="actionPanelPosition" value="bottom" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.naked">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="border" value="tool" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
</Style>
<Style name="Window.viewer">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="windowSystemMenu" value="yes" />
<StyleAttribute name="windowOptionMinimize" value="no" />
<StyleAttribute name="windowOptionMaximize" value="no" />
<StyleAttribute name="sizable" value="yes" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
</Style>
<Style name="Label:title">
<StyleAttribute name="fontSize" value="xx-large" />
<StyleAttribute name="fontFamily" value="sans-serif" />
<StyleAttribute name="textDecoration" value="underline" />
</Style>
<Style name="Table:focus">
<StyleAttribute name="highlightColor" value="#7E0C6E" />
</Style>
<Style name="Table.detail:even">
<StyleAttribute name="backgroundColor" value="#DECFDB" />
</Style>
<Style name="Image.title">
<StyleAttribute name="border" value="no" />
</Style>
</StyleList>
PROYECTO/otrodir/dbadministrator/bin/marmotech.sch
+4591
View File
File diff suppressed because it is too large Load Diff
PROYECTO/otrodir/dbadministrator/dbadm.4pw
+10
View File
@@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf8" ?>
<Workspace defaultApplication="2" id="0" version="2.0">
<Project id="1" label="DBADMINISTRATOR">
<Application id="2" label="DBADMINISTRATOR">
<File filePath="dbfmimportexport.per" id="9"/>
<File filePath="dbimportExport.4gl" id="10"/>
<File filePath="dbstyle.4st" id="11"/>
</Application>
</Project>
</Workspace>
PROYECTO/otrodir/dbadministrator/dbadm.deps
+5
View File
@@ -0,0 +1,5 @@
<?xml version="1.0" encoding="utf8" ?>
<FileContentsDatabase version="1.0">
<File dependencies="" filePath="C:/GENERO/PROYECTO/otrodir/dbadministrator/dbfmimportexport.per" references="" timestamp="20090608154519"/>
<File dependencies="" filePath="C:/GENERO/PROYECTO/otrodir/dbadministrator/dbimportExport.4gl" references="" timestamp="20090608181008"/>
</FileContentsDatabase>
PROYECTO/otrodir/dbadministrator/dbfmimportexport.per
+64
View File
@@ -0,0 +1,64 @@
ACTION DEFAULTS
ACTION CargaTablas(TEXT="Cargar",IMAGE="diropen",COMMENT="Carga las tablas de la base de datos fuente", ACCELERATOR=Control-O)
ACTION Export(TEXT="Export",IMAGE="disk",COMMENT="Exporta Tablas y Datos", ACCELERATOR=Control-S)
ACTION close(TEXT="Cerrar",IMAGE="quit",COMMENT="Salir Herramienta", ACCELERATOR=Alt-F4)
END
TOPMENU
GROUP Tablas (TEXT="Cargar")
COMMAND cargar
COMMAND export
SEPARATOR
COMMAND cerrar
END
LAYOUT(VERSION="1.02",TEXT="Schema manager",STYLE="dbstyle")
GROUP (TEXT="Table")
GRID
{
Base Datos a importar: [db ]
<t TABLAS >
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
[cn |cno |t1 |cn1 ]
}
END -- grid
END
ATTRIBUTES
EDIT db = FORMONLY.db1, REQUIRED;
EDIT cn = FORMONLY.nombre_origen, COLOR=BLUE, TITLE="TABLAS ORIGEN",
COMMENT="Name of database table";
EDIT t1 = FORMONLY.tabid;
EDIT cno = FORMONLY.nombre_destino, COLOR=BLUE,TITLE="TABLAS DESTINO",
COMMENT="Name of database table";
CHECKBOX cn1 = FORMONLY.aplica,
TITLE="Apl",
UNHIDABLE, NOT NULL, REQUIRED,
COMMENT="Exportar",NOT NULL,
VALUECHECKED="SI", VALUEUNCHECKED="NO";
END
INSTRUCTIONS
SCREEN RECORD stablas(
FORMONLY.nombre_origen,
FORMONLY.nombre_destino,
FORMONLY.tabid,
FORMONLY.aplica
);
PROYECTO/otrodir/dbadministrator/dbimportExport.4gl
+82
View File
@@ -0,0 +1,82 @@
GLOBALS
DEFINE db1 CHAR(100),
idx integer
DEFINE tablas DYNAMIC ARRAY OF RECORD
nombre_origen CHAR(100),
nombre_destino CHAR(100),
tabid INTEGER,
aplica CHAR(2)
END RECORD
END GLOBALS
MAIN
DEFER INTERRUPT
CALL startlog("db_error")
OPEN WINDOW dbadm WITH FORM "dbfmimportexport"
CALL ui.Interface.LoadStyles("dbstyle")
INPUT BY NAME db1
AFTER INPUT
IF int_flag THEN
LET int_flag = FALSE
RETURN
END IF
END INPUT
LET db1 = db1 CLIPPED,"+dbmifx9"
DATABASE marmotech
# CONNECT TO "marmotech+driver='dbmifx9x',source='ifxmarmotech'" USER "informix" USING "luismi001"
DECLARE busca_db1 CURSOR FOR
SELECT a.tabname,a.tabname,a.tabid FROM systables a WHERE a.tabtype = "T"
ORDER BY a.tabname
LET idx = 1
FOREACH busca_db1 INTO tablas[idx].*
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
INPUT ARRAY tablas WITHOUT DEFAULTS FROM stablas.*
# PARA CREAR TABLAS
FOR idx = 1 TO arr_count()
IF tablas[idx].aplica = "SI" THEN
SELECT a.colname,a.coltype, FROM syscolumns a WHERE a.tabname = tablas[idx].nombre_origen
IF STATUS != NOTFOUND THEN
CONTINUE FOR
ELSE
ERROR "INSERTANDO REGISTROS"
END IF
END IF
END FOR
END MAIN
FUNCTION tipo_datos(coltype)
DEFINE coltype SMALLINT
DEFINE tipodato CHAR(50)
CASE
WHEN coltype = 0
LET tipodato= "CHAR"
WHEN coltype = 1
LET tipodato = "INTEGER"
WHEN coltype = 5
LET tipodato = "DECIMAL"
WHEN coltype = 4
LET tipodato = "FLOAT"
WHEN coltype = 2
LET tipodato = "SMALLINT"
WHEN coltype = 7
LET tipodato = "DATE"
WHEN coltype = 10
LET tipodato= "DATETIME"
END CASE
END FUNCTION
PROYECTO/otrodir/dbadministrator/dbstyle.4st
+87
View File
@@ -0,0 +1,87 @@
<?xml version="1.0" encoding="ANSI_X3.4-1968"?>
<StyleList>
<Style name="Window">
<StyleAttribute name="windowType" value="normal" />
</Style>
<Style name="Window.main">
<StyleAttribute name="windowType" value="normal" />
<StyleAttribute name="startMenuPosition" value="menu" />
</Style>
<Style name="Window.grtable">
<StyleAttribute name="position" value="center" />
<StyleAttribute name="windowType" value="normal" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
</Style>
<Style name="Window.dialog">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="no" />
<StyleAttribute name="position" value="center" />
<StyleAttribute name="actionPanelPosition" value="bottom" />
<StyleAttribute name="ringMenuPosition" value="bottom" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.dialog2">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="no" />
<StyleAttribute name="position" value="center" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.dialog3">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="yes" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.dialog4">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="sizable" value="yes" />
<StyleAttribute name="actionPanelPosition" value="bottom" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
<StyleAttribute name="errorMessagePosition" value="popup" />
</Style>
<Style name="Window.naked">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="border" value="tool" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
</Style>
<Style name="Window.viewer">
<StyleAttribute name="windowType" value="modal" />
<StyleAttribute name="windowSystemMenu" value="yes" />
<StyleAttribute name="windowOptionMinimize" value="no" />
<StyleAttribute name="windowOptionMaximize" value="no" />
<StyleAttribute name="sizable" value="yes" />
<StyleAttribute name="actionPanelPosition" value="none" />
<StyleAttribute name="ringMenuPosition" value="none" />
<StyleAttribute name="toolBarPosition" value="none" />
<StyleAttribute name="statusBarType" value="none" />
</Style>
<Style name="Label:title">
<StyleAttribute name="fontSize" value="xx-large" />
<StyleAttribute name="fontFamily" value="sans-serif" />
<StyleAttribute name="textDecoration" value="underline" />
</Style>
<Style name="Table:focus">
<StyleAttribute name="highlightColor" value="#7E0C6E" />
</Style>
<Style name="Table.detail:even">
<StyleAttribute name="backgroundColor" value="#DECFDB" />
</Style>
<Style name="Image.title">
<StyleAttribute name="border" value="no" />
</Style>
</StyleList>
PROYECTO/otrodir/dbadministrator/fgldbsch.4gl
+475
View File
@@ -0,0 +1,475 @@
-- Warning: Uses fgldbslib.4gl
DEFINE params RECORD
dbname STRING,
filename STRING,
compat SMALLINT,
igncve SMALLINT,
verbose SMALLINT
END RECORD
CONSTANT toolname = "fgldbsch"
CONSTANT fext_coltypes = ".sch"
CONSTANT fext_colvalid = ".val"
CONSTANT fext_colattrs = ".att"
#-------------------------------------------------------------------------------
MAIN
DEFINE i, s SMALLINT
DEFINE fn STRING
DEFER INTERRUPT
DEFER QUIT
IF num_args()==0 THEN
CALL display_usage()
EXIT PROGRAM 1
END IF
CALL fgldbsch_init()
-- Check if program was called by fglschema script
IF cmdarg_option_used("om") THEN
CALL parse_fglschema_options()
ELSE
CALL parse_fgldbsch_options()
END IF
IF ( params.dbname IS NULL OR LENGTH(params.dbname) = 0 ) THEN
CALL display_usage()
EXIT PROGRAM 1
END IF
CALL fgldbsch_set_parameter("dbname",params.dbname)
LET s = fgldbsch_connect()
IF s<>0 THEN
DISPLAY "Connection to database '", params.dbname, "' failed."
IF SQLCA.SQLCODE<>0 THEN
DISPLAY SQLCA.SQLCODE, ": ", SQLERRMESSAGE
ELSE
DISPLAY s, ": ", err_get(s)
END IF
EXIT PROGRAM 1
END IF
IF fgldbsch_get_db_type() IS NULL THEN
DISPLAY "Could not identify the database type..."
EXIT PROGRAM 1
END IF
IF params.compat AND fgldbsch_get_db_type() == "IFX" THEN
CALL fgldbsch_set_parameter( "systabs", "Y" )
END IF
LET int_flag=FALSE
LET quit_flag=FALSE
IF params.filename IS NULL THEN
LET params.filename = params.dbname
LET i = params.dbname.getIndexOf("@",2) -- "dbname@informixserver"
IF i>0 THEN LET params.filename = params.dbname.subString(1,i-1) END IF
LET i = params.dbname.getIndexOf("+",2) -- "dbsource+driver='xxx'"
IF i>0 THEN LET params.filename = params.dbname.subString(1,i-1) END IF
END IF
IF params.verbose THEN
DISPLAY ""
DISPLAY toolname
DISPLAY "----------------------------------------------------------------"
DISPLAY ""
DISPLAY "Extracting database schema from '", params.dbname, "'"
DISPLAY " Database server type detected : ", fgldbsch_get_db_type()
DISPLAY ""
END IF
IF fgldbsch_extract() < 0 THEN
DISPLAY "Could not extract database schema..."
EXIT PROGRAM 1
END IF
LET fn = params.filename, fext_coltypes
CALL output_schema(fn)
IF params.compat THEN
DISPLAY "File \"", fn, "\" created."
END IF
IF fgldbsch_get_db_type() == "IFX" THEN
CALL extract_upscol()
END IF
LET s = fgldbsch_disconnect()
CALL fgldbsch_fini()
END MAIN
#-------------------------------------------------------------------------------
FUNCTION parse_fglschema_options()
DEFINE i INTEGER
DEFINE opt, tmp STRING
LET params.compat = TRUE
CALL fgldbsch_set_parameter("compat","Y")
FOR i=1 TO num_args()
LET tmp = arg_val(i)
IF tmp.getCharAt(1) == "-" THEN
LET opt = tmp.subString(2, tmp.getLength())
CASE opt
WHEN "om" -- ignore
WHEN "c"
CALL fgldbsch_set_parameter("cvmeth", "BBBBBBBBBBBBBB")
WHEN "r"
LET params.igncve = TRUE
OTHERWISE
CALL display_usage()
EXIT PROGRAM 1
END CASE
ELSE
LET params.dbname = tmp
END IF
END FOR
END FUNCTION
#-------------------------------------------------------------------------------
FUNCTION parse_fgldbsch_options()
-- Warning: om option just used to detect old mode usage (see scripts)
IF cmdarg_option_check( "*|V|h|H|v|om|ct|db+|dv+|un+|up+|ow+|tn+|cv+|of+|ie|cu|cl|cc|st" ) != 0 THEN
CALL display_usage()
EXIT PROGRAM 1
END IF
IF cmdarg_option_used( "V" ) THEN
DISPLAY "WARNING: Version info is displayed by calling script!"
EXIT PROGRAM 0
END IF
IF cmdarg_option_used( "h" ) THEN
CALL display_usage()
EXIT PROGRAM 0
END IF
IF cmdarg_option_used( "H" ) THEN
CALL display_help()
EXIT PROGRAM 0
END IF
IF cmdarg_option_used( "ct" ) THEN
CALL fgldbsch_display_convtables()
EXIT PROGRAM 0
END IF
LET params.dbname = cmdarg_option_param("db")
LET params.filename = cmdarg_option_param( "of" )
LET params.igncve = cmdarg_option_used( "ie" )
LET params.verbose = cmdarg_option_used( "v" )
IF params.verbose THEN
CALL fgldbsch_set_parameter("verbose", "Y")
END IF
CALL fgldbsch_set_parameter("dbdriver", cmdarg_option_param("dv"))
CALL fgldbsch_set_parameter("dbowner", cmdarg_option_param("ow"))
CALL fgldbsch_set_parameter("username", cmdarg_option_param("un"))
CALL fgldbsch_set_parameter("userpswd", cmdarg_option_param("up"))
CALL fgldbsch_set_parameter("tabname", cmdarg_option_param("tn"))
CASE
WHEN cmdarg_option_used( "cc" )
CALL fgldbsch_set_parameter("casens","C")
WHEN cmdarg_option_used( "cu" )
CALL fgldbsch_set_parameter("casens","U")
WHEN cmdarg_option_used( "cl" )
CALL fgldbsch_set_parameter("casens","L")
END CASE
IF cmdarg_option_used( "st" ) THEN
CALL fgldbsch_set_parameter( "systabs", "Y" )
END IF
IF cmdarg_option_used( "cv" ) THEN
CALL fgldbsch_set_parameter("cvmeth", cmdarg_option_param("cv"))
END IF
END FUNCTION
#-------------------------------------------------------------------------------
FUNCTION output_schema(fn)
DEFINE fn STRING
DEFINE c,x INTEGER
DEFINE tmp STRING
DEFINE ch base.Channel
DEFINE cl DYNAMIC ARRAY OF RECORD
tabname STRING,
colname STRING,
nattype STRING,
ifxtype INTEGER,
ifxleng INTEGER,
ordinal INTEGER
END RECORD
LET ch = base.Channel.create()
CALL ch.setDelimiter("^")
CALL ch.openFile(fn,"w")
WHILE fgldbsch_next_table() == 1
IF params.verbose THEN
DISPLAY "Table : ", fgldbsch_get_table_name()
END IF
LET x=1
FOR c=1 TO fgldbsch_get_column_count()
CALL fgldbsch_get_column_info(c)
RETURNING cl[x].tabname,
cl[x].colname,
cl[x].nattype,
cl[x].ifxtype,
cl[x].ifxleng
LET cl[x].ordinal = c
IF cl[x].ifxtype = -1 THEN
LET tmp = SFMT("Table \"%1.%2\" has not a valid datatype [%3]",
cl[x].tabname, cl[x].colname, cl[x].nattype)
IF params.compat THEN
IF params.igncve THEN
CONTINUE FOR
ELSE
DISPLAY "Warning: ", tmp, " - table is ignored."
CONTINUE WHILE
END IF
ELSE
IF params.igncve THEN
DISPLAY "Warning: ", tmp, " - table is ignored."
CONTINUE WHILE
ELSE
DISPLAY "ERROR: ", tmp
EXIT PROGRAM 1
END IF
END IF
END IF
LET x=x+1
END FOR
FOR c=1 TO x-1
CALL ch.write([cl[c].tabname,cl[c].colname,cl[c].ifxtype,cl[c].ifxleng,cl[c].ordinal])
END FOR
END WHILE
CALL ch.close()
END FUNCTION
FUNCTION extract_upscol()
DEFINE fn STRING
DEFINE ct INTEGER
WHENEVER ERROR CONTINUE
SELECT COUNT(*) INTO ct FROM syscolval
WHENEVER ERROR STOP
IF status = 0 THEN
LET fn = params.filename, fext_colvalid
UNLOAD TO fn DELIMITER "^"
SELECT UNIQUE tabname, colname, attrname, attrval
FROM syscolval
ORDER BY tabname, colname
IF params.compat THEN
DISPLAY "File \"", fn, "\" created."
END IF
END IF
WHENEVER ERROR CONTINUE
SELECT COUNT(*) INTO ct FROM syscolatt
WHENEVER ERROR STOP
IF status = 0 THEN
LET fn = params.filename, fext_colattrs
UNLOAD TO fn DELIMITER "^"
SELECT UNIQUE tabname, colname, seqno, color, inverse,
underline, blink, left, def_format, condition
FROM syscolatt
ORDER BY tabname, colname, seqno
IF params.compat THEN
DISPLAY "File \"", fn, "\" created."
END IF
END IF
END FUNCTION
FUNCTION display_usage()
DISPLAY "Usage: ", toolname, " [options]"
DISPLAY " -V : Display version information."
DISPLAY " -h : Display this help."
DISPLAY " -H : Display complete help."
DISPLAY " -v : Verbose mode. Default is silent."
DISPLAY " -ct : Show data type conversion tables."
DISPLAY " -db name : Database name."
DISPLAY " -dv name : Database driver."
DISPLAY " -un user : Database User name."
DISPLAY " -up pswd : Database User password."
DISPLAY " -ow name : Database schema/tables owner."
DISPLAY " -tn name : Extract specific table schema."
DISPLAY " -cv strg : Specify conversion method."
DISPLAY " -of name : Output filename prefix. Default is database name."
DISPLAY " -ie : Ignore tables with columns that cannot be converted."
DISPLAY " -cu : Generate upper case names."
DISPLAY " -cl : Generate lower case names."
DISPLAY " -cc : Generate case sensitive names."
DISPLAY " -st : Generate database system tables."
END FUNCTION
FUNCTION display_help()
CALL display_usage()
DISPLAY ""
DISPLAY "This program generates database schema description files from system"
DISPLAY "catalog tables."
DISPLAY ""
DISPLAY "List of generated files:"
DISPLAY " . schemaname.sch : Column definitions with data types."
DISPLAY " . schemaname.val : Validation rules and attributes."
DISPLAY " . schemaname.att : Video attributes (upscol compatibility)."
DISPLAY ""
DISPLAY "The database type is detected automatically after connection, you do"
DISPLAY "not have to specify any database server type."
DISPLAY ""
DISPLAY "You must at least give the database name with the '-db' option. For"
DISPLAY "example : ' -db stores '."
DISPLAY ""
DISPLAY "If the operating system user is not the database user, you can give"
DISPLAY "a database login and password with the '-un' and '-up' options."
DISPLAY ""
DISPLAY "For some databases you may need to specify the schema owner otherwise"
DISPLAY "you may get all the system tables too. Use the '-ow' option to give"
DISPLAY "the database schema owner."
DISPLAY ""
DISPLAY "By default table and column names are converted to lower case letters"
DISPLAY "to enforce compatibility with Informix. But you can force lower case,"
DISPLAY "upper case or case sensitive generation by giving the '-cl', '-cu' or"
DISPLAY "'-cc' options."
DISPLAY ""
DISPLAY "Data types generation in schema files can be controlled with the -cv"
DISPLAY "option. Each character position of the string passed to this option"
DISPLAY "corresponds to a data type in the conversion table."
DISPLAY "For example, ' -cv AAB' indicates that the first and second data type"
DISPLAY "in the conversion table must use the convertion A, while the third"
DISPLAY "type uses conversion B."
DISPLAY "When using X as conversion code, the columns using the corresponding"
DISPLAY "data types will be ignored and not written to the .sch file. This is"
DISPLAY "particularly useful in the case of auto-generated columns like with"
DISPLAY "SQL Server's uniqueidentifier data type, using DEFAULT NEWID()."
DISPLAY "Run this program with the '-ct' option to see the conversion tables."
DISPLAY ""
DISPLAY "Use the -tn option to extract the description of only one specific"
DISPLAY "table from the database. This option is useful if you have created"
DISPLAY "new tables in your database, and you need to extract the schema of"
DISPLAY "the new tables without overwriting the existing schema files."
DISPLAY ""
DISPLAY "Some data types may not be converted to BDL types, and cause an"
DISPLAY "error during schema extraction. To ignore unsupported types, use"
DISPLAY "the -ie option (you still get warnings)."
DISPLAY ""
DISPLAY "Use the -st option to include system tables in the schema. System"
DISPLAY "tables description are not needed if you do not explicitly use"
DISPLAY "them in the programs."
DISPLAY ""
END FUNCTION
#-------------------------------------------------------------------------------
FUNCTION cmdarg_option_used(optname)
DEFINE optname STRING -- The option name without '-'
RETURN ( cmdarg_option_index(optname)>0 )
END FUNCTION
FUNCTION cmdarg_option_param(optname)
DEFINE optname STRING -- The option name without '-'
DEFINE optidx INTEGER
DEFINE paramval STRING -- Can be a directory path !
LET paramval = NULL
LET optidx = cmdarg_option_index(optname)
IF (optidx>0) AND (optidx<num_args()) THEN
-- Get value ( follows option argument )
LET paramval = arg_val(optidx+1)
END IF
RETURN paramval
END FUNCTION
FUNCTION cmdarg_option_index(optname)
DEFINE optname STRING -- The option name without '-'
DEFINE idx, cnt, optidx INTEGER
DEFINE fopt STRING
LET optidx = -1
LET cnt = num_args()
LET fopt = "-", optname -- UNIX convention
FOR idx=1 TO cnt
IF (arg_val(idx)=fopt) THEN
LET optidx = idx
EXIT FOR
END IF
END FOR
RETURN optidx
END FUNCTION
FUNCTION cmdarg_option_isopt(name)
DEFINE name STRING
RETURN ( name.getCharAt(1) == "-" )
END FUNCTION
-- Syntax:
-- <option>+ = option has parameter (next arg must not use -)
-- * = simple string is allowed as argument
FUNCTION cmdarg_option_check(optlist)
DEFINE optlist STRING -- The possible options (v|x|cv|of+|*)
DEFINE optspec STRING
DEFINE optpara STRING
DEFINE i, j INTEGER
DEFINE indiv, found INTEGER
DEFINE tok base.StringTokenizer
DEFINE optarr DYNAMIC ARRAY OF RECORD
optname STRING,
hasparam INTEGER
END RECORD
LET tok = base.StringTokenizer.create(optlist, "|")
WHILE tok.hasMoreTokens()
LET optspec = tok.nextToken()
IF optspec = "*" THEN
LET indiv = TRUE
CONTINUE WHILE
END IF
LET i = optspec.getIndexOf("+",1)
CALL optarr.appendElement()
IF i > 0 THEN
LET optarr[optarr.getLength()].hasparam = 1
LET optspec = optspec.substring(1,i-1)
END IF
LET optarr[optarr.getLength()].optname = optspec
END WHILE
FOR i=1 TO num_args()
LET optspec = arg_val(i)
IF NOT cmdarg_option_isopt(optspec) THEN
IF indiv THEN CONTINUE FOR ELSE RETURN i END IF
END IF
LET optspec = optspec.substring(2,optspec.getLength())
LET found = FALSE
FOR j=1 TO optarr.getLength()
IF optarr[j].optname == optspec THEN
LET found = TRUE
LET optpara = arg_val(i+1)
IF optarr[j].hasparam THEN
IF optpara IS NULL OR cmdarg_option_isopt(optpara) THEN
LET found = FALSE
ELSE
LET i = i + 1
END IF
ELSE
IF optpara IS NOT NULL AND NOT cmdarg_option_isopt(optpara) THEN
LET found = FALSE
END IF
END IF
EXIT FOR
END IF
END FOR
IF NOT found THEN RETURN i END IF
END FOR
RETURN 0
END FUNCTION
PROYECTO/otrodir/dbadministrator/fgldbslib.4gl
+2447
View File
File diff suppressed because it is too large Load Diff
PROYECTO/otrodir/dbadministrator/fgldbutl.4gl
+210
View File
@@ -0,0 +1,210 @@
#+ Database utility functions
#+
DEFINE m_transcount SMALLINT
#+ Returns the current database type identifier (ORA,IFX,DB2,MSV).
#+ @returnType String
FUNCTION db_get_database_type()
DEFINE uname CHAR(30)
DEFINE dbtype CHAR(3)
DEFINE s INTEGER
WHENEVER ERROR CONTINUE
INITIALIZE dbtype TO NULL
IF dbtype IS NULL THEN
# Try INFORMIX specific statement
SELECT USER INTO uname FROM systables WHERE tabid=1
IF STATUS=0 THEN LET dbtype = "IFX" END IF
END IF
IF dbtype IS NULL THEN
# Try MS SQL Server specific statement
# MUST use a string because INFORMATION_SCHEMA.TABLES is case-sensitive!!!
EXECUTE IMMEDIATE "SELECT DISTINCT(@@SERVERNAME) FROM INFORMATION_SCHEMA.TABLES"
IF STATUS=0 THEN LET dbtype = "MSV" END IF
END IF
IF dbtype IS NULL THEN
# Try IBM DB2 specific statement
SELECT USER INTO uname FROM sysibm.systables WHERE name='SYSTABLES'
IF STATUS=0 THEN LET dbtype = "DB2" END IF
END IF
IF dbtype IS NULL THEN
# Try ORACLE specific statement
SELECT USER INTO uname FROM all_tables WHERE table_name='DUAL' AND pct_free IS NOT NULL
IF STATUS=0 THEN LET dbtype = "ORA" END IF
END IF
IF dbtype IS NULL THEN
# Try SYBASE ASA specific statement
SELECT USER INTO uname FROM systable WHERE table_id=1 AND file_id IS NOT NULL
IF STATUS=0 THEN LET dbtype = "ASA" END IF
END IF
IF dbtype IS NULL THEN
# Try POSTGRESQL specific statement
SELECT USER INTO uname FROM pg_class WHERE relname='pg_class'
IF STATUS=0 THEN LET dbtype = "PGS" END IF
END IF
IF dbtype IS NULL THEN
# Try MySQL specific statement
DECLARE cdbt1 CURSOR FROM "SELECT CURDATE()"
OPEN cdbt1
LET s=STATUS
CLOSE cdbt1
FREE cdbt1
IF s=0 THEN LET dbtype = "MYS" END IF
END IF
IF dbtype IS NULL THEN
SELECT USER INTO uname FROM SYSTEM.TABLE_OF_TABLES
WHERE TABLE_NAME = 'TABLE_OF_TABLES'
IF STATUS=0 THEN LET dbtype = "ADS" END IF
END IF
WHENEVER ERROR STOP
IF dbtype IS NULL THEN
DISPLAY "FATAL ERROR: db_get_database_type() could not identify database type."
EXIT PROGRAM 1
END IF
RETURN dbtype
END FUNCTION
#+ Generates a new sequence from seqreg table.
#+ @param sname The name of the sequence.
FUNCTION db_get_sequence( sname )
DEFINE sname VARCHAR(30)
DEFINE nlast INTEGER
-- Table must have the following structure:
-- CREATE TABLE seqreg (
-- sr_name VARCHAR(30) NOT NULL,
-- sr_last INTEGER NOT NULL,
-- PRIMARY KEY (sr_name)
-- )
WHENEVER ERROR CONTINUE
-- First statement must be the UPDATE to set an exclusive lock
UPDATE seqreg SET sr_last = sr_last + 1 WHERE sr_name = sname
IF status<0 THEN RETURN -1 END IF
-- If the number of processed row is zero, insert missing record
SELECT sr_last INTO nlast FROM seqreg WHERE sr_name = sname
IF status<0 THEN RETURN -1 END IF
-- If nothing was found, insert missing record
IF status = NOTFOUND THEN
LET nlast = 1
INSERT INTO seqreg ( sr_name, sr_last ) VALUES ( sname, nlast )
IF status<0 THEN RETURN -1 END IF
END IF
WHENEVER ERROR STOP
RETURN nlast
END FUNCTION
#+ Starts a new transaction.
#+ @returnType INTEGER
FUNCTION db_start_transaction( )
DEFINE s INTEGER
LET s = 0
IF m_transcount IS NULL OR m_transcount < 0 THEN
LET m_transcount = 0
END IF
IF m_transcount = 0 THEN
WHENEVER ERROR CONTINUE
BEGIN WORK
LET s = STATUS
WHENEVER ERROR STOP
END IF
IF s = 0 THEN
LET m_transcount = m_transcount + 1
END IF
RETURN s
END FUNCTION
#+ Terminates a transaction with COMMIT or ROLLBACK.
#+ @returnType INTEGER
#+ @param c TRUE=COMMIT, FALSE=ROLLBACK.
FUNCTION db_finish_transaction( c )
DEFINE c SMALLINT
DEFINE s INTEGER
LET s = 0
IF m_transcount IS NULL OR m_transcount < 0 THEN
LET m_transcount = 0
END IF
IF m_transcount <= 0 THEN
LET s = -1
ELSE
IF m_transcount = 1 THEN
WHENEVER ERROR CONTINUE
IF c THEN
COMMIT WORK
ELSE
ROLLBACK WORK
END IF
LET s = STATUS
WHENEVER ERROR STOP
END IF
END IF
IF s = 0 THEN
LET m_transcount = m_transcount - 1
END IF
RETURN s
END FUNCTION
#+ Has a transaction been started with db_start_transaction?
#+ @returnType INTEGER
#+ @return TRUE if a transaction was started with db_start_transaction.
FUNCTION db_is_transaction_started( )
IF m_transcount > 0 THEN
RETURN TRUE
ELSE
RETURN FALSE
END IF
END FUNCTION
#+ Renames a database table.
#+ @returnType INTEGER
#+ @param oldname Old table name.
#+ @param newname New table name.
FUNCTION db_rename_table( oldname, newname )
DEFINE oldname CHAR(200)
DEFINE newname CHAR(200)
DEFINE dbtype CHAR(3)
DEFINE sqltxt CHAR(500)
LET dbtype = db_get_database_type()
CASE dbtype
WHEN "ORA"
LET sqltxt = "RENAME ", oldname CLIPPED,
" TO ", newname CLIPPED
WHEN "MSV"
LET sqltxt = "sp_rename ", oldname CLIPPED,
", ", newname CLIPPED
WHEN "PGS"
LET sqltxt = "ALTER TABLE ", oldname CLIPPED,
" RENAME TO ", newname CLIPPED
OTHERWISE
LET sqltxt = "RENAME TABLE ", oldname CLIPPED,
" TO ", newname CLIPPED
END CASE
WHENEVER ERROR CONTINUE
PREPARE stmt_rename_table FROM sqltxt
IF sqlca.sqlcode<0 THEN RETURN sqlca.sqlcode END IF
EXECUTE stmt_rename_table
WHENEVER ERROR STOP
RETURN sqlca.sqlcode
END FUNCTION
PROYECTO/otrodir/dbadministrator/fgldialog.4gl
+385
View File
@@ -0,0 +1,385 @@
#+ Helper functions.
#+
DEFINE fgl_winDialogDirection STRING
#+ Is this 4gl program connected to a graphical user interface?
#+ @returnType Integer
#+ @return TRUE if connected to graphical user interface.
FUNCTION fgl_fglGui()
DEFINE uiName String
WHENEVER ERROR RAISE
LET uiName=ui.Interface.getFrontEndName()
IF uiName IS NOT NULL then
IF NOT uiName.equals("Console") THEN
RETURN 1
END IF
END IF
WHENEVER ERROR STOP
RETURN 0
END FUNCTION
#+ Opens window with message and choice.
#+ @returnType String
#+ @return The answer string.
#+ @param title Title of the window.
#+ @param message Message to be displayed.
#+ @param ans Default answer.
#+ @param items Pipe separated list of choices.
#+ @param icon Icon specification: 'info','exclamation','stop','question'.
#+ @param dang Danger indicator level ( 0, 1, 2, 3 ) - ignored.
#+
#+ The function returns one of the case-sensitive Strings in the items list.
#+ Displays a message with definable multiple choices.
FUNCTION fgl_winButton(title,message,ans,items,icon,dang)
DEFINE title, message, ans, items, icon STRING
DEFINE dang INTEGER -- unused ?
DEFINE i, itemC INTEGER
DEFINE result String
DEFINE tokenizer base.StringTokenizer
DEFINE itemV array[10] of STRING
DEFINE styleToUse STRING
DEFINE ansU STRING
IF title IS NULL THEN LET title = "" END IF
IF message IS NULL THEN LET message = "" END IF
IF icon IS NULL THEN LET icon = "" END IF
LET title=title.trimRight()
LET message=message.trimRight()
LET icon=icon.trimRight()
LET tokenizer=base.StringTokenizer.create(items,"|")
LET itemC=0
WHILE tokenizer.hasMoreTokens() AND itemC<10
LET itemC=itemC+1
LET itemV[itemC]=tokenizer.nextToken()
END WHILE
IF itemC = 0 THEN RETURN NULL END IF
IF NOT fgl_fglGui() THEN RETURN NULL END IF
IF icon="info" THEN
LET icon="information"
END IF
IF icon != "information" AND icon != "exclamation" AND icon != "stop"
AND icon != "question"
THEN
LET icon = NULL
END IF
LET result = ans
FOR i = itemC+1 TO 10
LET itemV[i]="fgl_winButton_item_No_"||i
END FOR
LET ansU=ans.toUpperCase()
LET styleToUse = "dialog" , fgl_winDialogDirection
MENU title ATTRIBUTE(STYLE=styleToUse,COMMENT=message,IMAGE=icon)
BEFORE MENU
FOR i = itemC+1 TO 10
HIDE OPTION itemV[i]
END FOR
FOR i=1 TO itemC
IF upshift(itemV[i])=ansU THEN
NEXT OPTION itemV[i]
EXIT FOR
END IF
END FOR
COMMAND itemV[1]
LET result=itemV[1]
COMMAND itemV[2]
LET result=itemV[2]
COMMAND itemV[3]
LET result=itemV[3]
COMMAND itemV[4]
LET result=itemV[4]
COMMAND itemV[5]
LET result=itemV[5]
COMMAND itemV[6]
LET result=itemV[6]
COMMAND itemV[7]
LET result=itemV[7]
COMMAND itemV[8]
LET result=itemV[8]
COMMAND itemV[9]
LET result=itemV[9]
COMMAND itemV[10]
LET result=itemV[10]
END MENU
RETURN result
END FUNCTION
#+ Shows a window with message and OK button.
#+ @param title Title of the window.
#+ @param message Message to be displayed.
#+ @param icon Icon specification: 'info','exclamation','stop','question'.
FUNCTION fgl_winMessage(title,message,icon)
DEFINE title String
DEFINE message String
DEFINE icon String
DEFINE ans CHAR(1)
IF NOT fgl_fglGui() THEN
IF LENGTH(message) THEN
PROMPT message CLIPPED FOR CHAR ans
ELSE
PROMPT "" FOR CHAR ans
END IF
RETURN
END IF
IF icon="info" THEN
LET icon="information"
END IF
IF icon != "information"
AND icon != "exclamation"
AND icon != "stop"
AND icon != "question"
THEN
LET icon = NULL
END IF
LET ans = fgl_winQuestion(title,message,1,"OK",icon,0)
END FUNCTION
#+ Prompts for data input.
#+ @returnType String
#+ @return NULL if error.
#+ @param line Line.
#+ @param column Column.
#+ @param message Message.
#+ @param ans Default answer.
#+ @param width Length of input field.
#+ @param type Data type (0=CHAR,1=SMALLINT,2=INTEGER,7=DATE,255=HIDDEN).
FUNCTION fgl_winPrompt(line,column,message,ans,width,type)
DEFINE line INTEGER
DEFINE column INTEGER
DEFINE message String
DEFINE ans String
DEFINE width INTEGER
DEFINE type INTEGER
DEFINE
lgtot INTEGER,
lgmess INTEGER,
newstr CHAR(100),
newint INTEGER,
newdate DATE,
newsma SMALLINT,
endinput SMALLINT,
disp CHAR(512),
errstatus SMALLINT
IF type != 0
AND type != 1
AND type != 2
AND type != 7
AND type != 255
THEN
ERROR "promptat: Unkwon type"
RETURN NULL
END IF
LET lgmess = LENGTH(message)
LET lgtot = LENGTH(message) + width
LET endinput = FALSE
WHILE NOT endinput
WHENEVER ERROR CONTINUE
CASE
WHEN type = 0
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newstr
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 1
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newsma
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 2
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newint
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 7
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newdate
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
WHEN type = 255
PROMPT message CLIPPED ATTRIBUTE(normal) FOR newstr ATTRIBUTE(invisible)
ON KEY(ACCEPT)
LET endinput = FALSE
END PROMPT
END CASE
LET errstatus = status
WHENEVER ERROR STOP
IF int_flag THEN
LET endinput = TRUE
ELSE
IF errstatus < 0 THEN
LET disp = err_get(errstatus)
ERROR disp CLIPPED
ELSE
LET endinput = TRUE
END IF
END IF
END WHILE
CASE
WHEN type = 0
RETURN newstr
WHEN type = 1
RETURN newsma
WHEN type = 2
RETURN newint
WHEN type = 7
RETURN newdate
WHEN type = 255
RETURN newstr
END CASE
RETURN NULL
END FUNCTION
-- fgl_winQuestion
-- Displays a message with fixed choices
-- 1) The function returns case-sensitive localized Strings!
-- 2) The client shows language specific Captions!
#+ Opens window with message and multiple choices.
#+ @returnType String
#+ @return Answer or NULL if error.
#+ @param title Title of the window.
#+ @param message Message to be displayed.
#+ @param ans Default answer.
#+ @param items Pipe separated list of : yes,no,ok,cancel,retry,abort,ignore.
#+ @param icon Icon specification: 'info','exclamation','stop','question'.
#+ @param dang Danger indicator level ( 0, 1, 2, 3 ) - ignored.
FUNCTION fgl_winQuestion(title,message,ans,items,icon,dang)
DEFINE title,message,ans,items,icon String
DEFINE dang Integer # ignored
DEFINE result String
DEFINE answerYes, answerNo, answerOk, answerAbort, answerRetry, answerIgnore, answerCancel String
DEFINE item, uItem String
DEFINE tokenizer base.StringTokenizer
DEFINE styleToUse STRING
IF title is NULL THEN LET title = "" END IF
IF ans is NULL THEN LET ans = "" END IF
IF message is NULL THEN LET message = "" END IF
IF icon is NULL THEN LET icon = "" END IF
LET icon=icon.trimRight()
LET title=title.trimRight()
LET message=message.trimRight()
LET icon=icon.trimRight()
IF icon="info" THEN
LET icon="information"
END IF
IF icon!="information" AND icon!="exclamation" AND icon!="stop"
AND icon!="question" THEN
LET icon = ""
END IF
LET ans=ans.toUpperCase()
LET styleToUse = "winmsg" , fgl_winDialogDirection
MENU title attribute(style=styleToUse,comment=message,image=icon)
BEFORE MENU
HIDE OPTION ALL
LET tokenizer=base.StringTokenizer.create(items,"|")
IF NOT tokenizer.hasMoreTokens() THEN RETURN NULL END IF
WHILE tokenizer.hasMoreTokens()
LET item=tokenizer.nextToken()
LET uItem = item.toUpperCase()
CASE
WHEN uitem = "JA" OR uitem = "OUI" OR uitem="YES"
SHOW OPTION "yes"
LET answerYes=item
IF ans==uitem then NEXT OPTION "yes" END IF
WHEN uitem = "NO" OR uitem = "NEIN" OR uitem="NON"
SHOW OPTION "no"
LET answerNo=item
IF ans==uItem then NEXT OPTION "no" END IF
WHEN uItem = "OK"
SHOW OPTION "ok"
LET answerOk= item
IF ans==uItem then NEXT OPTION "ok" END IF
WHEN uitem="CANCEL" OR uitem="INTERROMPRE" OR uitem="UNTERBRECHEN"
OR uItem="INTERRUPT" OR uItem="ANNULER"
SHOW OPTION "cancel"
LET answerCancel=item
IF ans==uItem THEN NEXT OPTION "cancel" END IF
WHEN uitem="WIEDERHOLEN" OR uitem="REPETER" OR uitem="RETRY"
SHOW OPTION "retry"
LET answerRetry=item
IF ans==uItem then NEXT OPTION "retry" END IF
WHEN uitem="IGNORER" OR uitem="IGNORE"
OR uitem="IGNORIEREN" OR uitem="UEBERGEHEN" OR uitem="_BERGEHEN"
SHOW OPTION "ignore"
LET answerIgnore=item
IF ans==uItem THEN NEXT OPTION "ignore" END IF
WHEN uitem="ABANDON" OR uitem="ABORT" OR uitem="ABBRECHEN"
SHOW OPTION "abort"
let answerAbort=item
IF ans==uItem THEN NEXT OPTION "abort" END IF
OTHERWISE
ERROR "Bad option '",item,"' in function fgl_winquestion"
RETURN NULL
END CASE
END WHILE
COMMAND "yes"
LET result=answerYes
COMMAND "no"
LET result=answerNo
COMMAND "ok"
LET result=answerOk
COMMAND "abort"
LET result=answerAbort
COMMAND "retry"
LET result=answerRetry
COMMAND "ignore"
LET result=answerIgnore
COMMAND "cancel"
LET result=answerCancel
END MENU
RETURN result
END FUNCTION
#+ Display a message and wait for a key press.
#+ @param message Message to be displayed.
FUNCTION fgl_winWait(message)
DEFINE message String
DEFINE l SMALLINT
DEFINE c SMALLINT
DEFINE win SMALLINT
DEFINE ans CHAR(1)
DEFINE lg SMALLINT
IF NOT fgl_fglGui() THEN
LET lg = LENGTH(message)
IF win AND l AND c AND lg THEN
OPEN WINDOW w_wait AT l, c WITH 1 ROWS, lg COLUMNS ATTRIBUTE (BORDER)
PROMPT message CLIPPED FOR CHAR ans
CLOSE WINDOW w_wait
ELSE
IF lg>0 THEN
PROMPT message CLIPPED FOR CHAR ans
ELSE
PROMPT "" FOR CHAR ans
END IF
END IF
RETURN
END IF
LET ans = fgl_winQuestion("",message,1,"OK","",0)
END FUNCTION
#+ Checks UI client to be WTK.
#+ @returnType Integer
#+ @return TRUE if the UI is a WTK.
FUNCTION fgl_wtkClient()
DEFINE uiName String
LET uiName=ui.Interface.getFrontEndName()
IF uiName IS NOT NULL then
IF uiName.equals("Wtk") THEN
RETURN 1
END IF
END IF
RETURN 0
END FUNCTION
FUNCTION fgl_setWinDialogDirectionRightToLeft()
LET fgl_winDialogDirection = " rightToLeft"
END FUNCTION
FUNCTION fgl_setWinDialogDirectionLeftToRight()
LET fgl_winDialogDirection = " leftToRight"
END FUNCTION
-- fgl_fixedcomment
PROYECTO/otrodir/dbadministrator/fgldraw.4gl
+315
View File
@@ -0,0 +1,315 @@
#+ Simple draw functions for Canvases.
#+
GLOBALS
DEFINE __fgldraw_theCanvas om.DomNode
DEFINE __fgldraw_theCanvas_fillColor String
DEFINE __fgldraw_theCanvas_linesAreBlack INTEGER
DEFINE __fgldraw_theCanvas_anchor String
DEFINE __fgldraw_theCanvas_fontSize String
DEFINE __fgldraw_theCanvas_trans INTEGER
DEFINE __fgldraw_theCanvas_lineWidth INTEGER
END GLOBALS
FUNCTION drawInit ()
LET __fgldraw_theCanvas=NULL
LET __fgldraw_theCanvas_fillColor="white"
LET __fgldraw_theCanvas_linesAreBlack = 0
LET __fgldraw_theCanvas_lineWidth = 1
END FUNCTION
#+ Selects a canvas.
#+ @param canvasName Canvas identifier.
#+
#+ The function initializes the fillColor to "white",
#+ the anchor to "s".
#+
#+ The selected canvas is the parent for all susequently created objects.
FUNCTION drawSelect(canvasName)
DEFINE canvasName String
DEFINE formField om.DomNode
DEFINE w ui.Window
let w = ui.Window.getCurrent()
let formField=w.findNode("Canvas",canvasName)
if formField is NULL then
initialize __fgldraw_theCanvas to NULL
end if
# let __fgldraw_theCanvas=formField.getFirstChild()
let __fgldraw_theCanvas=formField
let __fgldraw_theCanvas_fillColor="white"
let __fgldraw_theCanvas_trans=0
let __fgldraw_theCanvas_anchor="s"
initialize __fgldraw_theCanvas_fontSize to null
END FUNCTION
#+ Enable or Disable color mode for lines.
#+ @param ColorLines FALSE:Lines are in color, TRUE:Lines are black.
#+
#+ This is a global configuration.
FUNCTION drawDisableColorLines(ColorLines)
DEFINE ColorLines SMALLINT
IF ColorLines != 1 THEN
LET __fgldraw_theCanvas_linesAreBlack = FALSE
ELSE
LET __fgldraw_theCanvas_linesAreBlack = TRUE
END IF
END FUNCTION
#+ Set fill color.
#+ @param color The name of the color for filling shapes.
FUNCTION drawFillColor(color)
DEFINE color String
let __fgldraw_theCanvas_fillColor=color.trim()
END FUNCTION
#+ Define the with of the lines.
#+ @param width Pen size for drawing.
FUNCTION drawLineWidth(width)
DEFINE width SMALLINT
LET __fgldraw_theCanvas_lineWidth = width
END FUNCTION
#+ Set anchor to draw a text.
#+ @param a One of: 'n','e','s','w'
FUNCTION drawAnchor(a)
DEFINE a String
LET __fgldraw_theCanvas_anchor=a.trim()
IF __fgldraw_theCanvas_trans THEN
CASE a
WHEN "n" LET __fgldraw_theCanvas_anchor="e"
WHEN "e" LET __fgldraw_theCanvas_anchor="n"
WHEN "s" LET __fgldraw_theCanvas_anchor="w"
WHEN "w" LET __fgldraw_theCanvas_anchor="s"
END CASE
END IF
END FUNCTION
#+ Set the fontSize attribute for all subsequent drawText operations.
#+ @param size fontSize The new font size.
FUNCTION drawSetFontSize(size)
DEFINE size String
LET __fgldraw_theCanvas_fontSize=size.trim()
END FUNCTION
#+ Draws a line.
#+ @param startX The x start position.
#+ @param startY The y start position.
#+ @param dy The relative y end position.
#+ @param dx The relative x end position.
#+ @return Item identifier in the canvas.
FUNCTION drawLine(startY,startX,dy,dx)
DEFINE m om.DomNode
DEFINE startY,startX,dy,dx INTEGER
IF __fgldraw_theCanvas is NULL THEN
return NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasLine")
if NOT __fgldraw_theCanvas_linesAreBlack then
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
end if
CALL m.setAttribute("startY",startY);
CALL m.setAttribute("startX",startX);
CALL m.setAttribute("endY",startY+dy);
CALL m.setAttribute("endX",startX+dx);
CALL m.setAttribute("width",__fgldraw_theCanvas_lineWidth);
return m.getId()
END FUNCTION
#+ Draws a text.
#+ @param startX The x start position.
#+ @param startY The y start position.
#+ @param text Text to draw.
#+ @return Item identifier in the canvas.
FUNCTION drawText(startY,startX,text)
DEFINE startY,startX INTEGER
DEFINE text String
DEFINE m om.DomNode
IF __fgldraw_theCanvas is NULL THEN
RETURN NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasText")
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
CALL m.setAttribute("startY",startY);
CALL m.setAttribute("startX",startX);
CALL m.setAttribute("text",text.trim());
CALL m.setAttribute("anchor",__fgldraw_theCanvas_anchor);
if __fgldraw_theCanvas_fontSize is not null then
CALL m.setAttribute("fontSize",__fgldraw_theCanvas_fontSize);
end if
return m.getId()
END FUNCTION
#+ Draws a rectangle.
#+ @param startX The x start position.
#+ @param startY The y start position.
#+ @param width The rectangle width.
#+ @param height The rectangle height.
FUNCTION drawRectangle(startY,startX,height,width)
DEFINE startY,startX,height,width INTEGER
DEFINE m om.DomNode
IF __fgldraw_theCanvas is NULL THEN
return NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasRectangle")
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
CALL m.setAttribute("startY",startY);
CALL m.setAttribute("startX",startX);
CALL m.setAttribute("endY",startY+height);
CALL m.setAttribute("endX",startX+width);
return m.getId()
END FUNCTION
#+ Draws an Circle from a bounding square.
#+ @returnType INTEGER
#+ @param startX The x start position of the boundig square.
#+ @param startY The y start position of the boundig square.
#+ @param diameter The diameter (the width of the bounding square).
#+ @return Item identifier in the canvas.
FUNCTION drawCircle(startY,startX,diameter)
DEFINE m om.DomNode
DEFINE startY,startX,diameter INTEGER
IF __fgldraw_theCanvas is NULL THEN
RETURN NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasCircle")
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
CALL m.setAttribute("startY",startY);
CALL m.setAttribute("startX",startX);
CALL m.setAttribute("diameter",diameter);
return m.getId()
END FUNCTION
#+ Draws an Oval from a bounding rectangle.
#+ @returnType INTEGER
#+ @param startX The x start position of the bounding rectangle.
#+ @param startY The y start position of the bounding rectangle.
#+ @param width The width of the bounding rectangle.
#+ @param height The the height of the bounding rectangle.
#+ @return Item identifier in the canvas.
FUNCTION drawOval(startY,startX,height,width)
DEFINE m om.DomNode
DEFINE startY,startX,height,width INTEGER
IF __fgldraw_theCanvas is NULL THEN
RETURN NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasOval")
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
CALL m.setAttribute("startY",startY);
CALL m.setAttribute("startX",startX);
CALL m.setAttribute("endY",startY+height);
CALL m.setAttribute("endX",startX+width);
return m.getId()
END FUNCTION
#+ Draws a filled polygone.
#+ @param xyList A blank separated list of points.
#+ @return Item identifier in the canvas.
FUNCTION drawPolygon(xyList)
DEFINE m om.DomNode
DEFINE xyList String
IF __fgldraw_theCanvas is NULL THEN
RETURN NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasPolygon")
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
CALL m.setAttribute("xyList",xyList);
RETURN m.getId()
END FUNCTION
#+ Draws an arc in a bounding square.
#+ @param startX The x start position of the bounding quadrat.
#+ @param startY The y start position of the bounding quadrat.
#+ @param diameter The diameter (the with of the bounding quadrat).
#+ @param startDegrees Specifies the beginning of the angular range occupied
#+ by the arc.
#+ @param extentDegrees Specifies the size of the angular range occupied by
#+ the arc.
#+ @return Item identifier in the canvas.
FUNCTION drawArc(startY,startX,diameter,startDegrees,extentDegrees)
DEFINE m om.DomNode
DEFINE startY,startX,diameter,startDegrees,extentDegrees INTEGER
IF __fgldraw_theCanvas is NULL THEN
RETURN NULL
END IF
LET m=__fgldraw_theCanvas.createChild("CanvasArc")
CALL m.setAttribute("fillColor",__fgldraw_theCanvas_fillColor);
CALL m.setAttribute("startY",startY);
CALL m.setAttribute("startX",startX);
CALL m.setAttribute("diameter",diameter);
CALL m.setAttribute("startDegrees",startDegrees);
CALL m.setAttribute("extentDegrees",extentDegrees);
return m.getId()
END FUNCTION
#+ Clears the drawing area.
FUNCTION drawClear()
DEFINE c om.DomNode
IF __fgldraw_theCanvas is not NULL THEN
LET c=__fgldraw_theCanvas.getFirstChild()
WHILE c is NOT NULL
CALL __fgldraw_theCanvas.removeChild(c)
LET c=__fgldraw_theCanvas.getFirstChild()
END WHILE
END IF
END FUNCTION
#+ Defines key to send when left button click on.
#+ @param id Item identifier.
#+ @param key Key to send.
FUNCTION drawButtonLeft(id,key)
DEFINE id INTEGER
DEFINE key String
DEFINE m om.DomNode
DEFINE doc om.DomDocument
LET doc=ui.Interface.getDocument()
LET m=doc.getElementById(id)
IF m is NOT NULL THEN
CALL m.setAttribute("acceleratorKey1",key.trim())
END IF
END FUNCTION
#+ Defines key to send when right button click on.
#+ @param id Item identifier.
#+ @param key Key to send.
FUNCTION drawButtonRight(id,key)
DEFINE id INTEGER
DEFINE key String
DEFINE m om.DomNode
DEFINE doc om.DomDocument
LET doc=ui.Interface.getDocument()
LET m=doc.getElementById(id)
IF m is NOT NULL THEN
CALL m.setAttribute("acceleratorKey3",key.trim())
END IF
END FUNCTION
#+ Removes key bindings between item and mouse.
#+ @param id Item identifier.
#+ @param key Key to send.
FUNCTION drawClearButton(id,key)
DEFINE id INTEGER
DEFINE key String
DEFINE m om.DomNode
DEFINE doc om.DomDocument
LET doc=ui.Interface.getDocument()
LET m=doc.getElementById(id)
IF m is NOT NULL THEN
CALL m.setAttribute("acceleratorKey1","")
CALL m.setAttribute("acceleratorKey3","")
END IF
END FUNCTION
#+ Sets a comment for a canvas item.
#+ @param id Item identifier.
#+ @param comment Comment to set.
FUNCTION drawSetComment(id,comment)
DEFINE id INTEGER
DEFINE comment String
DEFINE m om.DomNode
DEFINE doc om.DomDocument
LET doc=ui.Interface.getDocument()
LET m=doc.getElementById(id)
IF m is NOT NULL THEN
CALL m.setAttribute("comment",comment.trim())
END IF
END FUNCTION
PROYECTO/otrodir/dbadministrator/fgldummy4js.4gl
+34
View File
@@ -0,0 +1,34 @@
#+ Dummy functions for FJS BDL 3.x compatibility.
#+ Miscellaneous initializations.
#+
#+ This is a dummy-function for FJS BDL 3.x compatibility.
FUNCTION fgl_init4js()
RETURN
END FUNCTION
#+ Selects a ressource file.
#+ @param filename Resource file.
#+
#+ This is a dummy-function for FJS BDL 3.x compatibility.
FUNCTION fgl_resource(filename)
DEFINE filename String
END FUNCTION
#+ Get the value of a variable defined at the ui-client.
#+ @param name Remote variable name.
#+
#+ This is a dummy-function for FJS BDL 3.x compatibility.
FUNCTION fgl_uiRetrieve(name)
DEFINE name String
RETURN NULL
END FUNCTION
#+ Get the value of a variable defined at the ui-client.
#+ @param name Remote variable name.
#+
#+ This is a dummy-function for FJS BDL 3.x compatibility.
FUNCTION fgl_uiSendCommand(n)
DEFINE n CHAR(256)
END FUNCTION
PROYECTO/otrodir/dbadministrator/fglhelp.4gl
+114
View File
@@ -0,0 +1,114 @@
CONSTANT mtit=%"fgl.helpViewer.title"
CONSTANT mop1=%"fgl.helpViewer.screen"
CONSTANT mhp1=%"fgl.helpViewer.nextpage"
CONSTANT mop2=%"fgl.helpViewer.resume"
CONSTANT mhp2=%"fgl.helpViewer.finish"
CONSTANT eohm=%"fgl.helpViewer.endmsg"
FUNCTION showhelp(id)
DEFINE id INTEGER
DEFINE txt STRING
LET txt=fgl_gethelp(id)
IF txt IS NULL THEN RETURN END IF
IF fgl_getenv("FGLGUI")=0 THEN
CALL __showhelp_txt(txt)
ELSE
CALL __showhelp_gui(txt)
END IF
END FUNCTION
FUNCTION __showhelp_txt(txt)
CONSTANT nlines = 24
DEFINE idx INTEGER,again INTEGER
DEFINE txt STRING
DEFINE l,p,y,y0,y1,nrows INTEGER
DEFINE sep CHAR(2),psep CHAR(1)
DEFINE tok,ptok base.StringTokenizer
DEFINE s STRING
DEFINE lastPage STRING
LET sep[1]=ascii(10) -- \n
LET sep[2]=ascii(13) -- \r
LET psep[1]=ascii(12) -- \f
LET nrows=nlines+1
OPEN WINDOW helpSessionTxt AT 1,1 WITH nrows ROWS, 80 COLUMNS
ATTRIBUTE(MESSAGE LINE LAST, MENU LINE FIRST)
LET y0 = 4
LET y1 = nlines-1
MENU mtit
BEFORE MENU
LABEL nextpage:
LET y=y0
IF ptok IS NULL THEN
LET ptok=base.StringTokenizer.createExt(txt,psep,NULL,FALSE);
INITIALIZE tok TO NULL
END IF
IF tok IS NULL THEN
LET s=ptok.nextToken()
LET tok=base.StringTokenizer.createExt(s,sep,NULL,TRUE)
END IF
IF NOT tok.hasMoreTokens() THEN
IF NOT ptok.hasMoreTokens() THEN
INITIALIZE ptok TO NULL
MESSAGE eohm CLIPPED ATTRIBUTE(REVERSE)
NEXT OPTION mop2
ELSE
LET s=ptok.nextToken()
LET tok=base.StringTokenizer.createExt(s,sep,NULL,TRUE)
END IF
END IF
IF NOT tok.hasMoreTokens() THEN
INITIALIZE ptok TO NULL
MESSAGE eohm CLIPPED ATTRIBUTE(REVERSE)
NEXT OPTION mop2
END IF
CLEAR WINDOW helpSessionTxt
DISPLAY "-------------------------------------------------------------------------------" AT 3,1
WHILE tok.hasMoreTokens() AND y<=y1
DISPLAY tok.nextToken() AT y,1
LET y=y+1
END WHILE
IF NOT ptok.hasMoreTokens() AND NOT tok.hasMoreTokens() THEN
INITIALIZE ptok TO NULL
MESSAGE eohm CLIPPED ATTRIBUTE(REVERSE)
NEXT OPTION mop2
ELSE
NEXT OPTION mop1
END IF
COMMAND mop1 mhp1
GOTO nextpage
COMMAND mop2 mhp2
EXIT MENU
END MENU
CLOSE WINDOW helpSessionTxt
END FUNCTION
FUNCTION __showhelp_gui(thetext)
DEFINE thetext STRING
DEFINE ptok base.StringTokenizer
DEFINE s STRING
DEFINE psep CHAR(1)
LET psep[1]=ascii(12)
OPEN WINDOW helpSessionGui WITH FORM "fglhelp"
MENU
BEFORE MENU
LABEL gui_nextpage:
IF ptok IS NULL THEN
LET ptok=base.StringTokenizer.createExt(thetext,psep,NULL,FALSE);
END IF
IF ptok.hasMoreTokens() THEN
LET s=ptok.nextToken()
DISPLAY s TO theText
END IF
IF NOT ptok.hasMoreTokens() THEN
INITIALIZE ptok TO NULL
END IF
ON ACTION helpscreen GOTO gui_nextpage
ON ACTION helpresume EXIT MENU
ON ACTION close EXIT MENU
END MENU
CLOSE WINDOW helpSessionGui
END FUNCTION
PROYECTO/otrodir/dbadministrator/fglhelp.per
+53
View File
@@ -0,0 +1,53 @@
ACTION DEFAULTS
ACTION helpscreen ( ACCELERATOR = RETURN )
ACTION helpresume ( ACCELERATOR = ESCAPE )
END
LAYOUT(TEXT=%"fgl.helpViewer.title",STYLE="viewer")
VBOX
GRID
{
[text ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
}
END
GRID
{
[b_screen ][b_resume ]
}
END
END
ATTRIBUTES
TEXTEDIT text = FORMONLY.thetext,FONTPITCH=FIXED,STRETCH=BOTH;
BUTTON b_screen : helpscreen, TEXT=%"fgl.helpViewer.screen", COMMENT=%"fgl.helpViewer.nextpage";
BUTTON b_resume : helpresume, TEXT=%"fgl.helpViewer.resume", COMMENT=%"fgl.helpViewer.finish";
END
PROYECTO/otrodir/dbadministrator/fglreport.4gl
+120
View File
@@ -0,0 +1,120 @@
CONSTANT buff_size = 20
DEFINE buff ARRAY[buff_size] OF STRING
DEFINE
interrupted SMALLINT,
finished SMALLINT,
curr_page INTEGER,
page_count INTEGER,
offset INTEGER
FUNCTION fgl_report_start()
OPEN WINDOW fglreport WITH FORM "fglreport"
LET curr_page = 0
LET page_count = 0
LET offset = 0
LET interrupted = FALSE
LET finished = FALSE
END FUNCTION
FUNCTION fgl_report_show_page(thepage)
DEFINE thepage STRING
IF interrupted THEN RETURN END IF
CURRENT WINDOW IS fglreport
IF NOT finished THEN
LET page_count = page_count+1
LET buff[(page_count MOD buff_size)+1] = thepage
IF page_count>buff_size THEN
LET offset=offset+1
END IF
END IF
LET curr_page=page_count
IF curr_page<=0 THEN
RETURN -- can't happen
END IF
DISPLAY curr_page TO pgnum
LET thepage=buff[(curr_page MOD buff_size)+1]
DISPLAY BY NAME thepage
MENU
BEFORE MENU
CALL DIALOG.setActionActive("reportprevpage",(page_count>1))
CALL DIALOG.setActionActive("reportnextpage",(not finished))
ON ACTION reportnextpage
IF curr_page==page_count THEN
EXIT MENU
END IF
LET curr_page=curr_page+1
LET thepage=buff[(curr_page MOD buff_size)+1]
DISPLAY BY NAME thepage
DISPLAY curr_page TO pgnum
IF curr_page==page_count AND finished THEN
CALL DIALOG.setActionActive("reportnextpage",FALSE)
END IF
CALL DIALOG.setActionActive("reportprevpage",(page_count>1))
ON ACTION reportprevpage
IF curr_page>1 THEN
LET curr_page=curr_page-1
let thepage=buff[(curr_page MOD buff_size)+1]
DISPLAY curr_page TO pgnum
DISPLAY BY NAME thepage
IF curr_page=offset+1 THEN
CALL DIALOG.setActionActive("reportprevpage",FALSE)
END IF
CALL DIALOG.setActionActive("reportnextpage",(curr_page<page_count))
END IF
COMMAND KEY(INTERRUPT) "cancel"
LET int_flag = TRUE
LET interrupted = TRUE
EXIT MENU
ON ACTION CLOSE
LET int_flag = TRUE
LET interrupted = TRUE
EXIT MENU
END MENU
END FUNCTION
FUNCTION fgl_report_finish()
DEFINE strbuf STRING
LET finished = TRUE
IF NOT interrupted AND page_count > 0 THEN
-- CALL fgl_winmessage("Report Viewer", "End of report", "information")
CALL fgl_report_show_page(NULL)
END IF
CLOSE WINDOW fglreport
INITIALIZE buff to NULL
LET page_count=0
LET curr_page=0
LET offset=0
END FUNCTION
FUNCTION fgl_reportToClient_start()
DEFINE started INTEGER
LET interrupted=FALSE
CALL ui.Interface.frontCall("standard","fgl_report_start",[],[started])
IF NOT started THEN
LET interrupted=TRUE
LET int_flag=TRUE
END IF
END FUNCTION
FUNCTION fgl_reportToClient_show_page(thepage)
DEFINE thepage STRING
DEFINE rv INTEGER
IF interrupted THEN RETURN END IF
CALL ui.Interface.frontCall("standard","fgl_report_printpage",[thepage],[rv])
IF NOT rv THEN
LET interrupted=TRUE
LET int_flag=TRUE
END IF
END FUNCTION
FUNCTION fgl_reportToClient_finish()
DEFINE rv INTEGER
IF interrupted THEN RETURN END IF
CALL ui.Interface.frontCall("standard","fgl_report_finish",[],[rv])
IF NOT rv THEN
LET interrupted=TRUE
LET int_flag=TRUE
END IF
END FUNCTION
PROYECTO/otrodir/dbadministrator/fglreport.per
+62
View File
@@ -0,0 +1,62 @@
ACTION DEFAULTS
ACTION reportnextpage ( ACCELERATOR = NEXT, ACCELERATOR2 = RETURN )
ACTION reportprevpage ( ACCELERATOR = PRIOR )
ACTION cancel ( ACCELERATOR = ESCAPE )
END
LAYOUT(TEXT=%"fgl.reportViewer.title",STYLE="viewer")
VBOX
GRID
{
[page ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
[ ]
}
END
GRID
{
[b_prevpage ] [b_nextpage ] [b_stop]
}
END
GRID
{
[l_pg][pgnum ]
}
END
END
ATTRIBUTES
EDIT pgnum = FORMONLY.pgnum;
TEXTEDIT page = FORMONLY.thepage,FONTPITCH=FIXED,SCROLLBARS=BOTH,STRETCH=BOTH;
BUTTON b_prevpage : reportprevpage, TEXT=%"fgl.reportViewer.prevPage";
BUTTON b_nextpage : reportnextpage, TEXT=%"fgl.reportViewer.nextPage";
BUTTON b_stop : cancel, TEXT=%"fgl.reportViewer.cancel";
LABEL l_pg : TEXT=%"fgl.reportViewer.page";
END
PROYECTO/otrodir/dbadministrator/fglwinexec.4gl
+289
View File
@@ -0,0 +1,289 @@
#+ Remote execution of client hosted programs.
#+
DEFINE DDECallStatus SMALLINT
DEFINE DDECallResult SMALLINT
#+ Starts a program on the workstation without waiting.
#+ @return Boolean
#+ @param commandLine Program name.
#+ @return TRUE on success, FALSE on error.
#+
#+ @code 4gl
#+ LET result=winExec("notepad")
#+ -- 1 backslash in the resulting commandline at the client side
#+ -- requires 4 backslash characters in the source. To avoid the
#+ -- backslash hell one should add the executables in the path
#+ -- at the client side.
#+ LET result=winExec("c:\\\\windows\\\\system32\\\\notepad.exe")
#+ LET result=winExec("\\\\\\\\MYCOMPUTER\\\\C\\\\windows\\\\system32\\\\notepad.exe")
FUNCTION winExec(commandLine)
DEFINE commandLine STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
let commandLine=__fgl_convertTclString(commandLine)
CALL ui.Interface.frontcall("standard","execute",[commandLine,0],[result])
WHENEVER ERROR STOP
IF STATUS=0 THEN RETURN result ELSE RETURN FALSE END IF
END FUNCTION
#+ Starts a program on the workstation and waits for program-termination.
#+ @returnType Boolean
#+ @param commandLine Program name with or without absolute path.
#+ @return TRUE on success, FALSE on error.
FUNCTION winExecWait(commandLine)
DEFINE commandLine STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
let commandLine=__fgl_convertTclString(commandLine)
CALL ui.Interface.frontcall("standard","execute",[commandLine,1],[result])
WHENEVER ERROR STOP
IF STATUS=0 THEN RETURN result ELSE RETURN FALSE END IF
END FUNCTION
#+ Opens a document on the workstation with the corresponding program.
#+ @returnType Boolean
#+ @param fileName Document name with or without absolute path.
#+ @return TRUE on success, FALSE on error.
FUNCTION winShellExec(fileName)
DEFINE fileName STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("standard","shellexec",[fileName],[result])
WHENEVER ERROR STOP
IF STATUS=0 THEN RETURN result ELSE RETURN FALSE END IF
END FUNCTION
#+ Opens a dialog to search a file on the workstation.
#+ @returnType Boolean
#+ @param dirName Default directory name.
#+ @param typeName The name to be displayed for the file type.
#+ @param typeExts Blank separated list of file extensions.
#+ @param caption The caption to be displayed.
#+ @return A file name on success, otherwise NULL.
FUNCTION winOpenFile(dirName,typeName,typeExts,caption)
DEFINE dirName STRING
DEFINE typeName STRING
DEFINE typeExts STRING
DEFINE caption STRING
DEFINE fn STRING
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("standard","openfile",
[dirName,typeName,typeExts,caption],[fn])
WHENEVER ERROR STOP
IF STATUS=0 THEN RETURN fn ELSE RETURN NULL END IF
END FUNCTION
#+ Opens a dialog to save a file on the workstation.
#+ @returnType Boolean
#+ @param dirName Default directory name.
#+ @param typeName The name to be displayed for the file type.
#+ @param typeExts Blank separated list of file extensions.
#+ @param caption The caption to be displayed.
#+ @return A file name on success, otherwise NULL.
FUNCTION winSaveFile(dirName,typeName,typeExts,caption)
DEFINE dirName STRING
DEFINE typeName STRING
DEFINE typeExts STRING
DEFINE caption STRING
DEFINE fn STRING
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("standard","savefile",
[dirName,typeName,typeExts,caption],[fn])
WHENEVER ERROR STOP
IF STATUS=0 THEN RETURN fn ELSE RETURN NULL END IF
END FUNCTION
#+ Opens a dialog to search a directory on the workstation.
#+ @returnType Boolean
#+ @param dirName Default directory name.
#+ @param caption The caption to be displayed.
#+ @return A directory name on success, otherwise NULL.
FUNCTION winOpenDir(dirName,caption)
DEFINE dirName STRING
DEFINE caption STRING
DEFINE dn STRING
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("standard","opendir",[dirName,caption],[dn])
WHENEVER ERROR STOP
IF STATUS=0 THEN RETURN dn ELSE RETURN NULL END IF
END FUNCTION
#-------------------------------------------------------------------------------
FUNCTION __returnDDECallResult(s,r)
DEFINE s,r INTEGER
LET DDECallStatus=s
LET DDECallResult=r
IF DDECallStatus=0 THEN
RETURN DDECallResult
ELSE
RETURN FALSE
END IF
END FUNCTION
#+ Starts a DDE connection.
#+ @returnType Boolean
#+ @param progname DDE server program to start ('WINWORD', 'EXCEL').
#+ @param docname Name of the document to open or 'System'.
#+ @return TRUE on success, FALSE on error, get message with DDEGetError().
#+
#+ Warning: Document names depend from the workstation language, for example,
#+ on a German Windows the first document is "Dokument1".
FUNCTION DDEConnect(progname,docname)
DEFINE progname STRING
DEFINE docname STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("WINDDE","DDEConnect",[progname,docname],[result])
WHENEVER ERROR STOP
RETURN __returnDDECallResult(STATUS,result)
END FUNCTION
FUNCTION __fgl_convertTclString(s)
DEFINE s String
DEFINE b base.StringBuffer
DEFINE i INTEGER
DEFINE c,cr CHAR
LET cr=ascii(13)
LET b=base.StringBuffer.create()
CALL b.append(s)
LET i=0
LET i=b.getIndexOf("\\",i+1)
WHILE i>0 AND i<b.getLength()
LET c=b.getCharAt(i+1)
CASE c
WHEN "t"
CALL b.replaceAt(i,2,"\t")
WHEN "n"
CALL b.replaceAt(i,2,"\n")
WHEN "r"
CALL b.replaceAt(i,2,cr)
WHEN "\\"
CALL b.replaceAt(i,2,"\\")
OTHERWISE
CALL b.replaceAt(i,1,"")
END CASE
LET i=b.getIndexOf("\\",i+1)
END WHILE
RETURN b.toString()
END FUNCTION
#+ Sends a DDE command to be executed.
#+ @param progname DDE server program.
#+ @param docname Document name or 'System'.
#+ @param cells Cell specs (Ger = Z#S#:Z#S#, Eng = R#C#:R#C#, Fre = L#C#:L#C#).
#+ @param values Tab separated list of values ( 'XX\tYY\tZZ' ).
#+ @return TRUE on success, FALSE on error, get message with DDEGetError().
FUNCTION DDEPoke(progname,docname,cells,values)
DEFINE progname STRING
DEFINE docname STRING
DEFINE cells STRING
DEFINE values STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
let values=__fgl_convertTclString(values)
CALL ui.Interface.frontcall("WINDDE","DDEPoke",
[progname CLIPPED,docname CLIPPED,cells CLIPPED,values CLIPPED],[result])
WHENEVER ERROR STOP
RETURN __returnDDECallResult(STATUS,result)
END FUNCTION
#+ Sends a DDE command to be executed.
#+ @param progname DDE server program.
#+ @param docname Document name or 'System'.
#+ @param execcmd Command to be executed.
#+ @return TRUE on success, FALSE on error, get message with DDEGetError().
#+ The execcmd will be enclosed in brackets - see DDEExecute.
FUNCTION DDEExecute(progname,docname,execcmd)
DEFINE progname STRING
DEFINE docname STRING
DEFINE execcmd STRING
let execcmd="[",__fgl_convertTclString(execcmd),"]"
-- let execcmd ="\\["||execcmd||"\\]"
RETURN DDEExecute2(progname,docname,execcmd)
END FUNCTION
#+ Sends a DDE command to be executed.
#+ @returnType Boolean
#+ @param progname DDE server program.
#+ @param docname Document name or 'System'.
#+ @param execcmd Command to be executed.
#+ @return TRUE on success, FALSE on error, get message with DDEGetError().
#+
#+ The execcmd will be sent untouched - see DDEExecute.
FUNCTION DDEExecute2(progname,docname,execcmd)
DEFINE progname STRING
DEFINE docname STRING
DEFINE execcmd STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("WINDDE","DDEExecute",
[progname CLIPPED,docname CLIPPED,execcmd CLIPPED],[result])
WHENEVER ERROR STOP
RETURN __returnDDECallResult(STATUS,result)
END FUNCTION
#+ Retrieve a DDE command to be executed.
#+ @param progname DDE server program.
#+ @param docname Document name or 'System'.
#+ @param cells Cell specs (Ger = Z#S#:Z#S#, Eng = R#C#:R#C#, Fre = L#C#:L#C#).
#+ @return Tab separated list of values ( 'XX\tYY\tZZ' )."
FUNCTION DDEPeek(progname,docname,cells)
DEFINE progname STRING
DEFINE docname STRING
DEFINE cells STRING
DEFINE result INTEGER
DEFINE value STRING
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("WINDDE","DDEPeek",
[progname CLIPPED,docname CLIPPED,cells CLIPPED],[result,value])
WHENEVER ERROR STOP
LET DDECallStatus=STATUS
RETURN value
END FUNCTION
#+ Terminates a DDE connection.
#+ @returnType Boolean
#+ @param progname DDE server program.
#+ @param docname Document name or 'System'.
#+ @return TRUE on success, FALSE on error, get message with DDEGetError().
FUNCTION DDEFinish(progname,docname)
DEFINE progname STRING
DEFINE docname STRING
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("WINDDE","DDEFinish",[progname,docname],[result])
WHENEVER ERROR STOP
RETURN __returnDDECallResult(STATUS,result)
END FUNCTION
#+ Terminates all DDE connections.
FUNCTION DDEFinishAll()
DEFINE result INTEGER
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("WINDDE","DDEFinishAll",[],[result])
WHENEVER ERROR STOP
LET DDECallStatus = STATUS
END FUNCTION
#+ Returns last DDE error message.
#+ @return The last error message.
FUNCTION DDEGetError()
DEFINE s INTEGER
DEFINE errmsg STRING
IF DDECallStatus IS NULL THEN RETURN NULL END IF
IF DDECallStatus<>0 THEN
LET errmsg="DDE Function Call Error: " || DDECallStatus
ELSE
IF NOT DDECallResult THEN
LET DDECallResult=TRUE
WHENEVER ERROR CONTINUE
CALL ui.Interface.frontcall("WINDDE","DDEError",[],[errmsg])
WHENEVER ERROR STOP
END IF
END IF
RETURN errmsg
END FUNCTION