001000 @OPTIONS NOALPHA
001010 @OPTIONS MAIN
001020
001030 *>
001040 *>
001050 *>  Source Module: MAILER.CBL
001060 *>
001070 *>  Last Modified: September 1, 1999
001080 *>
001090 *>  Author:  MDM
001100 *>
001110 *>  Must be linked with SEE32.LIB
001120 *>
001130 *> IMPORTANT:  Edit SMTP_SERVER, EMAIL_TO, EMAIL_FROM, EMAIL_SUBJ,
001140 *>    and EMAIL_MSG with appropriate strings before compiling.
001150 *>    See SEE4CB_U.TXT and SEE4CB_R.TXT manuals.
001160 *>
001170
001180 IDENTIFICATION DIVISION.
001190 PROGRAM-ID.    MAILER.
001200 AUTHOR.        Mike Marshall.
001210 INSTALLATION.  Fujitsu COBOL.
001220 
001230 ENVIRONMENT DIVISION.
001240 CONFIGURATION SECTION.
001250 SOURCE-COMPUTER. Fujitsu.
001260 OBJECT-COMPUTER. Fujitsu.
001270 SPECIAL-NAMES.
001280     
001290 COPY "SEE32.CBI".
001300
001310 DATA DIVISION.
001320 
001330 WORKING-STORAGE SECTION.
001340
001350 COPY "KEYCODE.CBI".
001360  01  IS_ZERO      PIC 9(9) COMP-5 VALUE 0.
001370  01  BUFFER       PIC X(80).
001380  01  BUF_LEN      PIC 9(9) COMP-5 VALUE 80.
001390  01  SEE_CODE     PIC S9(9) COMP-5 VALUE 0.
001400  01  NBR_CHANS    PIC S9(9) COMP-5 VALUE 1.
001410  01  CHANNEL      PIC S9(9) COMP-5 VALUE 0.
001420  01  SMTP_SERVER.
001430      05  FILLER PIC X(8) VALUE "10.0.0.1".
001440      05  FILLER PIC X VALUE X'00'.
001450  01  EMAIL_TO.
001460      05  FILLER PIC X(15) VALUE "<mike@10.0.0.1>".
001470      05  FILLER PIC X VALUE X'00'.
001480  01  EMAIL_FROM.
001490      05  FILLER PIC X(15) VALUE "<mike@10.0.0.1>".
001500      05  FILLER PIC X VALUE X'00'.
001510  01  EMAIL_SUBJ.
001520      05  FILLER PIC X(12) VALUE "Fujitsu Test".
001530      05  FILLER PIC X VALUE X'00'.    
001540  01  EMAIL_MSG.
001550      05  FILLER PIC X(44) VALUE "This message was emailed from Fujitsu COBOL!".
001560      05  FILLER PIC X VALUE X'00'.      
001570  01  RESULT.
001580      05  FILLER PIC X(40).
001590      05  FILLER PIC X VALUE X'00'.
001600
001610 PROCEDURE DIVISION.
001620 
001630      DISPLAY "MAILER.CBL Program"
001640      DISPLAY " "
001650 
001660      DISPLAY "Server is " SMTP_SERVER
001670      DISPLAY "Email To "  EMAIL_TO
001680      DISPLAY "Email From "  EMAIL_FROM
001690      DISPLAY "Email Subject "  EMAIL_SUBJ
001700      DISPLAY " "
001710
001720      *> attach SEE
001730      CALL "seeAttach" WITH STDCALL USING
001740           BY VALUE     NBR_CHANS     *> number of channels
001750           BY VALUE     SEE_KEY_CODE  *> See KEYCODE.CBI
001760      END-CALL.
001770      
001780      *> connect to SMTP server
001790      DISPLAY "Calling seeSmptConnect()..."
001800      CALL "seeSmtpConnect" WITH STDCALL USING
001810           BY VALUE     CHANNEL       *> channel
001820           BY REFERENCE SMTP_SERVER   *> SMTP server name
001830           BY REFERENCE EMAIL_FROM    *> sender's email address
001840           BY REFERENCE IS_ZERO       *> no Reply-To header
001850      END-CALL.
001860
001870      *> check result
001880      IF PROGRAM-STATUS < 0 THEN
001890        DISPLAY "Cannot connect to SMTP server"
001900        MOVE PROGRAM-STATUS TO SEE_CODE
001910        GO TO ERROR-EXIT
001920      END-IF.
001930 
001940      *> send email
001950      DISPLAY "Calling seeSendEmail()..."
001960      CALL "seeSendEmail" WITH STDCALL USING
001970           BY VALUE     CHANNEL       *> channel
001980           BY REFERENCE EMAIL_TO      *> receipient
001990           BY REFERENCE IS_ZERO       *> no CC list
002000           BY REFERENCE IS_ZERO       *> no BCC list
002010           BY REFERENCE EMAIL_SUBJ    *> email subject
002020           BY REFERENCE EMAIL_MSG     *> text of message
002030           BY REFERENCE IS_ZERO       *> no attachment
002040      END-CALL.
002050
002060      *> check result
002070      IF PROGRAM-STATUS < 0 THEN
002080        DISPLAY "Cannot send email"
002090        MOVE PROGRAM-STATUS TO SEE_CODE
002100        GO TO ERROR-EXIT
002110      END-IF.   
002120    
002130      *> close SEE
002140      DISPLAY "Calling seeClose()..."
002150      CALL "seeClose" WITH STDCALL USING
002160           BY VALUE     CHANNEL       *> channel
002170      END-CALL
002180
002190      *> release SEE
002200      CALL "seeRelease" WITH STDCALL 
002210      END-CALL
002220    
002230      DISPLAY "All done."
002240      STOP RUN.
002250        
002260  ERROR-EXIT.
002270
002280      DISPLAY "SEE4CB Error " SEE_CODE
002290      CALL "seeErrorText" WITH STDCALL USING 
002300         BY VALUE     CHANNEL       *> channel
002310         BY VALUE     SEE_CODE
002320         BY REFERENCE BUFFER
002330         BY VALUE     BUF_LEN
002340      END-CALL
002350      DISPLAY BUFFER
002360      STOP RUN.
002370
002380 END PROGRAM MAILER.
002390 
002400
