SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 1 Data Division 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 .title 'Send Mail Subroutine' ; ; ; S M A I L . S B L ; ; 1 SUBROUTINE SMAIL 2 ADDRESS ,A ;ADDRESS of this message or the To: party 3 SUBJECT ,A ;Subject of this message 4 MESSAGE ,A ;Message of File Specification if @ present in string 5 EXTERNAL FUNCTION 6 MAIL$SEND_BEGIN ,%VAL 7 MAIL$SEND_END ,%VAL 8 MAIL$SEND_MESSAGE ,%VAL 9 MAIL$SEND_ADD_ATTRIBUTE ,%VAL 10 MAIL$SEND_ADD_BODYPART ,%VAL 11 MAIL$SEND_ADD_ADDRESS ,%VAL 12 SYS$GETJPIW ,%VAL .include 'maildef.dib' .include 'mailmsgdef.dib' .include '$jpidef' library 'sys$library:dblstarlet' SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 16 Data Division 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 603 RECORD 604 GROUP IN_ITEM_LIST ,[5]A 605 1 Buff_Length ,I2 606 1 Item_Code ,I2 607 1 Buffer_Addr ,I4 608 1 Return_Length ,I4 609 1 ENDGROUP 610 In_End_Of_List ,I4 611 RECORD 612 GROUP OUT_ITEM_LIST ,[5]A 613 1 Buff_Length ,I2 614 1 Item_Code ,I2 615 1 Buffer_Addr ,I4 616 1 Return_Length ,I4 617 1 ENDGROUP 618 Out_End_Of_List ,I4 619 RECORD 620 SEND_CONTEXT ,I4 ;Context Returned from Call to SEND routines 621 STATUS ,I4 ;Status Returned from Call 622 TEXT ,A80 ;Message Text of this Mail Message Record 623 TEXT_LENGTH ,I4 ;Length of "TEXT" 624 COUNTER ,I2 ;Counter for loop control 625 MESSAGE_ID ,I4 ;Message ID 626 ZERO ,I2,0 ;Zero 627 CURRENT_USERNAME ,A12 ;Current Username 628 CU_LENGTH ,I4 ;Length of "CURRENT_USERNAME" 629 ERROR ,D3 ;Error Number 630 IOSB ,[4]I2 ;I/O Status Block 631 ADDRESS_LEN ,I1 ;Length of "ADDRESS" Argument 632 SUBJECT_LEN ,I1 ;Length of "SUBJECT" Argument 633 MESSAGE_LEN ,I2 ;Length of "MESSAGE" Argument 634 FILENAME ,A80 ;File Specification of message to be mailed 635 FILENAME_LEN ,I1 ;Length of File Specification to be mailed 636 DEF_FILE_EXT ,A4,'.TXT' ;Default File Extension (.TXT) 637 DEF_FILE_EXT_LEN ,I1,4 ;Length of Default File Extension (.TXT) 638 RESULT_FILE_SPEC ,A80 ;Returned File Specification 639 RESULT_FILE_SPEC_LEN ,I1 ;Length of Returned File Specification 640 ALREADY_OPEN ,I1 ;Flag indicating status of current channel ; 0 - Not Yet Opened ; 1 - Already Opened 641 NEXT_AVAILABLE_CHANNEL ,I2,99 ;Next Available Channel Number 642 MESSAGE_FILE ,A80 ;File Specification to be mailed 643 MESSAGE_FILE_LEN ,I1 ;Length of "MESSAGE_FILE" 644 FILE_TO_SEND ,I1 ;Switch indicating nature of "MESSAGE" Argument ; 0 - Message Text (255 Chars max) ; 1 - File name to be mailed SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 17 Procedure Division 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 645 PROC 646 XCALL FLAGS (0001000000) 647 In_Item_List[1].Buff_Length = Zero 648 In_Item_List[1].Item_Code = MAIL$_NOSIGNAL 649 In_Item_List[1].Buffer_Addr = Zero 650 In_Item_List[1].Return_Length = Zero 651 In_End_Of_List = Zero 652 Status = %MAIL$SEND_BEGIN (%REF(Send_Context) & ,%REF(In_Item_list) & ,%REF(Out_Item_List)) 653 IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status)) 654 CALL CLEAR_ITEM_LISTS 655 In_Item_List[1].Buff_Length = %SIZE(CURRENT_USERNAME) 656 In_Item_List[1].Item_Code = JPI$_USERNAME 657 In_Item_List[1].Buffer_Addr = %ADDR(CURRENT_USERNAME) 658 In_Item_List[1].Return_Length = %ADDR(CU_LENGTH) 659 In_End_Of_List = Zero 660 Status = %SYS$GETJPIW (,,,%REF(In_Item_list),%REF(IOSB),,) 661 IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status)) .subtitle 'Parse MESSAGE Argument' 662 PARSE_MESSAGE, 663 FILE_TO_SEND = %INSTR (1,MESSAGE,'@') ;Look for the @ 664 MESSAGE_LEN = %SIZE (MESSAGE) ;Get length of MESSAGE argument passed 665 ADDRESS_LEN = %SIZE (ADDRESS) ;Get length of ADDRESS argument passed 666 SUBJECT_LEN = %SIZE (SUBJECT) ;Get length of SUBJECT argument passed 667 IF (FILE_TO_SEND .AND. FILE_TO_SEND .LT. MESSAGE_LEN) 668 1 BEGIN 669 1 DO ;Search for available channel number 670 2 BEGIN 671 2 INCR NEXT_AVAILABLE_CHANNEL 672 2 XCALL DBL$CHOPEN (NEXT_AVAILABLE_CHANNEL,ALREADY_OPEN) 673 2 END 674 1 UNTIL .NOT. ALREADY_OPEN 675 1 INCR FILE_TO_SEND 676 1 MESSAGE_FILE_LEN = MESSAGE_LEN - 1 677 1 MESSAGE_FILE(1:MESSAGE_FILE_LEN) = MESSAGE(FILE_TO_SEND:MESSAGE_LEN) 678 1 ONERROR OPEN_ERROR 679 1 OPEN (NEXT_AVAILABLE_CHANNEL,I,MESSAGE_FILE(1:MESSAGE_FILE_LEN)) 680 1 OFFERROR 681 1 CLOSE NEXT_AVAILABLE_CHANNEL 682 1 END SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 19 Add Attributes to Header 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 .subtitle 'Add Attributes to Header' 683 ADD_ATTRIBUTES_TO_HEADER, 684 CALL CLEAR_ITEM_LISTS 685 In_Item_List[1].Buff_Length = Zero 686 In_Item_List[1].Item_Code = MAIL$_NOSIGNAL 687 In_Item_List[1].Buffer_Addr = Zero 688 In_Item_List[1].Return_Length = Zero 689 In_Item_List[2].Buff_Length = ADDRESS_LEN 690 In_Item_List[2].Item_Code = MAIL$_SEND_TO_LINE 691 In_Item_List[2].Buffer_Addr = %ADDR(ADDRESS(1:ADDRESS_LEN)) 692 In_Item_List[2].Return_Length = Zero 693 In_Item_List[3].Buff_Length = CU_LENGTH 694 In_Item_List[3].Item_Code = MAIL$_SEND_FROM_LINE 695 In_Item_List[3].Buffer_Addr = %ADDR(CURRENT_USERNAME(1:CU_LENGTH)) 696 In_Item_List[3].Return_Length = Zero 697 In_Item_List[4].Buff_Length = SUBJECT_LEN 698 In_Item_List[4].Item_Code = MAIL$_SEND_SUBJECT 699 In_Item_List[4].Buffer_Addr = %ADDR(SUBJECT(1:SUBJECT_LEN)) 700 In_Item_List[4].Return_Length = Zero 701 In_End_Of_List = Zero 702 Status = %MAIL$SEND_ADD_ATTRIBUTE (%REF(Send_Context) & ,%REF(In_Item_list) & ,%REF(Out_Item_List)) 703 IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status)) .subtitle 'Address Message' 704 ADDRESS_MESSAGE, 705 CALL CLEAR_ITEM_LISTS 706 In_Item_List[1].Buff_Length = Zero 707 In_Item_List[1].Item_Code = MAIL$_NOSIGNAL 708 In_Item_List[1].Buffer_Addr = Zero 709 In_Item_List[1].Return_Length = Zero 710 In_Item_List[2].Buff_Length = ADDRESS_LEN 711 In_Item_List[2].Item_Code = MAIL$_SEND_USERNAME 712 In_Item_List[2].Buffer_Addr = %ADDR(ADDRESS(1:ADDRESS_LEN)) 713 In_Item_List[2].Return_Length = Zero 714 In_End_Of_List = Zero 715 Status = %MAIL$SEND_ADD_ADDRESS (%REF(Send_Context) & ,%REF(In_Item_list) & ,%REF(Out_Item_List)) 716 IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status)) SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 21 Format Message 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 .subtitle 'Format Message' 717 FORMAT_MESSAGE, 718 CALL CLEAR_ITEM_LISTS 719 In_Item_List[1].Buff_Length = Zero 720 In_Item_List[1].Item_Code = MAIL$_NOSIGNAL 721 In_Item_List[1].Buffer_Addr = Zero 722 In_Item_List[1].Return_Length = Zero 723 IF (FILE_TO_SEND) THEN 724 1 BEGIN 725 1 In_Item_List[2].Buff_Length = MESSAGE_FILE_LEN 726 1 In_Item_List[2].Item_Code = MAIL$_SEND_FILENAME 727 1 In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE_FILE(1:MESSAGE_FILE_LEN)) 728 1 In_Item_List[2].Return_Length = Zero 729 1 Out_Item_List[1].Buff_Length = %SIZE(RESULT_FILE_SPEC) 730 1 Out_Item_List[1].Item_Code = MAIL$_SEND_RESULTSPEC 731 1 Out_Item_List[1].Buffer_Addr = %ADDR(RESULT_FILE_SPEC) 732 1 Out_Item_List[1].Return_Length = %ADDR(RESULT_FILE_SPEC_LEN) 733 1 In_End_Of_List = Zero 734 1 Out_End_Of_List = Zero 735 1 END 736 ELSE 737 1 BEGIN 738 1 In_Item_List[2].Buff_Length = MESSAGE_LEN 739 1 In_Item_List[2].Item_Code = MAIL$_SEND_RECORD 740 1 In_Item_List[2].Buffer_Addr = %ADDR(MESSAGE(1:MESSAGE_LEN)) 741 1 In_Item_List[2].Return_Length = Zero 742 1 In_End_Of_List = Zero 743 1 END 744 Status = %MAIL$SEND_ADD_BODYPART (%REF(Send_Context) & ,%REF(In_Item_list) & ,%REF(Out_Item_List)) 745 IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status)) SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 22 Send Message 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 .subtitle 'Send Message' 746 SEND_MESSAGE, 747 CALL CLEAR_ITEM_LISTS 748 In_Item_List[1].Buff_Length = Zero 749 In_Item_List[1].Item_Code = MAIL$_NOSIGNAL 750 In_Item_List[1].Buffer_Addr = Zero 751 In_Item_List[1].Return_Length = Zero 752 In_End_Of_List = Zero 753 Status = %MAIL$SEND_MESSAGE (%REF(Send_Context) & ,%REF(In_Item_list) & ,%REF(Out_Item_List)) 754 IF (.NOT.%SUCCESS(Status)) XCALL LIB$STOP (%VAL(Status)) 755 CLEAN_UP_AND_RETURN, 756 CALL CLEANUP 757 CLOSE 1 758 RETURN .subtitle 'Clear Item List Arrays' 759 CLEAR_ITEM_LISTS, 760 CLEAR Counter 761 FOR Counter FROM 1 THRU 5 762 1 BEGIN 763 1 CLEAR In_Item_list[Counter].Buff_Length 764 1 CLEAR In_Item_List[Counter].Item_Code 765 1 CLEAR In_Item_List[Counter].Buffer_Addr 766 1 CLEAR In_Item_List[Counter].Return_Length 767 1 CLEAR Out_Item_list[Counter].Buff_Length 768 1 CLEAR Out_Item_List[Counter].Item_Code 769 1 CLEAR Out_Item_List[Counter].Buffer_Addr 770 1 CLEAR Out_Item_List[Counter].Return_Length 771 1 END 772 RETURN SMAIL Send Mail Subroutine 5-DEC-1990 19:21:19 VAX DIBOL V4.1-00 Page 24 Cleanup and Exit 5-DEC-1990 19:14:42 DUB0:[DECUS]SMAIL.SBL;1 .subtitle 'Cleanup and Exit' 773 CLEANUP, 774 CALL CLEAR_ITEM_LISTS 775 In_Item_List[1].Buff_Length = Zero 776 In_Item_List[1].Item_Code = MAIL$_NOSIGNAL 777 In_Item_List[1].Buffer_Addr = Zero 778 In_Item_List[1].Return_Length = Zero 779 In_End_Of_List = Zero 780 Status = %MAIL$SEND_END (%REF(Send_Context) & ,%REF(In_Item_list) & ,%REF(Out_Item_List)) 781 RETURN .subtitle 'File Open Error' 782 OPEN_ERROR, 783 OFFERROR 784 Error = %ERROR ; Possibilities ; ; 17 $ERR_FILSPC - Illegal Characters in File Specification ; ; 22 $ERR_IOFAIL - Hardware problem. ; ; 24 $ERR_NOSPAC - No space for file ; ; 32 $ERR_REPLAC - Already Exists ; 785 CALL CLEAR_ITEM_LISTS 786 CLOSE NEXT_AVAILABLE_CHANNEL 787 GOTO CLEAN_UP_AND_RETURN No errors detected DIBOL/NOSTAND/OBJECT/LIS SMAIL.SBL