@OPTIONS BINARY(BYTE)
IDENTIFICATION DIVISION.
PROGRAM-ID PRINT-RAW.
AUTHOR. Doug Brown.
INSTALLATION. FUJITSU COBOL (GENERIC).
SECURITY. COPYRIGHT (C) 1999 FUJITSU SOFTWARE CORPORATION.
*
* Program is passed a text file and printer name and prints the
* file to the printer. It is assumed that the text file may contain
* printer control characters and should be passed to the printer
* "as is" i.e. it is read as a sequential file and passed to the
* printer in blocks.
* The program is designed to be invoked from the command line, or
* from the Windows CreateProcess function, so that it executes
* asynchronously.
* Command line format is:
*
* FSC-SPOOL-FILE.EXE "Text file name" "Printer name"
*
* The quotes are only required if the text file or printer name
* includes spaces.
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. WINDOWS.
OBJECT-COMPUTER. WINDOWS.
SPECIAL-NAMES.
ARGUMENT-NUMBER IS ARGUMENT-NUMBER
ARGUMENT-VALUE IS ARGUMENT-VALUE
SYMBOLIC CONSTANT
*> Program Copyright Information
PROGRAM-NAME IS "CBLEXEC"
PROGRAM-SOURCE-DATE IS "April 5 1999"
PROGRAM-SERIAL-NUMBER IS "DAB/FSC/000001"
PROGRAM-DESCRIPTION IS
"Fujitsu COBOL Spool Print File"
PROGRAM-COPYRIGHT IS
"Copyright (C) 1999 Fujitsu Software Corporation"
PROGRAM-AUTHOR IS "Doug Brown"
PROGRAM-BUILD-TYPE IS "PRODUCTION"
PROGRAM-CHARACTER-SET IS "ASCII"
PROGRAM-CHARACTER-TYPE IS "SBCS".
*-----------------------------------------------------------------
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT Print-File ASSIGN TO Print-File-Name
ORGANIZATION SEQUENTIAL
FILE STATUS IS Print-File-Status
.
DATA DIVISION.
FILE SECTION.
FD Print-File.
01 Print-Record PIC X(16384).
WORKING-STORAGE SECTION.
* Note: Ensure that Print-Buffer is always the same size
* as Print-Record
01 Print-Buffer PIC X(16384).
01 Print-File-Name PIC X(255) VALUE SPACES.
01 Print-File-Status PIC X(2).
01 Record-Bytes PIC 9(9) COMP-5.
01 Bytes-Written PIC 9(9) COMP-5.
01 Printer-Name PIC X(255) VALUE SPACES.
01 Printer-Handle PIC 9(9) COMP-5.
01 Return-Value PIC S9(9) COMP-5.
01 Doc-Info.
03 pDocName USAGE POINTER.
03 pOutputFile USAGE POINTER VALUE NULL.
03 pDatatype USAGE POINTER.
01 Datatype.
03 PIC X(3) VALUE "RAW".
03 PIC X VALUE X"00".
01 Number-of-Arguments PIC 9(2) COMP-5.
01 End-of-File-Flag PIC 9 VALUE ZERO.
88 END-OF-FILE VALUE 1.
01 Offset PIC 9(5) COMP-5.
01 PRINTER-d.
05 pDatatyp pic x(4) value low-value.
05 pDevMod pic x(4) value low-value.
05 DesiredAccess pic s9(9) comp-5 value 8.
*------------------------------------------------------------------
PROCEDURE DIVISION.
ACCEPT Number-of-Arguments FROM ARGUMENT-NUMBER
* DISPLAY Number-of-Arguments
IF Number-of-Arguments NOT = 2
* <<Check what action is appropriate to notify user of an error>>
DISPLAY "Argumentos incorrectos"
EXIT PROGRAM
END-IF
ACCEPT Print-File-Name FROM ARGUMENT-VALUE
ACCEPT Printer-Name FROM ARGUMENT-VALUE
* Find end of printer name and place a null byte to terminate
* the string.
MOVE FUNCTION LENG (Printer-Name) TO Offset
PERFORM UNTIL Printer-Name (Offset:1) NOT = SPACE
SUBTRACT 1 FROM Offset
END-PERFORM
ADD 1 TO Offset
MOVE X"00" TO Printer-Name (Offset:1)
* Set up the Doc-Info structure for use with the StartDocPrinter
* function.
MOVE FUNCTION ADDR (Print-File-Name) TO pDocName
MOVE FUNCTION ADDR (Datatype) TO pDatatype
* Open the printer.
* <<Insert explanation as to why some functions are called with the
* "A" appended and others are not.>>
CALL "OpenPrinterA" WITH STDCALL
USING BY REFERENCE Printer-Name
BY REFERENCE Printer-Handle
BY VALUE 0
RETURNING Return-Value.
IF Return-Value = 0
DISPLAY "Error en la apertura de la impresora"
EXIT PROGRAM
END-IF
CALL "StartDocPrinterA" WITH STDCALL
USING BY VALUE Printer-Handle
BY VALUE 1
BY REFERENCE Doc-Info
RETURNING Return-Value
IF Return-Value = 0
DISPLAY "Problema de iniciar el documento a imprimir"
EXIT PROGRAM
END-IF
CALL "StartPagePrinter" WITH STDCALL
USING BY VALUE Printer-Handle
RETURNING Return-Value
IF Return-Value = 0
DISPLAY "Problema iniciar página de impresión"
EXIT PROGRAM
END-IF
OPEN INPUT Print-File
IF Print-File-Status NOT = "00"
DISPLAY "No se puede abrir el archivo de impresión"
EXIT PROGRAM
END-IF
* Ensure Print-Record area is initialized to nulls
MOVE LOW-VALUES TO Print-Record
MOVE FUNCTION LENG (Print-Buffer) TO Record-Bytes
* Read ahead so that last record can be detected
READ Print-File
AT END
DISPLAY "No hay datos para imprimir en el fichero"
EXIT PROGRAM
END-READ
IF Print-File-Status NOT = "00"
DISPLAY "Error lectura archivo de impresión (1): " Print-File-Status
EXIT PROGRAM
END-IF
* Move record to buffer so that Print-Record is available for
* the next read
MOVE Print-Record TO Print-Buffer
PERFORM UNTIL END-OF-FILE
* Set Print-Record to LOW-VALUES before reading
MOVE LOW-VALUES TO Print-Record
READ Print-File
AT END
* Last read had the last record, so find last non-null
* byte in record (only want to pass the data in the file
* not the padding nulls at the end of the buffer)
SET END-OF-FILE TO TRUE
MOVE FUNCTION LENG (Print-Buffer) TO Offset
PERFORM UNTIL Print-Buffer (Offset:1) NOT = X"00"
SUBTRACT 1 FROM Offset
END-PERFORM
MOVE Offset TO Record-Bytes
END-READ
IF Print-File-Status = "00"
OR
Print-File-Status = "10" *> At end status
CALL "WritePrinter" WITH STDCALL
USING BY VALUE Printer-Handle
BY REFERENCE Print-Buffer
BY VALUE Record-Bytes
BY REFERENCE Bytes-Written
RETURNING Return-Value
IF Return-Value = 0
DISPLAY "Error imprimir en la impresora"
SET END-OF-FILE TO TRUE
END-IF
ELSE
DISPLAY "Error lectura archivo de impresión (2): " Print-File-Status
SET END-OF-FILE TO TRUE
END-IF
IF NOT END-OF-FILE
* Set up next record to print
MOVE Print-Record TO Print-Buffer
END-IF
END-PERFORM
CLOSE Print-File
CALL "EndPagePrinter" WITH STDCALL
USING BY VALUE Printer-Handle
RETURNING Return-Value
CALL "EndDocPrinter" WITH STDCALL
USING BY VALUE Printer-Handle
RETURNING Return-Value
CALL "ClosePrinter" WITH STDCALL
USING BY VALUE Printer-Handle
RETURNING Return-Value
STOP RUN.