ZBCC0007-Send_mail-SE38(I類型)

*&---------------------------------------------------------------------*
* Report      : Send_mail
* Description : 寄信副程式 (Function)
* Date/Author : 2019.3.29 / Duke
*&---------------------------------------------------------------------*
* M O D I F I C A T I O N  L O G
*&---------------------------------------------------------------------*
* ChangeDate  Programmer  Request     Description
* ==========  ==========  ==========  ==================================
*&
*&---------------------------------------------------------------------*

DATA: %g_title    LIKE sodocchgi1,   "郵件標題
      %g_mailname TYPE sopcklsti1-obj_descr,   "附件名稱
      %t_txt      LIKE STANDARD TABLE OF solisti1 WITH HEADER LINE,   "E-mail內文
      %t_email    LIKE STANDARD TABLE OF somlreci1 WITH HEADER LINE,  "E-mail地址
      %g_send     LIKE  soextreci1-receiver.   "寄件者(E-mail)
DATA: %g_length     TYPE i,   "總行數
      %g_txt_length TYPE i.   "內文行數
DATA: %g_doc TYPE sopcklsti1-doc_type VALUE 'RAW'.   "內文Type

DATA: %_string  TYPE string,
      %_xstring TYPE xstring.   "PDF附件 & Excel附件

DATA: BEGIN OF %t_attach OCCURS 0,
        doctype TYPE sopcklsti1-doc_type,  "附件類型 'PDF' or 'XLS'
        name    TYPE sopcklsti1-obj_descr,    "附件名稱
        annex   TYPE xstring,                "PDF附件 & Excel附件
      END OF %t_attach.

*--------------------------------------------------*
*----------get_mail_address----------*
"抓郵件群組的E-mail
"-----> pt_email      E-mail地址
"<----- pl_mailgroup  郵件群組
*--------------------------------------------------*
FORM get_mail_address TABLES pt_email STRUCTURE somlreci1
                       USING pl_mailgroup.   "取得Mail Group的E-mail
  DATA: lt_dli      LIKE STANDARD TABLE OF soxdl WITH HEADER LINE,
        l_dli       LIKE soodk,
        lt_member   LIKE STANDARD TABLE OF sodm1 WITH HEADER LINE,
        lt_objpara  LIKE STANDARD TABLE OF selc  WITH HEADER LINE,
        lt_objparb  LIKE STANDARD TABLE OF soop1 WITH HEADER LINE,
        l_mailgroup LIKE  sood-objnam.

  l_mailgroup = pl_mailgroup.

  IF l_mailgroup IS NOT INITIAL.   "2020.5.31 Duke增加檢查
    "如果Mail Group空值，會抓系統中第一個Mail Group的資料
    CALL FUNCTION 'SO_DLI_LIST_READ_XDL'
      EXPORTING
*       DLI_GENERIC_DESC      = ' '
        dli_generic_name      = l_mailgroup
*       ENTRY_ESCAPE          = ' '
*       ENTRY_ID              = ' '
*       ENTRY_NAME            = ' '
*       OWNER                 = ' '
*       PRIVATE               = ' '
        public                = 'X'
*       SUBSCRIPT             = 'X'
      TABLES
        dli_display_tab       = lt_dli
      EXCEPTIONS
        communication_failure = 1
        dl_list_no_entries    = 2
        owner_not_exist       = 3
        system_failure        = 4
        x_error               = 5
        parameter_error       = 6
        OTHERS                = 7.
    IF sy-subrc <> 0.
* Implement suitable error handling here
    ELSE.
      READ TABLE lt_dli INDEX 1.
      l_dli-objtp = lt_dli-dlitp.
      l_dli-objyr = lt_dli-dliyr.
      l_dli-objno = lt_dli-dlino.

      CALL FUNCTION 'SO_DLI_READ'
        EXPORTING
*         DISTRIBUTIONLIST           = ' '
          dli_id                     = l_dli
*         OWNER                      = ' '
          system_dli                 = 'X'
* IMPORTING
*         OBJECT_FL_DISPLAY          =
*         OBJECT_HD_DISPLAY          =
*         OBJECT_ID                  =
*         OBJECT_SD_DISPLAY          =
        TABLES
          member                     = lt_member
          objpara                    = lt_objpara
          objparb                    = lt_objparb
        EXCEPTIONS
          active_user_not_exist      = 1
          communication_failure      = 2
          component_not_available    = 3
          dl_name_not_exist          = 4
          folder_not_exist           = 5
          folder_no_authorization    = 6
          forwarder_not_exist        = 7
          object_not_exist           = 8
          object_no_authorization    = 9
          operation_no_authorization = 10
          owner_not_exist            = 11
          parameter_error            = 12
          substitute_not_active      = 13
          substitute_not_defined     = 14
          system_failure             = 15
          user_not_exist             = 16
          x_error                    = 17
          OTHERS                     = 18.
      IF sy-subrc <> 0.
* Implement suitable error handling here
      ELSE.
        LOOP AT lt_member.
          CASE lt_member-memtp.
            WHEN 'ADR'.   "外部e-mail帳號
              pt_email-receiver = lt_member-address.
              pt_email-rec_type = 'U'.
              APPEND pt_email.
              CLEAR pt_email.
            WHEN 'USR'.   "內部user id
              pt_email-receiver = lt_member-address.
              pt_email-rec_type = 'B'.
              APPEND pt_email.
              CLEAR pt_email.
          ENDCASE.
        ENDLOOP.

      ENDIF.
    ENDIF.
  ENDIF.
ENDFORM.
*--------------------------------------------------*
*----------send_mail----------*
"寄信副程式
"-----> pt_txt           郵件內文+TXT附件
"       pl_type          附件類型 'TXT' or 'PDF' or 'XLS'
"       pl_title         郵件標題(最多50 char)
"       pl_name          附件標題
"       pl_xstring_annex PDF or XLS附件 type xstring
"<----- pl_subrc         錯誤指示碼
"Data: %g_txt_length  郵件內文長度
"      %g_send  寄件人
"      %t_email  E-mail地址
*--------------------------------------------------*
FORM send_mail  TABLES pt_txt
                 USING VALUE(pl_type)
                       pl_title
                       pl_name
                       pl_xstring_annex
              CHANGING pl_subrc.
  DATA: lt_packing    LIKE STANDARD TABLE OF sopcklsti1 WITH HEADER LINE,
        lt_header     LIKE STANDARD TABLE OF solisti1 WITH HEADER LINE,
        lt_attachment LIKE STANDARD TABLE OF solix WITH HEADER LINE.
  DATA: l_length  TYPE i,   "E-mail 郵件內文的行數
        l_doctype TYPE sopcklsti1-doc_type,
        l_xstring TYPE xstring.
  DATA: l_adr LIKE soextreci1-adr_typ.

  CASE pl_type.
    WHEN 'TXT'.
      l_doctype = 'RAW'.
    WHEN 'PDF' OR 'XLS'.
      IF pl_xstring_annex IS NOT INITIAL.
        l_xstring = pl_xstring_annex.
        PERFORM %xstring_to_bin TABLES lt_attachment   "整理PDF or XLS附件
                                 USING l_xstring.
        l_doctype = pl_type.
      ENDIF.
      %g_txt_length = lines( pt_txt[] ).   "TXT為內文

    WHEN 'ZIP'.   "ZIP測試 2020.11.30 Duke
      IF pl_xstring_annex IS NOT INITIAL.

        CALL FUNCTION 'SCMS_XSTRING_TO_BINARY'
          EXPORTING
            buffer     = pl_xstring_annex
          TABLES
            binary_tab = lt_attachment.

        l_doctype = pl_type.
      ENDIF.
      %g_txt_length = lines( pt_txt[] ).   "TXT為內文

    WHEN OTHERS.   "非預設附件類型則轉換為TXT
      pl_type = 'TXT'.
      l_doctype = 'RAW'.
  ENDCASE.

*-----郵件內文
  %g_length = lines( pt_txt[] ).   "郵件總行數
  lt_packing-body_start =  1.
  lt_packing-body_num   = %g_txt_length.  "郵件內文lines
  lt_packing-doc_type   = %g_doc. "DOC type
  APPEND lt_packing.
  CLEAR lt_packing.

*-----附件內文
  CASE pl_type.
    WHEN 'TXT'.
      l_length = %g_length - %g_txt_length. "附件總行數
    WHEN 'PDF' OR 'XLS' OR 'ZIP'.
      lt_packing-transf_bin  = 'X'.
      CLEAR %g_txt_length.   "附件為PDF or XLS時，TXT內容全部顯示為內文
      l_length = lines( lt_attachment[] ).

  ENDCASE.

  IF l_length > 0.
    lt_packing-head_start = 1.
    lt_packing-head_num   = 1.
    lt_packing-body_start = 1 + %g_txt_length."郵件內文lines 結束的地方
    lt_packing-body_num   =  l_length .

*-----附件
    IF pl_name IS INITIAL.
      %g_mailname = '附件'.
    ELSE.
      %g_mailname = pl_name.
    ENDIF.

    lt_packing-doc_type  = l_doctype.
    lt_packing-obj_name  = %g_mailname.   "沒有用到
    lt_packing-obj_descr = %g_mailname.   "在SOST中看到的附件名稱(TXT為同名)
    lt_packing-doc_size  = 255 * l_length .
    APPEND lt_packing.

    lt_header-line = %g_mailname && '.' && pl_type.   "在Mail中看到的附件名稱(PDF or XLS)
    APPEND lt_header.
  ENDIF.

  PERFORM %mail_title USING pl_title.   "組郵件標題

  IF %g_send IS INITIAL.
    l_adr = 'B'.
  ELSE.
    l_adr = 'INT'.
  ENDIF.

  PERFORM %call_send_mail TABLES %t_email[]
                                 pt_txt[]
                                 lt_packing[]
                                 lt_header[]
                                 lt_attachment[]
                           USING %g_title
                                 l_adr
                        CHANGING pl_subrc.


ENDFORM.

*--------------------------------------------------*
*----------send_mail_2----------*
"寄信副程式
"-----> pt_txt           郵件內文
"       pt_attachment    郵件附件(附件類型, 附件標題, PDF or XLS附件 type xstring)
"       pl_title         郵件標題(最多50 char)
"<----- pl_subrc         錯誤指示碼
"Data: %g_send  寄件人
"      %t_email  E-mail地址
*--------------------------------------------------*
FORM send_mail_2 TABLES pt_txt
                        pt_attachment STRUCTURE %t_attach
                  USING pl_title
               CHANGING pl_subrc.
  DATA: lt_packing    LIKE STANDARD TABLE OF sopcklsti1 WITH HEADER LINE,
        lt_header     LIKE STANDARD TABLE OF solisti1 WITH HEADER LINE,
        lt_attachment LIKE STANDARD TABLE OF solix WITH HEADER LINE.
  DATA: l_length  TYPE i,   "E-mail 郵件內文的行數
        l_length2 TYPE i,  "Keep行數
        l_doctype TYPE sopcklsti1-doc_type,
        l_xstring TYPE xstring,
        l_num     TYPE i.   "附件數計算
  DATA: l_adr LIKE soextreci1-adr_typ.   "寄件人Type

*-----郵件內文
  %g_txt_length = lines( pt_txt[] ).   "郵件總行數
  lt_packing-body_start =  1.
  lt_packing-body_num   = %g_txt_length.  "郵件內文lines
  lt_packing-doc_type   = 'RAW'. "DOC type
  APPEND lt_packing.

*  l_length2 = %g_txt_length.
  CLEAR: lt_packing, %g_txt_length.

*-----附件
  IF pt_attachment[] IS NOT INITIAL.
    LOOP AT pt_attachment.
      IF pt_attachment-doctype IS INITIAL.   "附件類型
        l_doctype = 'PDF'.
      ELSE.
        l_doctype = pt_attachment-doctype.
      ENDIF.

      IF pt_attachment-annex IS NOT INITIAL.
        l_xstring = pt_attachment-annex.
        PERFORM %xstring_to_bin TABLES lt_attachment   "整理PDF or XLS附件
                                 USING l_xstring.
      ENDIF.

      l_num = l_num + 1.

      l_length = lines( lt_attachment[] ).

*-----附件
      IF pt_attachment-name IS INITIAL.
        %g_mailname = '附件_' && l_num.
      ELSE.
        %g_mailname = pt_attachment-name.
      ENDIF.

*-----組附件結構
      IF l_length > 0.
        lt_packing-transf_bin  = 'X'.

        lt_packing-head_start = 1.
        lt_packing-head_num   = 1.
        lt_packing-body_start = 1 +  l_length2.
        lt_packing-body_num   =  l_length .

        lt_packing-doc_type  = l_doctype.
        lt_packing-obj_name  = %g_mailname.   "沒有用到
        lt_packing-obj_descr = %g_mailname.   "在SOST中看到的附件名稱(TXT為同名)
        lt_packing-doc_size  = 255 * l_length .
        APPEND lt_packing.

        lt_header-line = %g_mailname && '.' && l_doctype.   "在Mail中看到的附件名稱(PDF or XLS)
        APPEND lt_header.

        l_length2 = l_length2 + l_length.   "紀錄行數

      ENDIF.

    ENDLOOP.
  ENDIF.

  PERFORM %mail_title USING pl_title.   "組郵件標題

  IF %g_send IS INITIAL.
    l_adr = 'B'.
  ELSE.
    l_adr = 'INT'.
  ENDIF.

  PERFORM %call_send_mail TABLES %t_email[]
                                 pt_txt[]
                                 lt_packing[]
                                 lt_header[]
                                 lt_attachment[]
                           USING %g_title
                                 l_adr
                        CHANGING pl_subrc.

ENDFORM.

FORM %call_send_mail TABLES pt_email
                            pt_txt
                            pt_list
                            pt_header
                            pt_attachment
                      USING pl_document
                            pl_adr
                   CHANGING pl_subrc.

  CALL FUNCTION 'SO_DOCUMENT_SEND_API1'
    EXPORTING
      document_data              = pl_document
      put_in_outbox              = 'X'
      sender_address             = %g_send
      sender_address_type        = pl_adr
      commit_work                = 'X'
*     IP_ENCRYPT                 =
*     IP_SIGN                    =
*     IV_VSI_PROFILE             =
* IMPORTING
*     SENT_TO_ALL                =
*     NEW_OBJECT_ID              =
*     SENDER_ID                  =
    TABLES
      packing_list               = pt_list[]
      object_header              = pt_header[]
*     CONTENTS_BIN               =
      contents_txt               = pt_txt[]
      contents_hex               = pt_attachment[]
*     OBJECT_PARA                =
*     OBJECT_PARB                =
      receivers                  = pt_email[]
*     ET_VSI_ERROR               =
    EXCEPTIONS
      too_many_receivers         = 1
      document_not_sent          = 2
      document_type_not_exist    = 3
      operation_no_authorization = 4
      parameter_error            = 5
      x_error                    = 6
      enqueue_error              = 7
      OTHERS                     = 8.
*  IF sy-subrc <> 0.
** Implement suitable error handling here
*  ENDIF.


*  CALL FUNCTION 'SO_NEW_DOCUMENT_ATT_SEND_API1'
*    EXPORTING
*      document_data              = pl_document
*      put_in_outbox              = 'X'
*      commit_work                = 'X'
** IMPORTING
**     SENT_TO_ALL                =
**     NEW_OBJECT_ID              =
*    TABLES
*      packing_list               = pt_list[]
*      object_header              = pt_header[]
**     contents_bin               =
*      contents_txt               = pt_txt[]
*      contents_hex               = pt_attachment[]
**     OBJECT_PARA                =
**     OBJECT_PARB                =
*      receivers                  = pt_email[]
*    EXCEPTIONS
*      too_many_receivers         = 1
*      document_not_sent          = 2
*      document_type_not_exist    = 3
*      operation_no_authorization = 4
*      parameter_error            = 5
*      x_error                    = 6
*      enqueue_error              = 7
*      OTHERS                     = 8.
  pl_subrc = sy-subrc.
ENDFORM.

FORM %mail_title USING pl_title.
  IF pl_title IS INITIAL.   "信件標題
    %g_title-obj_descr = 'SAP系統信件_' && sy-datum.
  ELSE.
    %g_title-obj_descr = pl_title.
  ENDIF.
  IF %g_title-obj_langu IS INITIAL.   "語言(預設繁中)
    %g_title-obj_langu = 'M'.
  ENDIF.
  IF %g_title-sensitivty  IS INITIAL.   "郵件信用程度( 'O' = 標準 )
    %g_title-sensitivty  = 'O'.
  ENDIF.
ENDFORM.
*--------------------------------------------------*
*----------%xstring_to_bin----------*
"xstring to bin
"-----> pl_xstring     xstring格式
"<----- pt_attachment  bin格式
*--------------------------------------------------*
FORM %xstring_to_bin TABLES pt_attachment
                      USING pl_xstring.
  DATA: lt_attachment LIKE STANDARD TABLE OF solix WITH HEADER LINE.

  CONCATENATE cl_abap_char_utilities=>byte_order_mark_little
   pl_xstring INTO pl_xstring IN BYTE MODE.

  CALL FUNCTION 'SCMS_XSTRING_TO_BINARY'
    EXPORTING
      buffer     = pl_xstring
    TABLES
      binary_tab = lt_attachment.

  IF pt_attachment[] IS INITIAL.
    pt_attachment[] = lt_attachment[].
  ELSE.
    LOOP AT lt_attachment.
      APPEND lt_attachment TO pt_attachment.
    ENDLOOP.
  ENDIF.

ENDFORM.
*--------------------------------------------------*
*----------string_to_xstring----------*
"string_to_xstring
"-----> pl_string   string格式
"<----- pl_xstring  xstring格式
*--------------------------------------------------*
FORM string_to_xstring USING pl_string TYPE string
                    CHANGING pl_xstring TYPE xstring.
  DATA: l_mimetype TYPE char64    "處理文字亂碼Excel
      VALUE 'APPLICATION/MSEXCEL;charset=utf-16le'.

  CALL FUNCTION 'SCMS_STRING_TO_XSTRING'
    EXPORTING
      text     = pl_string
      mimetype = l_mimetype
*     ENCODING =
    IMPORTING
      buffer   = pl_xstring
    EXCEPTIONS
      failed   = 1
      OTHERS   = 2.
  IF sy-subrc <> 0.
* Implement suitable error handling here
  ENDIF.

ENDFORM.



*&---------------------------------------------------------------------*
*&  DEFINE
*&---------------------------------------------------------------------*
DEFINE add_text.
  WRITE: / gt_txt.
  APPEND gt_txt.
END-OF-DEFINITION.