home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
postpr.zip
/
postproc.cmd
next >
Wrap
OS/2 REXX Batch file
|
1994-07-12
|
48KB
|
1,240 lines
/* VisPro REXX DB2 generated code post processor */
/* POSTPROC.CMD */
/* DPB 1 jul 94 created and distributed */
/* jrb 5 jul 94 made into subroutines POSTPRJB.CMD */
/* jrb 6 jul 94 additional file header documentation */
/* ddlfile in specific project folder */
/* dpb 7/8/94 added COMMIT to ADD, CHANGE, DELETE events */
/* v 1.1 added author parameter */
/* fixed minor bug in SQUOTEIT & SQUOTEWC code */
/* dpb/ 7/12/94 added HINT code genereation. Also fixed a bug */
/* jrb v 1.2 in the SQUOTEIT, SQUOTEWC code that while not */
/* fatal might have caused future problems. */
arg author pathname /* eg. pathname=c:\visprorx\projects\test\main */
if ARG() < 1 then do
say
say
say "You must have at least the pathname as an argument."
say "Generally this results from drag/dropping the form on this object."
pause
exit
end
if Pathname = '' then do
Pathname = Author
Author = 'Post Processor'
end
version='PostProc Version 1.2'
today=date()' 'time()
call RxFuncAdd 'SysFileTree' , 'RexxUtil', 'SysFileTree'
call RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'
SubProcPath = substr(pathname ,1,lastpos("\",pathname))'SubProcs'
ProjectPath = substr(pathname ,1,lastpos("\",pathname)-1)
DDLfile=ProjectPath'\DDL.TXT' /* JRB keeps .dbd * ddl.txt in each project */
ProjectPath = substr(ProjectPath,1,lastpos("\",ProjectPath))
UndoPath = pathname'\UNDO'
ThreadPath = pathname'\Threads' /* ???? not used */
call BackUp
call SingleQuote
call SingleQuoteWildCard
call FindEvents
call GetColNames
/* Move the start using database code to the FORM OPEN event and */
/* delete it from the others. */
call GetDBCodeFromAdd
call SingleQuoteAdd
call SingleQuoteChange
call DelStartUsingFromChange
call SingleQuoteDelete
call DelStartUsingFromDelete
call CommentToClear
call CommentToContainerClick
call CollapseFix
call SingleQuoteWildCardSearch
call DelStartUsingFromSearch
call StartUsingInFormOpen
call InsertColNamesForAdd
call ColNamesForSelect
call BuildWhereInSearch
call ReadLimitInSearch
call NullColumnsBeforeFetch
call CommitAddPB
call CommitChangePB
call CommitDeletePB
call ConfirmDeletePB
call MakeHintFile
EXIT
/************************************************************************/
/* END MAIN */
/************************************************************************/
/************************************************************************/
/* BEGIN SUBROUTINES */
/************************************************************************/
BackUp:
/*========================================================================*/
/* make a backup copy of the original files in case we want to start over */
/*========================================================================*/
file.0=0
call SysFileTree UndoPath'\*.*', 'file', 'FO'
if file.0 = 0 then do /* if this is the first time then make a backup */
"MD "UndoPath
"xcopy "Pathname" "UndoPath
end
else
"xcopy "UndoPath" "Pathname /* reset the actual files from the backup */
return
SingleQuote:
/*=======================================================*/
/* create the library subproc for handling single quotes */
/*=======================================================*/
filename=SubProcPath"\SQUOTEIT"
rc=stream(filename,'c','close')
rc=SysFileDelete(filename)
CALL LINEOUT filename, "/* Single quote doubler subproc */"
CALL LINEOUT filename, '/* 'filename' */'
CALL LINEOUT filename, '/* 'author' 'today' 'version' */'
CALL LINEOUT filename, ''
CALL LINEOUT filename, 'arg value, FieldType /* Use PARSE ARG instead of ARG for mixed case. */'
CALL LINEOUT filename, 'q=pos("'||"'"||'",value)'
CALL LINEOUT filename, 'do while q > 0'
CALL LINEOUT filename, ' value=insert("'||"'"||'",value,q)'
CALL LINEOUT filename, ' q=pos("'||"'"||'",value,q+2)'
CALL LINEOUT filename, 'end'
CALL LINEOUT filename, "if STRIP(value,'B',' ') = '' then return 'NULL'"
CALL LINEOUT filename, 'if FieldType = '||"'"||'C'||"'"||' then value = '||'"'||"'"||'"'||'value'||'"'||"'"||'"'
CALL LINEOUT filename, 'if FieldType = '||"'"||'T'||"'"||' then value = '||'"'||"'"||'"'||'value'||'"'||"'"||'"'
CALL LINEOUT filename, 'return value'
rc=stream(filename,'c','close')
return
SingleQuoteWildCard:
/*=====================================================================*/
/* create the library subproc for handling single quotes w/ wild cards */
/*=====================================================================*/
filename=SubProcPath"\SQUOTEWC"
rc=stream(filename,'c','close')
rc=SysFileDelete(filename)
CALL LINEOUT filename, "/* Single quote w/ wild cards doubler subproc */"
CALL LINEOUT filename, '/* 'filename' */'
CALL LINEOUT filename, '/* 'author' 'today' 'version' */'
CALL LINEOUT filename, ''
CALL LINEOUT filename, 'arg value, FieldType /* Use PARSE ARG instead of ARG for mixed case. */'
CALL LINEOUT filename, 'q=pos("'||"'"||'",value)'
CALL LINEOUT filename, 'do while q > 0'
CALL LINEOUT filename, ' value=insert("'||"'"||'",value,q)'
CALL LINEOUT filename, ' q=pos("'||"'"||'",value,q+2)'
CALL LINEOUT filename, 'end'
CALL LINEOUT filename, "if STRIP(value,'B',' ') = '' then return ''" /* in this case we don't wan't NULL */
CALL LINEOUT filename, 'if FieldType = '||"'"||'C'||"'"||' then value = '||'"'||"'%"||'"'||'value'||'"'||"%'"||'"'
CALL LINEOUT filename, 'if FieldType = '||"'"||'T'||"'"||' then value = '||'"'||"'"||'"'||'value'||'"'||"'"||'"'
CALL LINEOUT filename, 'return value'
rc=stream(filename,'c','close')
return
FindEvents:
/*=======================================*/
/* get the .0 and .1 files in the path */
/*=======================================*/
call SysFileTree pathname'\*.0', 'file', 'FO'
/* add in the FORM.1 file entry */
count = file.0
count = count + 1
file.count = pathname'\Form.1'
file.0 = count
/*=============================================*/
/* figure out which file goes with which event */
/*=============================================*/
do i=1 to count
filename=file.i
IF LENGTH(filename) > 0 THEN DO
j=0
DO WHILE LINES(filename)
value=LINEIN(filename)
j=j+1
/* insert here to use value */
select
when pos('register the rexx functions',value) > 0
then do
FormOpen = filename
iterate i
end
when pos('Arg window self index',value) > 0
then do
ContainerClicked = filename
iterate i
end
when pos("prep_string = 'INSERT INTO",value) > 0
then do
AddPB = filename
iterate i
end
when pos("prep_string = 'UPDATE",value) > 0
then do
ChangePB = filename
iterate i
end
when pos("prep_string = 'DELETE FROM",value) > 0
then do
DeletePB = filename
iterate i
end
when pos("prep_string = 'SELECT *",value) > 0
then do
SearchPB = filename
iterate i
end
when ((pos("CALL VpSetItemValue",value) > 0) & j=6)
then do
ClearPB = filename
iterate i
end
otherwise
nop
end /* select */
END /* do while */
rc=stream(filename,'c','close')
END /* IF LENGTH */
rc=stream(filename,'c','close')
end /* end do i */
say "Form open event "FormOpen
say "Add Pushbutton "AddPB
say "Change Pushbutton "ChangePB
say "Delete Pushbutton "DeletePB
say "ClearPB Pushbutton "ClearPB
say "Search Pushbutton "SearchPB
say "Container Clicked "ContainerClicked
return
GetColNames:
/*===============================================*/
/* Now read the Add file to get the column names */
/*===============================================*/
filename=AddPB
rc=stream(filename,'c','close')
IF LENGTH(filename) > 0 THEN DO
j=0
column.0 = 0
ColumnType.0 = 0
/* get to the start of the field section */
DO WHILE LINES(filename)
value=LINEIN(filename)
if pos("get the field values",value) > 0 then leave
END
/* get the colunm names */
DO WHILE LINES(filename)
value=LINEIN(filename)
if pos('prepare the SQL string',value) > 0 then do
column.0 = j
leave
end
if word(value,2) = '=' then do
j=j+1
column.j = word(value,1)
if pos('"',value) > 0 then ColumnType.j = 'C'
else ColumnType.j = 'N'
end
column.0 = j
END
DO WHILE LINES(filename) /* now get the name of the table */
value=LINEIN(filename)
if pos("INSERT INTO",value) > 0 then do
Table=word(value,5)
Table=STRIP(Table,'B',",")
Table=STRIP(Table,'B',"'")
end /* if */
END /* DO */
rc=stream(filename,'c','close')
/* Now see if there is DDL.TXT file that can be used to */
/* further refine the column types since Dates, Times, and TimeStamps */
/* require some special handling. We'll call these type 'T' */
filename=STREAM(ProjectPath"DDL.TXT",'c','query exists')
/* filename=STREAM(DDLfile ,'c','query exists') /* jrb */*/
if LENGTH(filename) > 0 then do
DO WHILE LINES(filename) /* find the create table statement */
value=LINEIN(filename)
if pos(Table,value) > 0 then leave
END
j=0
colddl.0=0
DO WHILE LINES(filename) /* find the create table statement */
value=LINEIN(filename)
if pos("PRIMARY",value) > 0 then leave
j=j+1
colddl.j=STRIP(WORD(value,1),'B','(')
colddlType.j=WORD(value,2)
LeftParen=pos('(',colddlType.j,)
if LeftParen > 0 then colddlType.j=substr(colddlType.j,1,LeftParen-1)
colddlType.j=STRIP(colddlType.j,'B',',')
END
colddl.0=j
/* Now we have to check each of the actual columns used to find out if */
/* any of them are actually date, time or timestamp because these get */
/* treated later as character data types but LIKE can't be used with */
/* such predicates */
do i=1 to column.0
do j=1 to colddl.0
if column.i=colddl.j then do /* we have a match */
if colddlType.j= 'SMALLINT' then ColumnType.i = 'N'
if colddlType.j= 'VARCHAR' then ColumnType.i = 'C'
if colddlType.j= 'LONG' then ColumnType.i = 'C'
if colddlType.j= 'CHAR' then ColumnType.i = 'C'
if colddlType.j= 'DATE' then ColumnType.i = 'T'
if colddlType.j= 'TIME' then ColumnType.i = 'T'
if colddlType.j= 'TIMESTAMP' then ColumnType.i = 'T'
if colddlType.j= 'INTEGER' then ColumnType.i = 'N'
if colddlType.j= 'DECIMAL' then ColumnType.i = 'N'
if colddlType.j= 'FLOAT' then ColumnType.i = 'N'
end /* if do */
end /* do i */
end /* do j */
rc=stream(filename,'c','close')
END /* if length */
END /* IF LENGTH */
do i = 1 to column.0
say "column "i" is "column.i" of type "ColumnType.i
end
return
GetDBCodeFromAdd:
/********************************************/
/* get the database code from the Add event */
/********************************************/
filename=AddPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Add Pushbutton Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
j=0
/* get START USING DATABASE CODE and delete it from the event */
DO WHILE LINES(filename)
value=LINEIN(filename)
select
when pos("start the dbase and",value) > 0
then do
CALL LINEOUT tempfile,"/* run the SQL */"
end
when pos("call sqldbs 'START USING DATABASE",value) > 0
then do
StartDBCode=value
CALL LINEOUT tempfile,"DO"
value=LINEIN(filename) /* discard the original if */
end
when pos("stop using the database",value) > 0
then do /* discard the next few lines */
value=LINEIN(filename) /* discard the call sqldbs */
value=LINEIN(filename) /* discard the IF check */
value=LINEIN(filename) /* discard the message box */
value=LINEIN(filename) /* discard the end */
value=LINEIN(filename) /* discard the else */
value=LINEIN(filename) /* discard the message box */
CALL LINEOUT tempfile, "END" /* put back the end */
end
OTHERWISE /* otherwise just output the lines */
CALL LINEOUT tempfile,value
END /* SELECT */
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
SingleQuoteAdd:
/*****************************************************/
/* Put the SQUOTEIT call in the Add event */
/*****************************************************/
filename=AddPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the get field values */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("get the field values",value) > 0 then leave
END /* Do */
value=LINEIN(filename) /* read the following blank line */
CALL LINEOUT tempfile, value
do i=1 to column.0
value=LINEIN(filename)
ColType = ColumnType.i
do k=1 to column.0
if word(value,1) = column.k then Coltype = ColumnType.k
end
Vstart=pos("VpGetItemValue",value) /* process the current VpGetItemValue */
value = insert('squoteit(',value,Vstart-1)
Vend=pos(")",value)
value = insert(','||"'"||ColType||"'"||')',value,Vend)
quote=pos('"',value) /* eliminate the "'" from both ends - not needed */
do while quote > 0
value = delstr(value,quote,3)
quote=pos('"',value)
end
CALL LINEOUT tempfile, value
end /* do i */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
SingleQuoteChange:
/********************************************/
/* Put the SQUOTEIT call in the Change event */
/********************************************/
filename=ChangePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the get field values */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("get the field values",value) > 0 then leave
END /* Do */
value=LINEIN(filename) /* read the following blank line */
CALL LINEOUT tempfile, value
do i=1 to column.0
value=LINEIN(filename)
ColType = ColumnType.i
do k=1 to column.0
if word(value,1) = column.k then Coltype = ColumnType.k
end
Vstart=pos("VpGetItemValue",value) /* process the current VpGetItemValue */
value = insert('squoteit(',value,Vstart-1)
Vend=pos(")",value)
value = insert(','||"'"||ColType||"'"||')',value,Vend)
quote=pos('"',value) /* eliminate the "'" from both ends - not needed */
do while quote > 0
value = delstr(value,quote,3)
quote=pos('"',value)
end
CALL LINEOUT tempfile, value
end /* do i */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
DelStartUsingFromChange:
/**********************************************************/
/* delete Start Using database code from the Change event */
/**********************************************************/
filename=ChangePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Change Pushbutton Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
j=0
/* get START USING DATABASE CODE and delete it from the event */
DO WHILE LINES(filename)
value=LINEIN(filename)
select
when pos("start the dbase and",value) > 0
then do
CALL LINEOUT tempfile,"/* run the SQL */"
end
when pos("call sqldbs 'START USING DATABASE",value) > 0
then do
StartDBCode=value
CALL LINEOUT tempfile,"DO"
value=LINEIN(filename) /* discard the original if */
end
when pos("stop using the database",value) > 0
then do /* discard the next few lines */
value=LINEIN(filename) /* discard the call sqldbs */
value=LINEIN(filename) /* discard the IF check */
value=LINEIN(filename) /* discard the message box */
value=LINEIN(filename) /* discard the end */
value=LINEIN(filename) /* discard the else */
value=LINEIN(filename) /* discard the message box */
CALL LINEOUT tempfile, "END" /* put back the end */
end
OTHERWISE /* otherwise just output the lines */
CALL LINEOUT tempfile,value
END /* SELECT */
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
SingleQuoteDelete:
/********************************************/
/* Put the SQUOTEIT call in the Delete event */
/********************************************/
filename=DeletePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the get field values */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("get the field values",value) > 0 then leave
END /* Do */
value=LINEIN(filename) /* read the following blank line */
CALL LINEOUT tempfile, value
do i=1 to column.0
value=LINEIN(filename)
ColType = ColumnType.i
do k=1 to column.0
if word(value,1) = column.k then Coltype = ColumnType.k
end
Vstart=pos("VpGetItemValue",value) /* process the current VpGetItemValue */
if Vstart > 0 then do /* only change VpGetItemValue lines */
value = insert('squoteit(',value,Vstart-1)
Vend=pos(")",value)
value = insert(','||"'"||ColType||"'"||')',value,Vend)
quote=pos('"',value) /* eliminate the "'" from both ends - not needed */
do while quote > 0
value = delstr(value,quote,3)
quote=pos('"',value)
end
end
CALL LINEOUT tempfile, value
end /* do i */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
DelStartUsingFromDelete:
/**********************************************************/
/* delete Start Using database code from the Delete event */
/**********************************************************/
filename=DeletePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Delete Pushbutton Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
j=0
/* get START USING DATABASE CODE and delete it from the event */
DO WHILE LINES(filename)
value=LINEIN(filename)
select
when pos("start the dbase and",value) > 0
then do
CALL LINEOUT tempfile,"/* run the SQL */"
end
when pos("call sqldbs 'START USING DATABASE",value) > 0
then do
StartDBCode=value
CALL LINEOUT tempfile,"DO"
value=LINEIN(filename) /* discard the original if */
end
when pos("stop using the database",value) > 0
then do /* discard the next few lines */
value=LINEIN(filename) /* discard the call sqldbs */
value=LINEIN(filename) /* discard the IF check */
value=LINEIN(filename) /* discard the message box */
value=LINEIN(filename) /* discard the end */
value=LINEIN(filename) /* discard the else */
value=LINEIN(filename) /* discard the message box */
CALL LINEOUT tempfile, "END" /* put back the end */
end
OTHERWISE /* otherwise just output the lines */
CALL LINEOUT tempfile,value
END /* SELECT */
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
CommentToClear:
/**********************************/
/* Add comment to the Clear event */
/**********************************/
filename=ClearPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Clear Pushbutton Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile,value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
CommentToContainerClick:
/*************************************************/
/* Add comment to the Container Clicked on event */
/*************************************************/
filename=ContainerClicked
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Container Clicked on Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile,value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
CollapseFix:
/******************************************************/
/* Add collapse fix to the Container Clicked on event */
/******************************************************/
filename=ContainerClicked
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* read past the Arg line */
value=LINEIN(filename)
CALL LINEOUT tempfile,value
if pos("Arg window",value) then leave
END /* Do */
CALL LINEOUT tempfile, " "
CALL LINEOUT tempfile, "/* The following line fixes a VisPro REXX bug that causes */ "
CALL LINEOUT tempfile, "/* the application to close when doing a SEARCH without */ "
CALL LINEOUT tempfile, "/* first clearing the fields. It causes some extra iterations */ "
CALL LINEOUT tempfile, "/* of this event but at least your app doesn't collapse. */ "
CALL LINEOUT tempfile, "/* Remove this line when VisPro gets fixed. */ "
CALL LINEOUT tempfile, " "
CALL LINEOUT tempfile, "/* For an interesting variation on this theme, copy all of the*/ "
CALL LINEOUT tempfile, "/* code from this event into the double-click event for this */ "
CALL LINEOUT tempfile, "/* object. Then delete this (single click) event. It allows */ "
CALL LINEOUT tempfile, "/* the SEARCH criteria to remain in the fields until you click*/ "
CALL LINEOUT tempfile, "/* twice on a container record. This allows easy refinement of*/ "
CALL LINEOUT tempfile, "/* searches as needed. */ "
CALL LINEOUT tempfile, " "
CALL LINEOUT tempfile, "index=VpGetIndex(window,'SEARCHCNR','SELECTED',0) /* collapse fix */ "
DO WHILE LINES(filename) /* copy the rest of the file */
value=LINEIN(filename)
CALL LINEOUT tempfile,value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
SingleQuoteWildCardSearch:
/*****************************************************/
/* Put the SQUOTEWC call in the Search event */
/*****************************************************/
filename=SearchPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the get field values */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("get the field values",value) > 0 then leave
END /* Do */
value=LINEIN(filename) /* read the following blank line */
CALL LINEOUT tempfile, value
do i=1 to column.0
value=LINEIN(filename)
ColType = ColumnType.i
do k=1 to column.0
if word(value,1) = column.k then Coltype = ColumnType.k
end
Vstart=pos("VpGetItemValue",value) /* process the current VpGetItemValue */
value = insert('squotewc(',value,Vstart-1)
Vend=pos(")",value)
value = insert(','||"'"||ColType||"'"||')',value,Vend)
quote=pos('"',value) /* eliminate the "'" from both ends - not needed */
do while quote > 0
value = delstr(value,quote,3)
quote=pos('"',value)
end
CALL LINEOUT tempfile, value
end /* do i */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
DelStartUsingFromSearch:
/**********************************************************/
/* delete Start Using database code from the Search event */
/**********************************************************/
filename=SearchPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Search Pushbutton Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
j=0
/* get START USING DATABASE CODE and delete it from the event */
DO WHILE LINES(filename)
value=LINEIN(filename)
select
when pos("start the dbase and",value) > 0
then do
CALL LINEOUT tempfile,"/* run the SQL */"
end
when pos("call sqldbs 'START USING DATABASE",value) > 0
then do
CALL LINEOUT tempfile,"DO"
value=LINEIN(filename) /* discard the original if */
end
when pos("stop using the database",value) > 0
then do /* discard the next few lines */
value=LINEIN(filename) /* discard the call sqldbs */
value=LINEIN(filename) /* discard the IF check */
value=LINEIN(filename) /* discard the message box */
value=LINEIN(filename) /* discard the end */
value=LINEIN(filename) /* discard the end */
value=LINEIN(filename) /* discard the else */
value=LINEIN(filename) /* discard the message box */
CALL LINEOUT tempfile, " end" /* put back the end */
CALL LINEOUT tempfile, "END" /* put back the end */
end
OTHERWISE /* otherwise just output the lines */
CALL LINEOUT tempfile,value
END /* SELECT */
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
StartUsingInFormOpen:
/*********************************************************/
/* put the Start Using database code into the FORM OPEN */
/*********************************************************/
filename=FormOpen
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
CALL LINEOUT tempfile, "/* Form Open Event */"
CALL LINEOUT tempfile, '/* 'filename' */'
CALL LINEOUT tempfile, '/* 'author' 'today' 'version' */'
CALL LINEOUT tempfile, ''
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, " "
CALL LINEOUT tempfile, "/* Start using the database */"
CALL LINEOUT tempfile, " "
CALL LINEOUT tempfile, StartDBCode
CALL LINEOUT tempfile, "IF SQLCA.SQLCODE <> 0 then"
CALL LINEOUT tempfile, "CALL VpMessageBox window, 'Error Starting Database : 'SQLCA.SQLCODE, SQLCA.SQLMSG"
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
InsertColNamesForAdd:
/*************************************************************/
/* put column names in the INSERT statement in the ADD event */
/*************************************************************/
filename=AddPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
/* get down to the prep string statement */
DO WHILE LINES(filename)
value=LINEIN(filename)
if pos("prep_string",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, value /* prep_string */
do i = 1 to column.0
select
when i=1 then do
d1="'"
d2="("
d3=",'"
d4=","
end /* Do */
when i=column.0 then do
d1="'"
d2=""
d3=")"
d4="',"
end /* Do */
otherwise
d1="'"
d2=""
d3=",'"
d4=","
end /* select */
CALL LINEOUT tempfile, " "||d1||d2||column.i||d3||d4
end /* do */
DO WHILE LINES(filename) /* append the rest of the file */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
ColNamesForSelect:
/****************************************************************/
/* put column names in the SELECT statement in the SEARCH event */
/* and make sure all FETCH columns have indicator variables. */
/****************************************************************/
filename=SearchPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
/* get down to the prep string statement */
DO WHILE LINES(filename)
value=LINEIN(filename)
if pos("prep_string",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, "prep_string = 'SELECT ',"
do i = 1 to column.0
select
when i=1 then do
d1="'"
d2=""
d3=",'"
d4=","
end /* Do */
when i=column.0 then do
d1="'"
d2=""
d3=""
d4="',"
end /* Do */
otherwise
d1="'"
d2=""
d3=",'"
d4=","
end /* select */
CALL LINEOUT tempfile, " "||d1||d2||column.i||d3||d4
end /* do */
/* get down to the FETCH prep string statement */
DO WHILE LINES(filename)
value=LINEIN(filename)
if pos("prep_string = 'FETCH",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, value /* ouput the FETCH */
do i = 1 to column.0
select
when i=1 then do
d1="'"
d2=""
d3=",'"
d4=","
end /* Do */
when i=column.0 then do
d1="'"
d2=""
d3=""
d4="'"
end /* Do */
otherwise
d1="'"
d2=""
d3=",'"
d4=","
end /* select */
value=LINEIN(filename) /* skip over the corresponding column */
CALL LINEOUT tempfile, " "||d1||d2||":"||column.i||":N_"||column.i||d3||d4
end /* do */
DO WHILE LINES(filename) /* append the rest of the file */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
BuildWhereInSearch:
/*******************************************************/
/* add dynamic where clause in the SELECT statement */
/* in the SEARCH event */
/*******************************************************/
filename=SearchPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
/* get down to the prepare SQL string comment */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("prepare the SQL string",value) > 0 then leave
END /* Do */
CALL LINEOUT tempfile, "j=0"
do i = 1 to column.0
select
when ColumnType.i = 'C' then
comparator = 'LIKE'
otherwise
comparator = '='
end /* select */
CALL LINEOUT tempfile, "if "||column.i||" <> '' then do"
CALL LINEOUT tempfile, " j=j+1"
CALL LINEOUT tempfile, " WhereClause.j ="||'"'||column.i comparator ||'" 'column.i
CALL LINEOUT tempfile, "end"
end /* do */
/* now generate the code to generate the where clause */
CALL LINEOUT tempfile, "WhereString = '' "
CALL LINEOUT tempfile, "if j > 0 then"
CALL LINEOUT tempfile, " do i=1 to j"
CALL LINEOUT tempfile, " select"
CALL LINEOUT tempfile, " when i=1"
CALL LINEOUT tempfile, " then LogicOper='WHERE '"
CALL LINEOUT tempfile, " Otherwise"
CALL LINEOUT tempfile, " LogicOper='AND '"
CALL LINEOUT tempfile, " end /* select */"
CALL LINEOUT tempfile, " WhereString = WhereString LogicOper WhereClause.i"
CALL LINEOUT tempfile, "end /* IF j */"
DO WHILE LINES(filename) /* append up to the 'FROM */
value=LINEIN(filename)
if pos("'FROM",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, value "WhereString" /* append the where string */
DO WHILE LINES(filename) /* append the rest of the file */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
ReadLimitInSearch:
/*******************************************************/
/* Add read limit code to the SEARCH event as well as */
/* a No Data Found message. */
/*******************************************************/
filename=SearchPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
/* get down to the ARG window line */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("Arg window",value) > 0 then leave
END /* Do */
CALL LINEOUT tempfile, "ReadLimit = 1000"
/* get down to the Retrieve data FETCH loop */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("Retrieve data from the cursor",value) > 0 then leave
END /* Do */
/* get down to the sqlexec */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("call sqlexec",value) > 0 then leave
END /* Do */
CALL LINEOUT tempfile," if numitems >= ReadLimit then do"
CALL LINEOUT tempfile," leave"
CALL LINEOUT tempfile," end /* if do */"
/* get down to close cursor statement */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("CLOSE c1",value) > 0 then leave
END /* Do */
CALL LINEOUT tempfile," if numitems = 0 then do"
CALL LINEOUT tempfile," CALL VpMessageBox window, 'Search Complete','No Rows Matched. '"
CALL LINEOUT tempfile," end /* if do */"
CALL LINEOUT tempfile," if numitems >= ReadLimit then do"
CALL LINEOUT tempfile," CALL VpMessageBox window, 'Search Complete','Read Limit exceeded. First 'ReadLimit' rows retrieved.'"
CALL LINEOUT tempfile," end /* if do */"
DO WHILE LINES(filename) /* append the rest of the file */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
NullColumnsBeforeFetch:
/***********************************************************/
/* Add code to set the FETCH column variables to '' just */
/* prior to the fetch so that the container isn't aliased. */
/***********************************************************/
filename=SearchPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
/* get down to the retrieve data from the cursor line */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("Retrieve data from the cursor",value) > 0 then leave
END /* Do */
/* get down to the following DO WHILE loop */
DO WHILE LINES(filename)
value=LINEIN(filename)
CALL LINEOUT tempfile, value
if pos("do while",value) > 0 then leave
END /* Do */
do i=1 to column.0 /* add code to set variables = '' */
CALL LINEOUT tempfile, " "||column.i||" = "||"''"
end
DO WHILE LINES(filename) /* append the rest of the file */
value=LINEIN(filename)
CALL LINEOUT tempfile, value
END /* Do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
CommitAddPB:
/*****************************************************/
/* Put a COMMIT at the end of the ADD event */
/*****************************************************/
filename=AddPB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the turn off the hour glass */
value=LINEIN(filename)
if pos("turn off the hour glass",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, "CALL SQLEXEC 'COMMIT'"
CALL LINEOUT tempfile, 'if sqlca.sqlcode <> 0 then do '
CALL LINEOUT tempfile, " CALL VpMessageBox window, 'Error Running SQL : 'SQLCA.SQLCODE, SQLCA.SQLMSG "
CALL LINEOUT tempfile, 'end /* if do */ '
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, value /* don't forget the hour glass comment */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
CommitChangePB:
/*****************************************************/
/* Put a COMMIT at the end of the CHANGE event */
/*****************************************************/
filename=ChangePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the turn off the hour glass */
value=LINEIN(filename)
if pos("turn off the hour glass",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, "CALL SQLEXEC 'COMMIT'"
CALL LINEOUT tempfile, 'if sqlca.sqlcode <> 0 then do '
CALL LINEOUT tempfile, " CALL VpMessageBox window, 'Error Running SQL : 'SQLCA.SQLCODE, SQLCA.SQLMSG "
CALL LINEOUT tempfile, 'end /* if do */ '
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, value /* don't forget the hour glass comment */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
CommitDeletePB:
/*****************************************************/
/* Put a COMMIT at the end of the DELETE event */
/*****************************************************/
filename=DeletePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the turn off the hour glass */
value=LINEIN(filename)
if pos("turn off the hour glass",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, "CALL SQLEXEC 'COMMIT'"
CALL LINEOUT tempfile, 'if sqlca.sqlcode <> 0 then do '
CALL LINEOUT tempfile, " CALL VpMessageBox window, 'Error Running SQL : 'SQLCA.SQLCODE, SQLCA.SQLMSG "
CALL LINEOUT tempfile, 'end /* if do */ '
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, value /* don't forget the hour glass comment */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
ConfirmDeletePB:
/*********************************************************/
/* insert DELETE confirmation code into the DELETE event */
/*********************************************************/
filename=DeletePB
tempfile='TEMPFILE'
rc=stream(filename,'c','close')
rc=SysFileDelete(tempfile)
IF LENGTH(filename) > 0 THEN DO
DO WHILE LINES(filename) /* copy up to the turn on the hour glass */
value=LINEIN(filename)
if pos("turn on the hour glass",value) > 0 then leave
CALL LINEOUT tempfile, value
END /* Do */
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, "response=VpMessageBox(window,'DELETE Confirmation','Are you sure you wish to DELETE the row?','YESNO')"
CALL LINEOUT tempfile, "if response = 'YES' then do /* Do it */"
CALL LINEOUT tempfile, ' '
CALL LINEOUT tempfile, value /* don't forget the hour glass comment */
do while lines(filename) /* copy the rest of the file */
value=LINEIN(filename)
call LINEOUT tempfile, value
end /* do */
CALL LINEOUT tempfile, "END /* if YES do */"
END /* IF LENGTH */
rc=stream(filename,'c','close')
rc=stream(tempfile,'c','close')
"copy "tempfile" "filename
return
MakeHintFile:
/*=================================================*/
/* Make FORM.HIN file TIP entries for push buttons */
/*=================================================*/
filename=pathname'\FORM.HIN'
rc=stream(filename,'c','close')
rc=SysFileDelete(filename)
nul='00'X
HinAdd ='Add a row to the database.'
HinChange='Change a row in the database.'
HinDelete='Delete a row from the database.'
HinClear ='Clear screen fields.'
HinSearch='Search for records matching fields or partial strings above;',
' or load a limited set to container.'
Hint= HinAdd||nul||substr( AddPB,lastpos('\', AddPB)+1,4)||nul
Hint=Hint||HinChange||nul||substr(ChangePB,lastpos('\',ChangePB)+1,4)||nul
Hint=Hint||HinDelete||nul||substr(DeletePB,lastpos('\',DeletePB)+1,4)||nul
Hint=Hint|| HinClear||nul||substr( ClearPB,lastpos('\', ClearPB)+1,4)||nul
Hint=Hint||HinSearch||nul||substr(SearchPB,lastpos('\',SearchPB)+1,4)||nul
CALL CHAROUT filename, Hint
rc=stream(filename,'c','close')
return
/************************************************************************/
/* END OF SUBROUTINES */
/************************************************************************/