DEFINE TEMP-TABLE ttFolder NO-UNDO
FIELD displayName AS CHARACTER LABEL 'Display Name' format "x(32)"
INDEX idxDisplayName
displayName.
FUNCTION ExchangeService RETURNS HANDLE
(INPUT pchUsername AS CHARACTER,
INPUT pchPassword AS CHARACTER):
DEFINE VARIABLE hWebService AS HANDLE NO-UNDO.
DEFINE VARIABLE hExchangeServicePortType AS HANDLE NO-UNDO.
DEFINE VARIABLE chEWSSOAPConnect AS CHARACTER NO-UNDO.
CREATE SERVER hWebService.
chEWSSOAPConnect = SUBSTITUTE("-WSDL 'Services.wsdl' -Service ExchangeServices -ServiceNamespace http://schemas.microsoft.com/exchange/services/2006/messages -SOAPEndpointUserid &1 -SOAPEndpointPassword &2",
pchUsername,
pchPassword).
hWebService:CONNECT(chEWSSOAPConnect) NO-ERROR.
IF NOT ERROR-STATUS:ERROR THEN
RUN ExchangeServicePortType SET hExchangeServicePortType ON hWebService.
ELSE
MESSAGE ERROR-STATUS:GET-MESSAGE(1)
VIEW-AS ALERT-BOX ERROR.
/** NOT YET NEEDED **/
/** hExchangeServicePortType:SET-CALLBACK-PROCEDURE("REQUEST-HEADER", "ReqHandler").**/
RETURN hExchangeServicePortType.
END FUNCTION.
PROCEDURE ReqHandler:
/* Define procedure parameters */
DEFINE OUTPUT PARAMETER hHeader AS HANDLE.
DEFINE INPUT PARAMETER cNamespace AS CHARACTER.
DEFINE INPUT PARAMETER cLocalNS AS CHARACTER.
DEFINE OUTPUT PARAMETER lDeleteOnDone AS LOGICAL.
/** Not Yet Used**/
/** EWS has option into allow additional SOAP header to be instered if required.**/
RETURN.
END PROCEDURE.
FUNCTION FINDFOLDERREQUEST RETURNS LONGCHAR
(INPUT chDistinguishedFolderId AS CHARACTER ):
/** Find Folder XML Request **/
DEFINE VARIABLE LCREQUEST AS LONGCHAR NO-UNDO.
DEFINE VARIABLE hnSAXWriter AS HANDLE NO-UNDO.
CREATE SAX-WRITER hnSAXWriter.
hnSAXWriter:FRAGMENT = TRUE.
hnSAXWriter:FORMATTED = TRUE.
hnSAXWriter:STRICT = FALSE.
hnSAXWriter:SET-OUTPUT-DESTINATION('longchar':U , LCREQUEST).
hnSAXWriter:START-DOCUMENT().
hnSAXWriter:START-ELEMENT('FindFolder':U,'http://schemas.microsoft.com/exchange/services/2006/messages':U).
hnSAXWriter:DECLARE-NAMESPACE('http://schemas.microsoft.com/exchange/services/2006/types':U,'t':U).
hnSAXWriter:INSERT-ATTRIBUTE('Traversal':U,'Shallow':U).
hnSAXWriter:START-ELEMENT('FolderShape':U).
hnSAXWriter:WRITE-DATA-ELEMENT('t:BaseShape':U, 'Default':U ).
hnSAXWriter:END-ELEMENT('FolderShape':U).
hnSAXWriter:START-ELEMENT('ParentFolderIds':U).
hnSAXWriter:WRITE-EMPTY-ELEMENT ('t:DistinguishedFolderId':U).
hnSAXWriter:INSERT-ATTRIBUTE('Id':U, chDistinguishedFolderId).
hnSAXWriter:END-ELEMENT('ParentFolderIds':U).
hnSAXWriter:END-ELEMENT('FindFolder':U).
hnSAXWriter:END-DOCUMENT().
DELETE OBJECT hnSAXWriter.
RETURN LCREQUEST.
END FUNCTION.
PROCEDURE FindFolderResponce:
DEFINE INPUT PARAMETER plcFindFolderResult AS LONGCHAR NO-UNDO.
DEFINE VARIABLE hnSAXReader AS HANDLE NO-UNDO.
/** Read the Responce...**/
CREATE SAX-READER hnSAXReader.
hnSAXReader:ADD-SCHEMA-LOCATION("http://schemas.microsoft.com/exchange/services/2006/messages", "messages.xsd").
hnSAXReader:ADD-SCHEMA-LOCATION("http://schemas.microsoft.com/exchange/services/2006/types", "types.xsd").
hnSAXReader:HANDLER = THIS-PROCEDURE.
hnSAXReader:SET-INPUT-SOURCE('Longchar',plcFindFolderResult).
hnSAXReader:SAX-PARSE( ).
/* message string(request) SKIP */
/* STRING(FindFolderResult) */
/* view-as alert-box info. */
RETURN.
END PROCEDURE.
DEFINE VARIABLE LCELEMENTVALUE AS LONGCHAR NO-UNDO.
/** SAX Override Procedure. **/
PROCEDURE characters:
DEFINE INPUT PARAMETER pmCharArray AS MEMPTR NO-UNDO.
DEFINE INPUT PARAMETER piArrayLength AS INTEGER NO-UNDO.
LCELEMENTVALUE = LCELEMENTVALUE + GET-STRING(pmCharArray,1,piArrayLength ).
/* COPY-LOB FROM OBJECT pmCharArray FOR piArrayLength TO OBJECT LCELEMENTVALUE APPEND. */
RETURN.
END PROCEDURE.
/** SAX Override Procedure. **/
PROCEDURE startElement:
DEFINE INPUT PARAMETER pcNamespaceURI AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcLocalName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcQName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER phAttributes AS HANDLE NO-UNDO.
LCELEMENTVALUE = ''.
RETURN.
END PROCEDURE.
/** SAX Override Procedure. **/
PROCEDURE endElement:
DEFINE INPUT PARAMETER pcNamespaceURI AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcLocalName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pcQName AS CHARACTER NO-UNDO.
IF pcLocalName EQ 'DisplayName':U THEN
DO:
CREATE ttFolder.
ASSIGN
ttFolder.displayName = LCELEMENTVALUE.
END.
RETURN.
END PROCEDURE.
/** MAIN-BLOCK **/
DEFINE VARIABLE lcFindFolderRequest AS LONGCHAR NO-UNDO.
DEFINE VARIABLE lcFindFolderResult AS LONGCHAR NO-UNDO.
DEFINE VARIABLE hExchangeServicePortType AS HANDLE NO-UNDO.
hExchangeServicePortType = ExchangeService(INPUT 'your emaill address goes here',
INPUT 'YOUR PASSWORD GOES HERE').
lcFindFoldeRREQUEST = FINDFOLDERREQUEST(INPUT 'msgfolderroot':U ).
/** DEBUG MESSAGE **/
/** message STRING(lcFindFoldeRREQUEST) view-as alert-box info. **/
/** Execute the SOAP call..**/
RUN FindFolder IN hExchangeServicePortType(INPUT lcFindFoldeRREQUEST,
OUTPUT lcFindFolderResult).
RUN FindFolderResponce(INPUT lcFindFolderResult).
FOR each ttFolder:
DISPLAY ttFolder.
END.