The following COBOL source code is compiled and linked to produce a cs-source-backup.exe executable.
Code: Select all
IDENTIFICATION DIVISION.
PROGRAM-ID. CS-SOURCE-BACKUP.
*****************************************************************
* DESCRIPTION:
* Copy a file with DATE and TIME appended to filename to \!version sub-directory
* E.G. PROGNAME.COB will be copied to PROGNAME-2019-07-28-124533.COB
* Triggered by cs-source.lua from Zeus Editor when file is saved.
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-PC.
OBJECT-COMPUTER. IBM-PC.
SPECIAL-NAMES.
CONSOLE IS CRT
ARGUMENT-NUMBER IS COMMAND-LINE-NUMBER
ARGUMENT-VALUE IS COMMAND-LINE-VALUE
ENVIRONMENT-NAME IS ENV-NAME
ENVIRONMENT-VALUE IS ENV-VAL.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 NUMBER-OF-ARGUMENTS PIC 99 VALUE 0.
01 ARG-NO PIC 99 VALUE 0.
01 WS-COMMAND-LINE PIC X(50) VALUE SPACES.
01 WS-COMMAND-LINE-ARG PIC X(50) VALUE SPACES.
01 DUMMY PIC X.
01 FILLER.
05 MAIN-FILENAME PIC X(50).
05 MAIN-FILEEXT PIC X(10).
05 DIR-TO-CREATE PIC X(50).
05 FN-1 PIC X(96) VALUE SPACES.
05 FN-2 PIC X(96) VALUE SPACES.
05 FILE-DETAILS.
07 FILE-SIZE PIC 9(18) BINARY.
07 FILE-DATE.
10 FILE-DAY PIC 9(4) BINARY.
10 FILE-MONTH PIC 9(4) BINARY.
10 FILE-YEAR PIC 9(4) BINARY.
07 FILE-TIME.
10 FILE-HOUR PIC 9(4) BINARY.
10 FILE-MINS PIC 9(4) BINARY.
10 FILE-SECS PIC 9(4) BINARY.
10 FILE-HUNS PIC 9(4) BINARY.
01 DOS-DATE.
05 SYS-DATE PIC 9(8).
05 FILLER REDEFINES SYS-DATE.
07 YEARS PIC 9999.
07 MONTHS PIC 99.
07 DAYS PIC 99.
05 SYS-TIME PIC 9(8).
05 FILLER REDEFINES SYS-TIME.
07 HOURS PIC 99.
07 MINS PIC 99.
07 SECS PIC 99.
07 HUNDS PIC 99.
05 GMT-OFFSET.
07 GMT-DIRECTION PIC X.
07 GMT-HOURS PIC 99.
07 GMT-MINS PIC 99.
PROCEDURE DIVISION.
BGN.
MOVE FUNCTION CURRENT-DATE TO DOS-DATE.
ACCEPT NUMBER-OF-ARGUMENTS FROM COMMAND-LINE-NUMBER.
IF NUMBER-OF-ARGUMENTS NOT = 1
STOP RUN.
INITIALIZE WS-COMMAND-LINE.
ACCEPT WS-COMMAND-LINE FROM COMMAND-LINE-VALUE
* FORCE COMMAND-LINE TO UPPER-CASE.
MOVE FUNCTION UPPER-CASE (WS-COMMAND-LINE) TO WS-COMMAND-LINE.
* ATTEMPT TO CREATE THE DIRECTORY IN CASE IT DOESN'T ALREADY EXIST.
MOVE '!version' to DIR-TO-CREATE.
CALL "CBL_CREATE_DIR" USING DIR-TO-CREATE.
MOVE WS-COMMAND-LINE TO FN-1.
UNSTRING WS-COMMAND-LINE DELIMITED BY '.'
INTO MAIN-FILENAME MAIN-FILEEXT.
STRING '!version\' DELIMITED BY SIZE
MAIN-FILENAME DELIMITED BY ' '
'-' DELIMITED BY SIZE
YEARS DELIMITED BY SIZE
'-' DELIMITED BY SIZE
MONTHS DELIMITED BY SIZE
'-' DELIMITED BY SIZE
DAYS DELIMITED BY SIZE
'-' DELIMITED BY SIZE
HOURS DELIMITED BY SIZE
MINS DELIMITED BY SIZE
SECS DELIMITED BY SIZE
'.' DELIMITED BY SIZE
MAIN-FILEEXT DELIMITED BY ' '
INTO FN-2.
CALL "CBL_COPY_FILE" USING FN-1 FN-2.
STOP RUN.This cs-source.lua macro is then installed as a trigger and is used to file that COBOL executable:
Code: Select all
--
-- Name: Make Backup of document to !version
--
-- Author: Dennis Komeshak
--
-- Language: LUA Macro
--
-- Description: When the file is saved, this LUA macro wraps around cs-source-backup.exe
-- located in the WINDOWS directory. It passes the filename and cs-source-backup.exe
-- will write a copy to the !version directory. The filename is appended with the date
-- and time that the file was saved.
--
-- Example: SOURCE.COB will be saved as SOURCE-2019-07-27-133145.COB in the !version directory.
--
-- Installation: To configure this macro, for all document types, use the Options, Default Document Type
-- menu and attach the macro to the "File Save Prefix" trigger option. (e.g.)
--
-- Options|Default Document Type...|Triggers|File Save Prefix = $zud\zScript\cs-source.lua
--
-- To configure this macro, for a particular document type, use the Options, Trigger Options
-- menu and attach the macro to the "File Save Prefix" trigger option. (e.g.)
--
-- Options|Trigger Options...|File Save Prefix = $zud\zScript\cs-source.lua
--
function key_macro()
-- macro only works for documents
local document = is_document()
if document == 0 then
message("This macro only works for document files!")
beep()
return
end
-- macro only works for real documents
local named = is_named()
if named == 0 then
message("You must save this file before it can be converted.")
beep()
-- ask the user to save the file
if FileSaveAs() == 0 then
message("Operation cancelled by user.")
return
end
end
-- get the file names
local file_input = macro_tag("$F")
-- build the command line
local cmd_line = string.format("cs-source-backup.exe %s", file_input)
-- set the initial directory
local dir = macro_tag("$FDD")
-- setup command control falgs (see the Zeus Macro help for details)
local flags = 1+16+32
-- run command
system(cmd_line, dir, flags)
end
key_macro() -- run the macro