VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ArmGraph"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'what is new

Private ms_tenant As String             ' tenant ID
Private ms_appId As String              ' app id
Private userURL As String               ' Base URL for logged in user

Dim md_MailBoxFolderInfo As Dictionary  ' mailboxes to scan



Dim ms_inboxID As String
Dim ms_outboxID As String
Dim ms_processedID As String


'Public Event MoveMailErr(ls_ErrNr As String, ls_ErrSource As String, ls_ErrDesc As String)

Public Event ArmGraphError(ll_errNr As Long, ls_ErrSource As String, ls_ErrDesc As String, ls_fnc As String)

Private mb_SaveMessageOnSend As Boolean

Public Enum ArmGraphError
    InformationalError = 0
    UnresolvedEXRecipient = 1
    AttachementNotAdded = 2         ' added 5.1.2012 JN
End Enum

Public Sub Load_A_COM()
On Error GoTo ErrorHandler
    
    Call ArmREST.Load_A_COM
    
    Exit Sub
ErrorHandler:
    RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "Load_A_COM")
End Sub

Public Sub Unload_A_COM()
End Sub

Public Property Let TenantID(as_Value As String)
    ms_tenant = as_Value
End Property

Public Property Let ApplicationID(as_Value As String)
    ms_appId = as_Value
End Property

Public Property Let SaveMessageOnSend(ab_Value As Boolean)
  mb_SaveMessageOnSend = ab_Value
End Property

Public Property Get SaveMessageOnSend() As Boolean
  SaveMessageOnSend = mb_SaveMessageOnSend
End Property

Public Function OpenDatabase(ByVal as_userID As String, ByVal as_Password As String) As Boolean
On Error GoTo ErrorHandler
      OpenDatabase = False

Dim lb_Result As Boolean

    lb_Result = False
    
    If md_MailBoxFolderInfo Is Nothing Then
        Set md_MailBoxFolderInfo = New Dictionary
    Else
        Call md_MailBoxFolderInfo.removeAll
    End If
    
    ' connect to microsoft graph
    Dim as_json As String
    Dim ls_Request As String
    ls_Request = "grant_type=client_credentials&client_id=" & ms_appId & "&client_secret=" & as_Password & "&resource=https://graph.microsoft.com"
    If Not PostWebService("https://login.microsoftonline.com/" & ms_tenant & "/oauth2/token", ls_Request, as_json) Then
        RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "PostWebService", "Login failed. (" & ArmREST.ms_Exception & ")", "OpenDatabase")
        Exit Function
    End If
  
    ' get json
    Call ArmREST.SE_AssignObj(as_json)
    
    Call SetAuthToken(ArmREST.SE_ObjProp("token_type"), ArmREST.SE_ObjProp("access_token"))
    
    ' set logged user URL
    
    userURL = "https://graph.microsoft.com/v1.0/" & ms_tenant & "/users/" & as_userID
    
    ' now we can setup folders
    ls_Request = ""
    Dim ls_FoldersURL As String
    ls_FoldersURL = userURL & "/mailFolders"
    
    If Not GetWebService(ls_FoldersURL & "?" & GetRND, as_json) Then
        RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "GetWebService", "Get mail folders failed. (" & ArmREST.ms_Exception & ")", "OpenDatabase")
        Exit Function
    End If
    
    Call ArmREST.SE_AssignObj(as_json)
    
    Dim ll_folderCount As Long
    Dim ll_i As Long
    
    Dim ls_folderID As String
    Dim lb_inbox As Boolean, lb_outbox As Boolean, lb_processed As Boolean
    
    ll_folderCount = ArmREST.SE_ObjProp("value.length")
    
    Dim mailFolder As ArmGraphMailbox
    
    For ll_i = 0 To ll_folderCount - 1
    
        Set mailFolder = New ArmGraphMailbox
        mailFolder.Load_A_COM
        
        mailFolder.Id = ArmREST.SE_ObjProp("value[" & ll_i & "].id")
        mailFolder.displayName = ArmREST.SE_ObjProp("value[" & ll_i & "].displayName")
        mailFolder.childFolderCount = ArmREST.SE_ObjProp("value[" & ll_i & "].childFolderCount")
        mailFolder.unreadItemCount = ArmREST.SE_ObjProp("value[" & ll_i & "].unreadItemCount")
        mailFolder.totalItemCount = ArmREST.SE_ObjProp("value[" & ll_i & "].totalItemCount")
        mailFolder.URL = ls_FoldersURL & "/" & mailFolder.Id
        
        Call md_MailBoxFolderInfo.Add(mailFolder.displayName, mailFolder)
        
        Select Case mailFolder.displayName
            Case "Inbox":
                lb_inbox = True
            Case "Outbox":
                lb_outbox = True
            Case "Processed":
                lb_processed = True
        End Select
    Next
    
    If Not lb_processed Then
        ' create processed folder
        ls_Request = "{""displayName"":""Processed""}"
        If Not PostWebService(ls_FoldersURL & "?" & GetRND, ls_Request, as_json, "Content-Type:application/json") Then
            RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "PostWebService", """Processed"" foldercreation failed. (" & ArmREST.ms_Exception & ")", "OpenDatabase")
            Exit Function
        End If
        
        Call ArmREST.SE_AssignObj(as_json)
    
        ' add it to listi of folders
        Set mailFolder = New ArmGraphMailbox
        mailFolder.Load_A_COM
    
        mailFolder.Id = ArmREST.SE_ObjProp("id")
        mailFolder.displayName = ArmREST.SE_ObjProp("displayName")
        mailFolder.childFolderCount = ArmREST.SE_ObjProp("childFolderCount")
        mailFolder.unreadItemCount = ArmREST.SE_ObjProp("unreadItemCount")
        mailFolder.totalItemCount = ArmREST.SE_ObjProp("totalItemCount")
        mailFolder.URL = ls_FoldersURL & "/" & mailFolder.Id
        
        Call md_MailBoxFolderInfo.Add(mailFolder.displayName, mailFolder)
        
        lb_processed = True
    
    End If
    
    OpenDatabase = (lb_inbox And lb_outbox And lb_processed)
    
    Exit Function
ErrorHandler:
    OpenDatabase = False
    RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "OpenDatabase")
End Function

Public Function CloseDatabase() As Boolean

    Call ArmREST.SetAuthToken("", "")
    ms_inboxID = ""
    ms_outboxID = ""
    ms_processedID = ""

End Function

Public Function GetMailCount() As Long

Dim lo_folder As ArmGraphMailbox

On Error GoTo ErrorHandler
    GetMailCount = -1
    
    If Not md_MailBoxFolderInfo.Exists("Inbox") Then Exit Function
  
    Set lo_folder = md_MailBoxFolderInfo.Item("Inbox")
  
    Dim as_json As String

    'read email info folder ?$select=sender,subject
    If Not GetWebService(lo_folder.URL & "/messages?$select=id&" & GetRND, as_json) Then
        RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "GetWebService", "Get mail count failed. (" & ArmREST.ms_Exception & ")", "GetMailCount")
        Exit Function
    End If

    Call ArmREST.SE_AssignObj(as_json)
    
    Dim ll_folderCount As Long
    Dim ll_i As Long
    
    Dim ll_mailCOunt As Long
    ll_mailCOunt = ArmREST.SE_ObjProp("value.length")
    
    GetMailCount = ll_mailCOunt
    lo_folder.MailCount = ll_mailCOunt
    
    For ll_i = 0 To ll_mailCOunt - 1
    
        Dim lo_Mail As ArmGraphMail
        Set lo_Mail = New ArmGraphMail
        Call lo_Mail.Load_A_COM
        
        lo_Mail.Id = ArmREST.SE_ObjProp("value[" & ll_i & "].id")
        lo_Mail.URL = lo_folder.URL & "/messages/" & lo_Mail.Id
        
        Call lo_folder.SetMail(lo_Mail, ll_i)
        
        Set lo_Mail = Nothing
    Next
    
    Set lo_folder = Nothing

Exit Function
ErrorHandler:
    Set lo_folder = Nothing
    GetMailCount = -1
    RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "GetMailCount")
End Function


Public Function GetMailboxFolder(as_FolderName As String) As ArmGraphMailbox
On Error GoTo ErrorHandler
    
    Set GetMailboxFolder = Nothing
    
    If Not md_MailBoxFolderInfo.Exists(as_FolderName) Then Exit Function
  
    Set GetMailboxFolder = md_MailBoxFolderInfo.Item(as_FolderName)
  
  Exit Function
ErrorHandler:
  Set GetMailboxFolder = Nothing
  RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "GetMailboxFolder")
End Function

' this should be implemented into ArmGraphMail
Public Function ReadMail(ao_mail As ArmGraphMail) As Boolean
On Error GoTo ErrorHandler
    ReadMail = False

    ' get details for the email
    Dim as_json As String

    'read email info ?$select=sender,subject
    If Not GetWebService(ao_mail.URL & "?$select=createdDateTime,receivedDateTime,sentDateTime,hasAttachments,subject,importance,body,sender,from,toRecipients,ccRecipients,bccRecipients,replyTo,flag&" & GetRND, as_json) Then
        RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "GetWebService", "Get mail info failed. (" & ArmREST.ms_Exception & ")", "ReadMail")
        Exit Function
    End If
    
    Call ArmREST.SE_AssignObj(as_json)
    
    ao_mail.Subject = ArmREST.SE_ObjProp("subject")
    Dim ls_contentType As String
    
    ls_contentType = ArmREST.SE_ObjProp("body.contentType")
    Dim lb_askForTextBody As Boolean
    lb_askForTextBody = False
    
    If UCase(ls_contentType) = "HTML" Then
        ao_mail.HTMLBody = ArmREST.SE_ObjProp("body.content")
        
        ' have to ask for plain text body again
        lb_askForTextBody = True
    Else
        ao_mail.Body = ArmREST.SE_ObjProp("body.content")
    End If
    
    ao_mail.AddrFrom = ArmREST.SE_ObjProp("sender.emailAddress.address")
    
    Call ao_mail.ReadAddrTo(ArmREST.mo_ScriptEngine)
    
    Call ao_mail.ReadAddrCc(ArmREST.mo_ScriptEngine)
            
    Call ao_mail.ReadAddrBcc(ArmREST.mo_ScriptEngine)
    
    'TODO: from and replyTo lists not used?
    
    Dim lb_hasAttachments As Boolean
    lb_hasAttachments = ArmREST.SE_ObjProp("hasAttachments")
    
    If lb_hasAttachments Then
        ' get the list of attachements
        If Not GetWebService(ao_mail.URL & "/attachments?$select=id,isInline,name,contentType&" & GetRND, as_json) Then
            RaiseEvent ArmGraphError(ArmGraphError.AttachementNotAdded, "GetWebService", "Get attachements failed. (" & ArmREST.ms_Exception & ")", "ReadMail")
            Exit Function
        End If
        
        Call ArmREST.SE_AssignObj(as_json)
        
        Dim ll_AttCount As Long, ll_i As Long
    
        ll_AttCount = ArmREST.SE_ObjProp("value.length")
    
        For ll_i = 0 To ll_AttCount - 1

            Dim lo_MailAtt As ArmGraphMailAttachment
            Set lo_MailAtt = New ArmGraphMailAttachment
            Call lo_MailAtt.Load_A_COM
            
            lo_MailAtt.Id = ArmREST.SE_ObjProp("value[" & ll_i & "].id")
            lo_MailAtt.URL = ao_mail.URL & "/attachments/" & lo_MailAtt.Id
            lo_MailAtt.Name = ArmREST.SE_ObjProp("value[" & ll_i & "].name")
            lo_MailAtt.ContentType = ArmREST.SE_ObjProp("value[" & ll_i & "].contentType")
            lo_MailAtt.IsInline = ArmREST.SE_ObjProp("value[" & ll_i & "].isInline")
            
            Call ao_mail.Attachments.Add(lo_MailAtt)
            
            Set lo_MailAtt = Nothing
        Next
        
    End If
    
    If lb_askForTextBody Then
    
        ' ask for plain text
        If Not GetWebService(ao_mail.URL & "?$select=body&" & GetRND, as_json, "Prefer:outlook.body-content-type=""text""") Then
            RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "GetWebService", "Get mail body failed. (" & ArmREST.ms_Exception & ")", "ReadMail")
            Exit Function
        End If
        
        Call ArmREST.SE_AssignObj(as_json)
        
        ao_mail.Body = ArmREST.SE_ObjProp("body.content")
        
    End If

    ReadMail = True
    Exit Function
ErrorHandler:
  RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "ReadMail")
End Function

Public Function SendMail(ao_mail As ArmGraphMail, Optional as_saveAsPath As String = "") As Boolean

On Error GoTo ErrorHandler

    SendMail = False

    ' generate message json
    Dim ls_json As Variant
    Dim ls_Request As String
    
    Dim lo_folder As ArmGraphMailbox
    Set lo_folder = GetMailboxFolder("Drafts")
    
    ' create email into drafts
    If Not PostWebService(lo_folder.URL & "/messages/?" & GetRND, ao_mail.ToJSON(), ls_json, "Content-Type:application/json") Then
        RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "PostWebService", "Create mail failed. (" & ArmREST.ms_Exception & ")", "SendMail")
        Exit Function
    End If
    
    ' update mail id
    Call ArmREST.SE_AssignObj(ls_json)
    ao_mail.Id = ArmREST.SE_ObjProp("id")
    ao_mail.URL = lo_folder.URL & "/messages/" & ao_mail.Id
        
    ' add an attachments
    Dim ll_i As Long
    For ll_i = 1 To ao_mail.Attachments.Count
        Dim lo_att As ArmGraphMailAttachment
        
        Set lo_att = ao_mail.Attachments(ll_i)
        
        ' add attachement
        If Not PostWebService(ao_mail.URL & "/attachments/?" & GetRND, lo_att.ToJSON(), ls_json, "Content-Type:application/json") Then
            RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "PostWebService", "Add atachment to mail failed. (" & ArmREST.ms_Exception & ")", "SendMail")
            Exit Function
        End If
        
        ' update id
        Call ArmREST.SE_AssignObj(ls_json)
        lo_att.Id = ArmREST.SE_ObjProp("id")
        lo_att.URL = ao_mail.URL & "/attachments/" & lo_att.Id
    Next
    
    
    If as_saveAsPath <> "" Then
    
        ' get email in MIME format
        If Not ao_mail.Save(userURL, as_saveAsPath) Then
            RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "ArmGraphMail.Save", "Save failed. (" & ArmREST.ms_Exception & ")", "SendMail")
        End If
    
    End If
    
    ' send it
    If Not PostWebService(ao_mail.URL & "/send?" & GetRND, "", ls_json, "Content-Type:application/json") Then
        RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "PostWebService", "Send mail failed. (" & ArmREST.ms_Exception & ")", "SendMail")
        Exit Function
    End If
    
    Dim lo_sentFolder As ArmGraphMailbox
    Set lo_sentFolder = GetMailboxFolder("Sent Items")
    ' after sending the email it is no more part of draf so we have to update URL
    ao_mail.URL = userURL & "/messages/" & ao_mail.Id
    
    If mb_SaveMessageOnSend = False Then
        
        ' move to deleted
        Call DeleteMail(ao_mail)
        
    End If
  

'        lb_IsThisDefaultFolder = IsItDefaultFolder(lo_folder)
'        If lb_IsThisDefaultFolder = False Then
'            lo_MailItem.SentOnBehalfOfName = ao_Mail.SendAsAccount
'        End If
        
                
    SendMail = True
    
    Exit Function
ErrorHandler:
  RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "SendMail")
End Function

Public Function DeleteMail(ao_mail As ArmGraphMail)
On Error GoTo ErrorHandler
    DeleteMail = False
    
    Dim as_json As Variant
    
    If Not DeleteWebService(ao_mail.URL & "/?" & GetRND, as_json, "Content-Type:application/json") Then
         RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "DeleteWebService", "Delete mail failed. (" & ArmREST.ms_Exception & ")", "DeleteMail")
         Exit Function
     End If
    
        DeleteMail = True
  Exit Function
ErrorHandler:
  DeleteMail = False
  RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "DeleteMail")
End Function

Public Function MoveMail(ao_mail As ArmGraphMail, as_DstFolder As String) As Boolean
Dim lo_DestFolder As ArmGraphMailbox

On Error GoTo ErrorHandler
    MoveMail = False
  
    Set lo_DestFolder = GetMailboxFolder(as_DstFolder)
    
    If Not (lo_DestFolder Is Nothing) And Not (ao_mail Is Nothing) Then
        ' call move email request
        Dim as_json As String
        Dim ls_Request As String
        ls_Request = "{""destinationId"":""" & lo_DestFolder.Id & """}"
        If Not PostWebService(ao_mail.URL & "/move?" & GetRND, ls_Request, as_json, "Content-Type:application/json") Then
            RaiseEvent ArmGraphError(ArmGraphError.InformationalError, "PostWebService", "Move mail failed. (" & ArmREST.ms_Exception & ")", "MoveMail")
            Set lo_DestFolder = Nothing
            Exit Function
        End If
    
        MoveMail = True
    End If
    

    
    Exit Function
ErrorHandler:
  Set lo_DestFolder = Nothing
  MoveMail = False
  RaiseEvent ArmGraphError(Err.Number, Err.Source, Err.Description, "MoveMail")
End Function

