001000 @OPTIONS NOALPHA
001010 @OPTIONS MAIN
001020
001030 *>
001040 *>
001050 *>  Source Module: STATUS.CBL
001060 *>
001070 *>  Last Modified: September 1, 1999
001080 *>
001090 *>  Author:  MDM
001100 *>
001110 *>  Must be linked with SEE32.LIB
001120 *>
001130 *> IMPORTANT:  Edit POP3_SERVER, POP3_USER, and POP3_PASS
001140 *>    with appropriate strings before compiling.
001150 *>    See SEE4CB_U.TXT and SEE4CB_R.TXT manuals.
001160 *>
001170
001180 IDENTIFICATION DIVISION.
001190 PROGRAM-ID.    STAT.
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  POP3_SERVER.
001430      05  FILLER PIC X(8) VALUE "10.0.0.1".
001440      05  FILLER PIC X VALUE X'00'.
001450  01  POP3_USER.
001460      05  FILLER PIC X(4) VALUE "mike".
001470      05  FILLER PIC X VALUE X'00'.
001480  01  POP3_PASS.
001490      05  FILLER PIC X(4) VALUE "mike".
001500      05  FILLER PIC X VALUE X'00'. 
001510  01  FROM-TEXT.
001520      05  FILLER PIC X(6) VALUE "From: ".
001530      05  FILLER PIC X VALUE X'00'. 
001540  01  SUBJ-TEXT.
001550      05  FILLER PIC X(9) VALUE "Subject: ".
001560      05  FILLER PIC X VALUE X'00'. 
001570  01  NBR_MESSAGES PIC S9(9) COMP-5 VALUE 0.
001580  01  COUNTER PIC S9(9) COMP-5 VALUE 1.
001590  01  RESULT.
001600      05  FILLER PIC X(55).
001610      05  FILLER PIC X VALUE X'00'.
001620  01  RESULT_LEN PIC S9(9) COMP-5 VALUE 55.
001630  01  BIGBUF.
001640      05  FILLER PIC X(1000).
001650      05  FILLER PIC X VALUE X'00'.
001660  01  BIGBUF_LEN PIC S9(9) COMP-5 VALUE 1000.
001670
001680 PROCEDURE DIVISION.
001690 
001700      DISPLAY "STATUS.CBL Program"
001710      DISPLAY " "
001720 
001730      DISPLAY "Server is " POP3_SERVER
001740      DISPLAY "User is " POP3_USER
001750      DISPLAY " "
001760
001770      *> attach SEE
001780      CALL "seeAttach" WITH STDCALL USING
001790           BY VALUE     NBR_CHANS     *> number of channels
001800           BY VALUE     SEE_KEY_CODE  *> See KEYCODE.CBI
001810      END-CALL.
001820      
001830      *> connect to POP3 server
001840      DISPLAY "Calling seePop3Connect()..."
001850      CALL "seePop3Connect" WITH STDCALL USING
001860           BY VALUE     CHANNEL       *> channel
001870           BY REFERENCE POP3_SERVER   *> POP3 server name
001880           BY REFERENCE POP3_USER     *> user name
001890           BY REFERENCE POP3_PASS     *> user password
001900      END-CALL.
001910
001920      *> check result
001930      IF PROGRAM-STATUS < 0 THEN
001940        DISPLAY "Cannot connect to POP3 server"
001950        MOVE PROGRAM-STATUS TO SEE_CODE
001960        GO TO ERROR-EXIT
001970      END-IF.
001980 
001990      *> get # messages waiting
002000      DISPLAY "Calling seeGetEmailCount()..."
002010      CALL "seeGetEmailCount" WITH STDCALL USING
002020           BY VALUE     CHANNEL       *> channel
002030      END-CALL.
002040
002050      *> check result
002060      IF PROGRAM-STATUS < 0 THEN
002070        DISPLAY "Error getting email count"
002080        MOVE PROGRAM-STATUS TO SEE_CODE
002090        GO TO ERROR-EXIT
002100      END-IF.   
002110    
002120      MOVE PROGRAM-STATUS TO NBR_MESSAGES
002130      DISPLAY NBR_MESSAGES " messages waiting on server."
002140 
002150      MOVE 1 TO COUNTER.
002160
002170  PROCESS-LOOP.
002180
002190      *> any more email messages ?
002200      IF COUNTER > NBR_MESSAGES THEN
002210        GO TO PROCESS-DONE
002220      END-IF.
002230
002240      *> get all header lines
002250      DISPLAY "Calling seeGetEmailLines()..."
002260      CALL "seeGetEmailLines" WITH STDCALL USING 
002270        BY VALUE     CHANNEL       *> channel
002280        BY VALUE     COUNTER       *> message number (1,2,...)
002290        BY VALUE     IS_ZERO       *> number of lines (after headers)
002300        BY REFERENCE BIGBUF        *> resultant buffer
002310        BY VALUE     BIGBUF_LEN    *> buffer length
002320      END-CALL
002330
002340      DISPLAY "----- Email message " COUNTER
002350
002360      MOVE SPACES TO RESULT
002370      *> find header line with "From: "
002380      CALL "seeExtractText" WITH STDCALL USING 
002390        BY REFERENCE BIGBUF        *> source buffer
002400        BY REFERENCE FROM-TEXT     *> text to match
002410        BY REFERENCE RESULT        *> resultant buffer
002420        BY VALUE     RESULT_LEN    *> buffer length
002430      END-CALL
002440
002450      IF PROGRAM-STATUS > 0 THEN
002460        DISPLAY RESULT 
002470      END-IF. 
002480
002490      MOVE SPACES TO RESULT
002500      *> find header line with "Subject: "
002510      CALL "seeExtractText" WITH STDCALL USING 
002520        BY REFERENCE BIGBUF        *> source buffer
002530        BY REFERENCE SUBJ-TEXT     *> text to match
002540        BY REFERENCE RESULT        *> resultant buffer
002550        BY VALUE     RESULT_LEN    *> buffer length
002560      END-CALL
002570
002580      IF PROGRAM-STATUS > 0 THEN
002590        DISPLAY RESULT 
002600      END-IF.
002610      ADD 1 TO COUNTER
002620      GO TO PROCESS-LOOP.
002630
002640  PROCESS-DONE.
002650
002660      DISPLAY "-----"
002670
002680      *> close SEE
002690      DISPLAY "Calling seeClose()..."
002700      CALL "seeClose" WITH STDCALL USING
002710         BY VALUE     CHANNEL       *> channel
002720      END-CALL
002730
002740      *> release SEE
002750      DISPLAY "Calling seeRelease()..."
002760      CALL "seeRelease" WITH STDCALL 
002770      END-CALL
002780    
002790      DISPLAY "All done."
002800      STOP RUN.
002810        
002820  ERROR-EXIT.
002830
002840      DISPLAY "SEE4CB Error " SEE_CODE
002850      CALL "seeErrorText" WITH STDCALL USING 
002860         BY VALUE     CHANNEL       *> channel
002870         BY VALUE     SEE_CODE
002880         BY REFERENCE BUFFER
002890         BY VALUE     BUF_LEN
002900      END-CALL
002910      DISPLAY BUFFER
002920      STOP RUN.
002930
002940 END PROGRAM STAT.
002950 
002960
