COBOL File Backup Option

This forum allows you to share scripts with other Zeus users. Please do not post bug reports, feature requests or questions to this forum, but rather use it exclusively for posting scripts or for the discussion of scripts that have been posted.
Post Reply
jussij
Site Admin
Posts: 2447
Joined: Fri Aug 13, 2004 5:10 pm

COBOL File Backup Option

Post by jussij » Mon Jul 29, 2019 12:04 am

Courtesy of Dennis Komeshak.

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

Post Reply
kuchnie warszawa opinie

Who is online

Users browsing this forum: No registered users and 1 guest