More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 25-Sep-2018 08:07

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: advanced    Code area: Outlook Expert Techniques Printer Friendly Version
Title: How to decode an MSG file without any DLL's
Description: I think we've all wanted to do this for many years. A way of decoding an Outlook MSG file but without any DLL's or other code. This is it, it works on any MSG file sent via the internet or internally via exchange servers and its written using VBS. It totally bypasses Outlook or any other DLL and reads the MSG directly. Combine it with redemption for the ultimate way to save, read and re-read MSG files any way you want to. Please do not re-use without original credits.
Date: 08-Mar-2007  19:04
Code level: advanced
Code area: Outlook Expert Techniques
Posted by: Sean Currie
This message is displayed as VB.NET
 Option Explicit

MsgBox MsgGet("DateSent,ReplyType,DateReply,RecipientsBCC,RecipientsTo,RecipientsCC,From,Prefix,MessageID,Subject,DateSent,DateReceived,AttachmentNumbers,AttachmentExtract,AttachmentNames,Recipients","temp.MSG")


Function MsgGet(s_Val,s_fileName)

' **********************************************************************************
'                            Outlook MSG Reading Utility
'                                Sean Currie @2005
'
' Description : Decodes an Outlook MSG file by reading the Compound Binary File
'               format directly. Note most of the details on the compound binary
'               file format derived from www.openoffice.org
'               It DOES NOT require Outlook to be installed on the client machine
'               nor does it require access to any libraries or third party DLL's
' Arguments   : <s_Val> The value or values to return (each separated by a comma)
'                       e.g.
'                       Subject			- The subject of the email
'                       Prefix  		- The subject prefix of the email
'                       MessageID               - The Message ID
'                       From		 	- The from address or name whichever
'                                                 available
'                       Body                    - The Message Body
'                       AttachmentNumbers	- The number of attachments
'                       AttachmentNames		- The names of the attachments
'                                                 (multiple values separated by a |)
'                       Recipients		- All of the recipient addresses or name whichever
'                                                 available (multiple values
'                                                 separated by a |)
'                                                 includes TO, CC and BCC
'                       RecipientsTo		- All the TO addresses or name whichever
'                                                 available (multiple values
'                                                 separated by a |)
'                       RecipientsCC		- All the CC addresses or name whichever
'                                                 available (multiple values
'                                                 separated by a |)
'                       RecipientsBCC		- All the BCC addresses or name whichever
'                                                 available (multiple values
'                                                 separated by a |)
'                       AttachmentExtract	- The attachments are extracted to
'                                                 a temporary folder and the names
'                                                 returned to the user
'                                                 (multiple values spearated by a |)
'                       DateSent                - The date sent of the email (may not
'                                                 have been sent if in drafts)
'                       DateReceived            - The date received if the email has
'                                                 been received
'                       DateReply               - Date reply requested in follow up
'                       ReplyType               - Reply type (Follow up type)
'                       
'                       Each value is separated by a ^ and each sub value by a |
'                       For example:
'                         asking for Recipients could return
'                         sean.currie@poboxes.com|nuala.currie@poboxes.com
'                         You could then use Split to create an array
'                       For example:
'                         asking for "Recipients,From" could return
'                         sean.currie@poboxes.com|nuala.currie@poboxes.com^anyone@internet.com
'                         You could then use Split with ^ to create two arrays
'                         One of recipients and one of froms
'                         Then you could use Split again to get a list of the Recipients
'
'Examples     : Extract just the subject
'               MsgBox MsgGet("Subject","test.msg")
'
'               Extract multiple fields there we extract the Subject and the From address
'               MsgBox MsgGet("Subject,From","test2.msg")
'
'               Extract the subject, extract the attachments to the temporary folder and
'               return the names of the attachments
'               MsgBox MsgGet("Subject,AttachmentExtract","shortcut.msg")
'
' Created     : 24/12/2005
' Version     : 1.0
'
' Description : Modified the way attachments are decoded using a new feature I call
'               the MultiSectorReader, this speeds up sector decoding by reading
'               sequential sectors in one go thereby speeding up the read process for
'               big emails
' Modified    : 02/01/2006
' Version     : 1.1
'
' Description : Found failure when number of bytes to read for a sector was zero added
'               code to check for zero sectors
' Modified    : 28/01/2007
' Version     : 1.2
'
' Description : Major rewrite to reflect use of OutlookSpy to determine ID's of fields
'               Now accurately reports submit time and received time (previously searched
'               headers, now uses proper MAPI properties to get them).
'               Now also report recipients more accurately and can now separate TO, CC and
'               BCC.
'               Removed receivedby as didn't think it would ever be used.
'               Added support to determine follow up date of email (reply by field)
'               Now also correctly builds the directory from the array
' Modified    : 23/02/2007
' Version     : 2.0
' **********************************************************************************

Dim o_FSO              ' File system object
Dim o_File             ' The input MSG file
Dim s_String           ' Temporary string
Dim s_Temp             ' Temporary variable
Dim s_SectSize         ' Sector size
Dim s_ShortSectSize    ' Short sector size
Dim s_SectSAT          ' No of SAT sectors
Dim s_DIRSID           ' First SID of directory
Dim s_MinStream        ' Minimum size of standard stream
Dim s_SIDSSAT          ' SID of the SSAT
Dim s_SSATNumber       ' Number of SSAT sectors
Dim s_SAT              ' The array of SAT entries
Dim s_MSATSID          ' First sector of MSAT
Dim s_SectMSAT         ' No of MSAT sectors
Dim a_Temp()           ' The array of temporary entries
Dim a_Dir()            ' The array of directory entries
Dim a_MSAT()           ' The array of MSAT entries
Dim a_SSAT()           ' The array of SSAT entries
Dim M_W                ' Temporary Counter
Dim M_X                ' Temporary Counter
Dim M_Y                ' Temporary Counter
Dim M_Z                ' Temporary Counter
Dim s_ShortSat         ' The short sector container stream
Dim s_ShortStart       ' The short sector SAT data
Dim s_ShortSize        ' The short sector SAT data
Dim a_Val              ' Array of s_Val awaiting return values
Dim b_Debug            ' Set this variable to True to create TXT files in the
                       ' current directory to see what is being read from the
                       ' MSG file
Dim s_Return           ' The returned string
Dim s_MessageID        ' The message ID
Dim s_Subject          ' The message subject
Dim s_From             ' The message from address
Dim s_Prefix           ' The message subject prefix
Dim s_Body             ' The message body
Dim s_AttachNums       ' The message attachment numbers
Dim a_AttachNames()    ' The message attachment names
Dim a_Recipients()     ' The message recipients (To, CC and BCC)
Dim a_RecipientsTo()   ' The message recipients in the TO list
Dim a_RecipientsCC()   ' The message recipients in the CC list
Dim a_RecipientsBCC()  ' The message recipients in the BCC list
Dim a_Attachments()    ' The message attachments names on disk
Dim a_Attachments2()   ' The message attachments names
Dim s_DateSent         ' The message date was sent
Dim s_DateReceived     ' The message date was received
Dim s_DateReply        ' The message date of reply (also known as follow up date)
Dim s_ReplyType        ' The message follow up type

' Create object and get the file
Set o_FSO=WScript.CreateObject("Scripting.FileSystemObject")

If Not o_FSO.FileExists(s_FileName) Then
  MsgGet="Error: File does not exist!"
  Exit Function
End If
If UCase(Right(s_Filename,4))<>".MSG" Then
  MsgGet="Error: Not an MSG file!"
  Exit Function
End If

Set o_File=o_FSO.OpenTextFile(s_FileName,1,-1)

' Check that right hand of s_Val has comma
If Right(s_Val,1)<>"," Then
  s_Val=s_Val & ","
End If
s_Val=UCase(s_Val)

' Set the return variables to nothing
MsgGet=""
s_ShortSat=""
s_Return=""
s_Subject=""
s_MessageID=""
s_From=""
s_Prefix=""
s_Body=""
s_AttachNums=0
b_Debug=True
s_DateSent=""
s_DateReceived=""
s_DateReply=""
s_ReplyType=""

' Read header characters
s_String=o_File.Read(8)

' Check its a compound file
If s_String<>MyHexToHexCoded("D0CF11E0A1B11AE1") Then
  MsgGet="Error: Not an MSG file!"
  Exit Function
End If

' Read 16 chars unique identifier with revision
s_String=o_File.Read(20)

' Read 2 chars of byte identifier
s_String=o_File.Read(2)

If s_String<>MyHexToHexCoded("FEFF") Then
  MsgGet="Error: Not an MSG file!"
  Exit Function
End If

' Read 2 chars of sector size
  s_String=o_File.Read(2)

  ' Convert to number and power of 2
  s_SectSize=2 ^ MyVBNumber(s_String)

' Read 2 chars of short sector size
  s_String=o_File.Read(2)

  ' Convert to number and power of 2
  s_ShortSectSize=2 ^ MyVBNumber(s_String)

' Read 10 chars of invalid data
  s_String=o_File.Read(10)

' Read 4 chars of sectors in SAT
  s_String=o_File.Read(4)

  ' Convert to number
  s_SectSAT=MyVBNumber(s_String)

' Read 4 chars of first DIR SID
  s_String=o_File.Read(4)

  ' Convert to number
  s_DIRSID=MyVBNumber(s_String)

' Read 4 chars of invalid data
  s_String=o_File.Read(4)

' Read 4 chars of min stream size
  s_String=o_File.Read(4)

  ' Convert to number
  s_MinStream=MyVBNumber(s_String)

' Read 4 chars of SID of the SSAT
  s_String=o_File.Read(4)

  ' Convert to number
  s_SIDSSAT=MyVBNumber(s_String)

' Read 4 chars of number of SSAT sectors
  s_String=o_File.Read(4)

  ' Convert to number
  s_SSATNumber=MyVBNumber(s_String)

' Read 4 chars of MSAT SID
  s_String=o_File.Read(4)

  ' Convert to number
  s_MSATSID=MyVBNumber(s_String)

' Read 4 chars of number of sectors in MSAT
  s_String=o_File.Read(4)

  ' Convert to number
  s_SectMSAT=MyVBNumber(s_String)

' Now read the first 109 entries in the MSAT
For M_X=1 To 109

  ' Read 4 chars of MSAT sector IDs
  s_String=o_File.Read(4)

  If MyVBNumber(s_String)>=0 Then

    ReDim Preserve a_MSAT(MyArrayLen(a_MSAT,1)+1)
  
    a_MSAT(MyArrayLen(a_MSAT,1)-1)=MyVBNumber(s_String)
      
  End If

Next

o_File.Close

' The header has now been read
' We now know quite a few things
' - The total number of sectors in the MSAT
' - The first sector of the MSAT to start reading it
' We can now read the MSAT and from there we can read everything

' Do we need to read the MSAT if it is more than 109 entries?
If s_MSATSID<>-2 Then

  M_Y=s_MSATSID

  ' Lets loop through the MSAT
  Do While M_Y>=0

    s_Temp=MySectorReader(s_SectSize,M_Y,s_FileName)

    For M_X=1 To s_SectSize-4 Step 4

      s_String=Mid(s_Temp,M_X,4)

      If MyVBNumber(s_String)>0 Then

        ReDim Preserve a_MSAT(MyArrayLen(a_MSAT,1)+1)
  
        a_MSAT(MyArrayLen(a_MSAT,1)-1)=MyVBNumber(s_String)
       
      End If
    Next

    s_String=Right(s_Temp,4)
    If MyVBNumber(s_String)>0 Then
      M_Y=MyVBNumber(s_String)
    Else
      M_Y=-2
    End If

  Loop
End If

' Temporary debug routine to write out the MSAT
If b_Debug Then
  Set o_File=o_FSO.CreateTextFile("MSAT.TXT")
  For M_X=0 To MyArrayLen(a_MSAT,1)-1
    o_File.WriteLine("---" & a_MSAT(M_X))
  Next
  o_File.Close
End If

' We now have the MSAT hence we can now build the SAT from this
s_SAT=""

For M_Y=0 To (MyArrayLen(a_MSAT,1)-1)

  s_SAT=s_SAT & MySectorReader(s_SectSize,a_MSAT(M_Y),s_FileName)

Next

' Temporary debug routine to write out the SAT
If b_Debug Then
  Set o_File=o_FSO.CreateTextFile("SAT.TXT")
  o_File.WriteLine("Sector" & Chr(9) & " : " & "Value")
  For M_X=1 To Len(s_SAT) Step 4
    o_File.WriteLine(Int(M_X/4) & Chr(9) & " : " & MyVBNumber(Mid(s_SAT,M_X,4)))
  Next
  o_File.Close
End If

' Now we can read the Short Sector SSAT
If s_SIDSSAT<>-2 Then

  M_Y=s_SIDSSAT
  s_Temp=MySectorReader(s_SectSize,M_Y,s_FileName)

  For M_X=1 To s_SectSize Step 4

    s_String=Mid(s_Temp,M_X,4)

    ReDim Preserve a_SSAT(MyArrayLen(a_SSAT,1)+1)
    a_SSAT(MyArrayLen(a_SSAT,1)-1)=MyVBNumber(s_String)

  Next

  M_Z=1
  Do While True
    M_Y=MyVBNumber(Mid(s_Sat,(M_Y*4)+1,4))
    If M_Y>0 Then
      M_Z=M_Z+1
      s_Temp=MySectorReader(s_SectSize,M_Y,s_FileName)
      For M_X=1 To s_SectSize Step 4
        s_String=Mid(s_Temp,M_X,4)

        ReDim Preserve a_SSAT(MyArrayLen(a_SSAT,1)+1)

        a_SSAT(MyArrayLen(a_SSAT,1)-1)=MyVBNumber(s_String)
      Next
    End If
    If M_Z=s_SSATNumber Then
      Exit Do
    End If
  Loop

End If

' Temporary debug routine to write out the SSAT
If b_Debug Then
  Set o_File=o_FSO.CreateTextFile("SSAT.TXT")
  For M_X=0 To MyArrayLen(a_SSAT,1)-1
    o_File.WriteLine(M_X & Chr(9) & " : " & a_SSAT(M_X))
  Next
  o_File.Close
End If

' Finally lets read the directory
M_Y=s_DIRSID

' Lets loop through the DIRECTORY
M_Z=-1
Do While M_Y>=0

  s_Temp=MySectorReader(s_SectSize,M_Y,s_FileName)


  For M_X=1 To s_SectSize Step 128

    M_Z=M_Z+1

    ' First lets check the type of the directory entry and if zero it is unused
    If MyVBNumber(Mid(s_Temp,M_X+66,1))<>0 Then


      If MyArrayLen(a_Dir,2)=0 Then
        ReDim Preserve a_Dir(8,1)
      Else
        ReDim Preserve a_Dir(8,MyArrayLen(a_Dir,2)+1)
      End If
   
      ' Format of the array
      ' 0 - DID
      ' 1 - Name 
      ' 2 - Type
      ' 3 - DID Left Child
      ' 4 - DID Right Child
      ' 5 - DID root node
      ' 6 - SID of first sector
      ' 7 - Stream size

      a_Dir(0, MyArrayLen(a_Dir,2)-1)=M_Z
      a_Dir(1, MyArrayLen(a_Dir,2)-1)=Replace(Mid(s_Temp,M_X,MyVBNumber(Mid(s_Temp,M_X+64,2))),Chr(0),"")
      a_Dir(2, MyArrayLen(a_Dir,2)-1)=MyVBNumber(Mid(s_Temp,M_X+66,1))
      a_Dir(3, MyArrayLen(a_Dir,2)-1)=MyVBNumber(Mid(s_Temp,M_X+68,4))
      a_Dir(4, MyArrayLen(a_Dir,2)-1)=MyVBNumber(Mid(s_Temp,M_X+72,4))
      a_Dir(5, MyArrayLen(a_Dir,2)-1)=MyVBNumber(Mid(s_Temp,M_X+76,4))
      a_Dir(6, MyArrayLen(a_Dir,2)-1)=MyVBNumber(Mid(s_Temp,M_X+116,4))
      a_Dir(7, MyArrayLen(a_Dir,2)-1)=MyVBNumber(Mid(s_Temp,M_X+120,4))

    End if 

  Next

  M_Y=MyVBNumber(Mid(s_Sat,(M_Y*4)+1,4))

Loop

' Temporary debug routine to write out the SSAT
' TO BE REMOVED
If b_Debug Then
  Set o_File=o_FSO.CreateTextFile("DIR.TXT")
  o_File.WriteLine("DID" & Chr(9) & " : " & "Name" & String(30-Len("Name")," ") & " : " & "Type" & Chr(9) & " : " & "Left DID" & Chr(9) & " : " & "Right DID" & Chr(9) & " : " & "Root DID" & Chr(9) & " : " & "Start Sec" & Chr(9) & " : " & "Size")
  For M_X=0 To MyArrayLen(a_Dir,2)-1
    o_File.WriteLine(a_DIR(0,M_X) & Chr(9) & " : " & a_DIR(1,M_X) & String(30-Len(a_DIR(1,M_X))," ") & " : " & a_DIR(2,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(3,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(4,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(5,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(6,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(7,M_X))
  Next
  o_File.Close
End If

' Find out the starting SID for the short stream container and then read the short stream container
If s_SIDSSAT<>-2 Then

  s_ShortStart=0
  s_ShortSize=0
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    If InStr(UCase(a_DIR(1,M_X)),"ROOT ENTRY")>0 Then

      ' Allocate the first sector of the short sector container stream
      s_ShortStart=a_DIR(6,M_X)
      s_ShortSize=a_DIR(7,M_X)
      Exit For
    End If
  
  Next
  
  M_Y=s_ShortStart
  s_ShortSat=MySectorReader(s_SectSize,M_Y,s_FileName)

  Do While True
    M_Y=MyVBNumber(Mid(s_Sat,(M_Y*4)+1,4))
    If M_Y>0 Then
      s_ShortSat=s_ShortSat & MySectorReader(s_SectSize,M_Y,s_FileName)
    End If
    If Len(s_ShortSat)>=s_ShortSize Then
      Exit Do
    End If
  Loop

End If

' Now lets re-read the DIRECTORY in the proper order as Outlook scrambles it
For M_X=0 To MyArrayLen(a_Dir,2)-1

  ' Check for a root entry
  If a_Dir(5,M_X)<>-1 Then

    ' Add to final array
    ReDim Preserve a_Temp(8,MyArrayLen(a_Temp,2)+1)
    a_Temp(0, MyArrayLen(a_Temp,2)-1)=a_Dir(0,M_X)
    a_Temp(1, MyArrayLen(a_Temp,2)-1)=a_Dir(1,M_X)
    a_Temp(2, MyArrayLen(a_Temp,2)-1)=a_Dir(2,M_X)
    a_Temp(3, MyArrayLen(a_Temp,2)-1)=a_Dir(3,M_X)
    a_Temp(4, MyArrayLen(a_Temp,2)-1)=a_Dir(4,M_X)
    a_Temp(5, MyArrayLen(a_Temp,2)-1)=a_Dir(5,M_X)
    a_Temp(6, MyArrayLen(a_Temp,2)-1)=a_Dir(6,M_X)
    a_Temp(7, MyArrayLen(a_Temp,2)-1)=a_Dir(7,M_X)

    MySubRead a_Dir(5,M_X),-1,a_Dir,a_Temp

  End If
Next

' Temporary debug routine to write out the sorted DIRECTORY
' TO BE REMOVED
If b_Debug Then
  Set o_File=o_FSO.CreateTextFile("DIRFINAL.TXT")
  o_File.WriteLine("DID" & Chr(9) & " : " & "Name" & String(30-Len("Name")," ") & " : " & "Type" & Chr(9) & " : " & "Left DID" & Chr(9) & " : " & "Right DID" & Chr(9) & " : " & "Root DID" & Chr(9) & " : " & "Start Sec" & Chr(9) & " : " & "Size")
  For M_X=0 To MyArrayLen(a_Temp,2)-1
    o_File.WriteLine(a_Temp(0,M_X) & Chr(9) & " : " & a_Temp(1,M_X) & String(30-Len(a_Temp(1,M_X))," ") & " : " & a_Temp(2,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(3,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(4,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(5,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(6,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(7,M_X))
  Next
  o_File.Close
End If

ReDim a_Dir(8,MyArrayLen(a_Temp,2))

For M_X=0 To MyArrayLen(a_Temp,2)-1

  a_Dir(0, M_X)=a_Temp(0,M_X)
  a_Dir(1, M_X)=a_Temp(1,M_X)
  a_Dir(2, M_X)=a_Temp(2,M_X)
  a_Dir(3, M_X)=a_Temp(3,M_X)
  a_Dir(4, M_X)=a_Temp(4,M_X)
  a_Dir(5, M_X)=a_Temp(5,M_X)
  a_Dir(6, M_X)=a_Temp(6,M_X)
  a_Dir(7, M_X)=a_Temp(7,M_X)

Next

' Now lets build the return strings and data
If InStr(s_Val,"SUBJECT,")>0 Then

  ' Now get the directory entry for the subject
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_0037")>0 And a_Dir(7,M_X)>0 Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_Subject=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_Subject=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If
    End If
  Next

End If

' Now lets build the return strings and data
If InStr(s_Val,"REPLYTYPE,")>0 Then

  ' Now get the directory entry for the subject
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_8003")>0 And a_Dir(7,M_X)>0 Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_ReplyType=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_ReplyType=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If
    End If
  Next

End If


If InStr(s_Val,"MESSAGEID,")>0 Then

  ' Now get the directory entry for the message id
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_1035")>0 And a_Dir(7,M_X)>0 Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_MessageID=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_MessageID=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If
    End If
  Next

End If

If InStr(s_Val,"FROM,")>0 Then

  ' Now get the directory entry for the from type to find out the source email address
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for SMTP
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_0065")>0 And a_Dir(7,M_X)>0 And s_From="" Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
        s_From=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
      Else
        s_From=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
      End If

    End If
  Next

  ' Check if valid SMTP address
  If InStr(s_From,"@")=0 Then
    s_From=""
  Else
    s_From=Replace(s_From,"<","")
    s_From=Replace(s_From,">","")
    s_From=Replace(s_From,"'","")
  End If

  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for return address
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_800A")>0 And a_Dir(7,M_X)>0 And s_From="" Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
        s_From=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_From=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If

  Next

  ' Check if valid SMTP address
  If InStr(s_From,"@")=0 Then
    s_From=""
  Else
    s_From=Replace(s_From,"<","")
    s_From=Replace(s_From,">","")
    s_From=Replace(s_From,"'","")
  End If

  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for return address
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_800B")>0 And a_Dir(7,M_X)>0 And s_From="" Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
        s_From=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_From=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If

  Next

  ' Check if valid SMTP address
  If InStr(s_From,"@")=0 Then
    s_From=""
  Else
    s_From=Replace(s_From,"<","")
    s_From=Replace(s_From,">","")
    s_From=Replace(s_From,"'","")
  End If

  ' Now get the directory entry for the from type to find out the source email address
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for display name
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_0C1A")>0 And a_Dir(7,M_X)>0 And s_From="" Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
        s_From=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_From=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If
  Next

End If

If InStr(s_Val,"PREFIX,")>0 Then

  ' Now get the directory entry for the message id
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_003D")>0 And a_Dir(7,M_X)>0 Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_Prefix=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
        s_Prefix=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If
  Next

End If

If InStr(s_Val,"BODY,")>0 Then

  ' Now get the directory entry for the message body
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__SUBSTG1.0_1000")>0 And a_Dir(7,M_X)>0 Then

      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_Body=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat),Chr(0),"")
        Exit For
      Else
         s_Body=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
         Exit For
      End If
    End If
  Next

End If

If InStr(s_Val,"ATTACHMENTNUMBERS,")>0 Then

  ' Now get the directory entry for the attachments
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    If InStr(UCase(a_DIR(1,M_X)),"__ATTACH_VERSION1.0_#")>0 Then

      ' Total the number in the email
      s_AttachNums=s_AttachNums+1

    End If
  Next

End If

If InStr(s_Val,"ATTACHMENTNAMES,")>0 Then

  ' Now get the directory entry for the attachments
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for attachment
    If InStr(UCase(a_DIR(1,M_X)),"__ATTACH_VERSION1.0_#")>0 Then

      ReDim Preserve a_AttachNames(MyArrayLen(a_Attachnames,1)+1)

      ' Get attachment name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for attachment name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        ElseIF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3704")>0 Then

          ' Check if in short stream
          If a_DIR(7,M_Y)<s_MinStream Then
            a_AttachNames(MyArrayLen(a_AttachNames,1)-1)=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            a_AttachNames(MyArrayLen(a_AttachNames,1)-1)=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

        ElseIF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3707")>0 Then

          ' Check if in short stream
          If a_DIR(7,M_Y)<s_MinStream Then
            a_AttachNames(MyArrayLen(a_AttachNames,1)-1)=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            a_AttachNames(MyArrayLen(a_AttachNames,1)-1)=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If
        End If
      Next
    End If
  Next

End If

If InStr(s_Val,"RECIPIENTS,")>0 Then

  ' Now get the directory entry for the recipients
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for recipient
    If InStr(UCase(a_DIR(1,M_X)),"__RECIP_VERSION1.0_#")>0 Then

      ReDim Preserve a_Recipients(MyArrayLen(a_Recipients,1)+1)

      s_Temp=""

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for next recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If

        If InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_39FE")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_Recipients(MyArrayLen(a_Recipients,1)-1)=s_String
        End If
      Next

      ' Get org email
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for next recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For
        End If
        
        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_403E")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_Recipients(MyArrayLen(a_Recipients,1)-1)=s_String
        End If
      Next

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for next recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For
        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3001")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_Recipients(MyArrayLen(a_Recipients,1)-1)=s_String

        End If
      Next
    End If
  Next

End If

If InStr(s_Val,"RECIPIENTSTO,")>0 Then

  ' Now get the directory entry for the recipients
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for recipient
    If InStr(UCase(a_DIR(1,M_X)),"__RECIP_VERSION1.0_#")>0 Then

      ReDim Preserve a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)+1)

      s_Temp=""

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If
        
        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_39FE")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)-1)=s_String
        End If
      Next

      ' Get org email
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_403E")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)-1)=s_String

        End If
      Next

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3001")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)-1)=s_String

        End If
      Next

      ' Get recipient type and delete if wrong
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check if its in the TO list
        If InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 And a_Dir(7,M_Y)>0 Then

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat)
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          For M_Z=1 To Len(s_String) Step 8
            If Mid(s_String,M_Z,4)=MyHexToHexCoded("0300150C") Then
              If MyVBNumber(Mid(s_String,M_Z+8,1))<>1 And s_Temp<>"" Then
                If MyArrayLen(a_RecipientsTo,1)>1 Then
                  ReDim Preserve a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)-1)
                Else
                  ReDim a_RecipientsTo(0)
                End If
              End If
            End If
          Next

        End If

        ' Check for recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If
      Next

    End If
  Next

End If


If InStr(s_Val,"RECIPIENTSCC,")>0 Then

  ' Now get the directory entry for the recipients
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for recipient
    If InStr(UCase(a_DIR(1,M_X)),"__RECIP_VERSION1.0_#")>0 Then

      ReDim Preserve a_RecipientsCC(MyArrayLen(a_RecipientsCC,1)+1)

      s_Temp=""

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If
        
        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_39FE")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsCC(MyArrayLen(a_RecipientsCC,1)-1)=s_String
        End If
      Next

      ' Get org email
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_403E")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsCC(MyArrayLen(a_RecipientsCC,1)-1)=s_String

        End If
      Next

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3001")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsCC(MyArrayLen(a_RecipientsCC,1)-1)=s_String

        End If
      Next

      ' Get recipient type and delete if wrong
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check if its in the TO list
        If InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 And a_Dir(7,M_Y)>0 Then

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat)
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          For M_Z=1 To Len(s_String) Step 8
            If Mid(s_String,M_Z,4)=MyHexToHexCoded("0300150C") Then
              If MyVBNumber(Mid(s_String,M_Z+8,1))<>2 And s_Temp<>"" Then
                If MyArrayLen(a_RecipientsCC,1)>1 Then
                  ReDim Preserve a_RecipientsCC(MyArrayLen(a_RecipientsCC,1)-1)
                Else
                  ReDim a_RecipientsCC(0)
                End If
              End If
            End If
          Next

        End If

        ' Check for recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If
      Next

    End If
  Next

End If


If InStr(s_Val,"RECIPIENTSBCC,")>0 Then

  ' Now get the directory entry for the recipients
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for recipient
    If InStr(UCase(a_DIR(1,M_X)),"__RECIP_VERSION1.0_#")>0 Then

      ReDim Preserve a_RecipientsBCC(MyArrayLen(a_RecipientsBCC,1)+1)

      s_Temp=""

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If
        
        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_39FE")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsBCC(MyArrayLen(a_RecipientsBCC,1)-1)=s_String
        End If
      Next

      ' Get org email
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_403E")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsBCC(MyArrayLen(a_RecipientsBCC,1)-1)=s_String

        End If
      Next

      ' Get recipient name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for recipient display name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        End If

        IF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3001")>0 And a_Dir(7,M_Y)>0 And s_Temp="" Then

          s_Temp="1"

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          ' Check if valid SMTP address
          If InStr(s_String,"@")<>0 Then
            s_String=Replace(s_String,"<","")
            s_String=Replace(s_String,">","")
            s_String=Replace(s_String,"'","")
          End If

          a_RecipientsBCC(MyArrayLen(a_RecipientsBCC,1)-1)=s_String

        End If
      Next

      ' Get recipient type and delete if wrong
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check if its in the TO list
        If InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 And a_Dir(7,M_Y)>0 Then

          ' Check if in short stream
          s_String=""
          If a_DIR(7,M_Y)<s_MinStream Then
            s_String=MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat)
          Else
            s_String=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

          For M_Z=1 To Len(s_String) Step 8
            If Mid(s_String,M_Z,4)=MyHexToHexCoded("0300150C") Then
              If MyVBNumber(Mid(s_String,M_Z+8,1))<>3 And s_Temp<>"" Then
                If MyArrayLen(a_RecipientsBCC,1)>1 Then
                  ReDim Preserve a_RecipientsBCC(MyArrayLen(a_RecipientsBCC,1)-1)
                Else
                  ReDim a_RecipientsBCC(0)
                End If
              End If
            End If
          Next

        End If

        ' Check for recipient email
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then
          Exit For
        End If
      Next

    End If
  Next

End If

If InStr(s_Val,"ATTACHMENTEXTRACT,")>0 Then

  ' Now get the directory entry for the attachments
  For M_X=0 To MyArrayLen(a_DIR,2)-1

    ' Check for attachment
    If InStr(UCase(a_DIR(1,M_X)),"__ATTACH_VERSION1.0_#")>0 Then

      ReDim Preserve a_AttachMents(MyArrayLen(a_AttachMents,1)+1)
      ReDim Preserve a_AttachMents2(MyArrayLen(a_AttachMents2,1)+1)

      ' Get attachment name
      For M_Y=M_X+1 To MyArrayLen(a_DIR,2)-1

        ' Check for attachment name
        If InStr(UCase(a_DIR(1,M_Y)),"__ATTACH_VERSION1.0_#")>0  Or InStr(UCase(a_DIR(1,M_Y)),"__RECIP_VERSION1.0_#")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__NAMEID_VERSION1.0")>0 Or InStr(UCase(a_DIR(1,M_Y)),"__PROPERTIES_VERSION1.0")>0 Then

          Exit For

        ElseIF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3701")>0 Then

          ' Check if in short stream
          If a_DIR(7,M_Y)<s_MinStream Then

            s_Temp=o_FSO.GetSpecialFolder(2) & o_FSO.GetTempName
            Set o_File=o_FSO.CreateTextFile(s_Temp,True,False)
            o_File.Write(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat))
            a_AttachMents(MyArrayLen(a_AttachMents,1)-1)=s_Temp
            o_File.Close

          Else

            a_AttachMents(MyArrayLen(a_AttachMents,1)-1)=MyLongSectorReader("FILE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)

          End If

        ElseIF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3704")>0 Then

          ' Check if in short stream
          If a_DIR(7,M_Y)<s_MinStream Then
            a_AttachMents2(MyArrayLen(a_AttachMents2,1)-1)=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            a_Attachments2(MyArrayLen(a_AttachMents2,1)-1)=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If

        ElseIF InStr(UCase(a_DIR(1,M_Y)),"__SUBSTG1.0_3707")>0 Then

          ' Check if in short stream
          If a_DIR(7,M_Y)<s_MinStream Then
            a_AttachMents2(MyArrayLen(a_AttachMents2,1)-1)=Replace(MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),a_SSAT,s_ShortSat),Chr(0),"")
          Else
            a_AttachMents2(MyArrayLen(a_AttachMents2,1)-1)=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_Y),a_Dir(7,M_Y),s_FileName,s_SAT)
          End If
        End If
      Next
    End If
  Next


  ' At this stage we have temporary filenames and an array of names
  ' We now need to:
  ' - Check for existing files
  ' - Rename the temporary files to the new names

  ' Delete files in temporary folder
  For M_X=0 To MyArrayLen(a_Attachments2,1)-1

    ' Check for existing files
    If o_FSO.FileExists(o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)) Then

      On Error Resume Next
      o_FSO.DeleteFile(o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X))
      On Error Goto 0

    End If

  Next

  ' Now rename attachments
  For M_X=0 To MyArrayLen(a_Attachments2,1)-1
    

    ' Check for existing files
    If o_FSO.FileExists(o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)) Then

      M_Y=1
      Do While o_FSO.FileExists(o_FSO.GetSpecialFolder(2) & "\" & M_Y & a_Attachments2(M_X))
        M_Y=M_Y+1
      Loop

      o_FSO.MoveFile a_Attachments(M_X),o_FSO.GetSpecialFolder(2) & "\" & M_Y & a_Attachments2(M_X)
      a_Attachments(M_X)=o_FSO.GetSpecialFolder(2) & "\" & M_Y & a_Attachments2(M_X)
      
    Else

      o_FSO.MoveFile a_Attachments(M_X),o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)
      a_Attachments(M_X)=o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)

    End If
    
  Next
End If

' The date sent
If InStr(s_Val,"DATESENT,")>0 Then

  s_Temp=""
  ' Now get the directory entry for the first properties
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__PROPERTIES_VERSION1.0")>0 And a_Dir(7,M_X)>0 Then
      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_Temp=MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat)
        Exit For
      Else
        s_Temp=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If
  Next

  ' Now we've got the properties lets read them
  For M_X=1 To Len(s_Temp) Step 16
    If Mid(s_Temp,M_X,4)=MyHexToHexCoded("40003900") Then
      s_DateSent=MyGregorianDate(MyVBNumber(Mid(s_Temp,M_X+8,8)))
    End If
  Next

End If

' The date received
If InStr(s_Val,"DATERECEIVED,")>0 Then

  s_Temp=""
  ' Now get the directory entry for the first properties
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__PROPERTIES_VERSION1.0")>0 And a_Dir(7,M_X)>0 Then
      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_Temp=MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat)
        Exit For
      Else
        s_Temp=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If
  Next

  ' Now we've got the properties lets read them
  s_DateReceived=""
  For M_X=1 To Len(s_Temp) Step 16
    If Mid(s_Temp,M_X,4)=MyHexToHexCoded("4000060E") Then
      s_DateReceived=MyGregorianDate(MyVBNumber(Mid(s_Temp,M_X+8,8)))
    End If
  Next

End If


' The date reply requested
If InStr(s_Val,"DATEREPLY,")>0 Then

  s_Temp=""
  ' Now get the directory entry for the first properties
  For M_X=0 To MyArrayLen(a_DIR,2)-1
    If InStr(UCase(a_DIR(1,M_X)),"__PROPERTIES_VERSION1.0")>0 And a_Dir(7,M_X)>0 Then
      ' Check if in short stream
      If a_DIR(7,M_X)<s_MinStream Then
         s_Temp=MyShortSectorReader(s_ShortSectSize,a_Dir(6,M_X),a_Dir(7,M_X),a_SSAT,s_ShortSat)
        Exit For
      Else
        s_Temp=MyLongSectorReader("VARIABLE",s_SectSize,a_Dir(6,M_X),a_Dir(7,M_X),s_FileName,s_SAT)
        Exit For
      End If

    End If
  Next

  ' Now we've got the properties lets read them
  s_DateReply=""
  For M_X=1 To Len(s_Temp) Step 16
    If Mid(s_Temp,M_X,4)=MyHexToHexCoded("40003000") Then
      s_DateReply=MyGregorianDate(MyVBNumber(Mid(s_Temp,M_X+8,8)))
    End If
  Next

End If

' Build the return string by checking what was asked for
a_Val=Split(s_Val,",")
s_Return=""
For M_X=0 To MyArrayLen(a_Val,1)-1

  If Len(Trim(a_Val(M_X)))<>0 Then
 
    If UCase(Trim(a_Val(M_X)))="SUBJECT" Then
      If s_Return="" Then
        If Len(s_Subject)>0 Then
          s_Return=s_Return & s_Subject
        Else
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_Subject
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="MESSAGEID" Then
      If s_Return="" Then
        If Len(s_MessageID)>0 Then
          s_Return=s_Return & s_MessageID
        Else
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_MessageID
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="FROM" Then
      If s_Return="" Then
        If Len(s_From)>0 Then
          s_Return=s_Return & s_From
        Else
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_From
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="PREFIX" Then
      If s_Return="" Then
        If Len(s_Prefix)>0 Then
          s_Return=s_Return & s_Prefix
        Else
          s_Return=" "
        End If
      Else
       s_Return=s_Return & "^" & s_Prefix
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="BODY" Then
      If s_Return="" Then
        If Len(s_Body)>0 Then
          s_Return=s_Return & s_Body
        Else
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_Body
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="ATTACHMENTNUMBERS" Then
      If s_Return="" Then
        If Len(s_AttachNums)>0 Then
          s_Return=s_AttachNums
        Else
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_AttachNums
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="ATTACHMENTNAMES" Then
      If s_Return="" Then
        For M_Y=0 To MyArrayLen(a_AttachNames,1)-1
          s_Return=s_Return & a_AttachNames(M_Y) & "|"
        Next
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^"
        For M_Y=0 To MyArrayLen(a_AttachNames,1)-1
          s_Return=s_Return & a_AttachNames(M_Y) & "|"
        Next
      End if
      If Right(s_Return,1)="|" Then
        s_Return=Left(s_Return,Len(s_Return)-1)
      End If
    End If

    If UCase(Trim(a_Val(M_X)))="RECIPIENTS" Then
      If s_Return="" Then
        For M_Y=0 To MyArrayLen(a_Recipients,1)-1
          s_Return=s_Return & a_Recipients(M_Y) & "|"
        Next
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^"
        For M_Y=0 To MyArrayLen(a_Recipients,1)-1
          s_Return=s_Return & a_Recipients(M_Y) & "|"
        Next
      End if
      If Right(s_Return,1)="|" Then
        s_Return=Left(s_Return,Len(s_Return)-1)
      End If
    End If

    If UCase(Trim(a_Val(M_X)))="RECIPIENTSTO" Then
      If s_Return="" Then
        For M_Y=0 To MyArrayLen(a_RecipientsTo,1)-1
          s_Return=s_Return & a_RecipientsTo(M_Y) & "|"
        Next
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^"
        For M_Y=0 To MyArrayLen(a_RecipientsTo,1)-1
          s_Return=s_Return & a_RecipientsTo(M_Y) & "|"
        Next
      End if
      If Right(s_Return,1)="|" Then
        s_Return=Left(s_Return,Len(s_Return)-1)
      End If
    End If

    If UCase(Trim(a_Val(M_X)))="RECIPIENTSCC" Then
      If s_Return="" Then
        For M_Y=0 To MyArrayLen(a_RecipientsCC,1)-1
          s_Return=s_Return & a_RecipientsCC(M_Y) & "|"
        Next
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^"
        For M_Y=0 To MyArrayLen(a_RecipientsCC,1)-1
          s_Return=s_Return & a_RecipientsCC(M_Y) & "|"
        Next
      End if
      If Right(s_Return,1)="|" Then
        s_Return=Left(s_Return,Len(s_Return)-1)
      End If
    End If

    If UCase(Trim(a_Val(M_X)))="RECIPIENTSBCC" Then
      If s_Return="" Then
        For M_Y=0 To MyArrayLen(a_RecipientsBCC,1)-1
          s_Return=s_Return & a_RecipientsBCC(M_Y) & "|"
        Next
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^"
        For M_Y=0 To MyArrayLen(a_RecipientsBCC,1)-1
          s_Return=s_Return & a_RecipientsBCC(M_Y) & "|"
        Next
      End if
      If Right(s_Return,1)="|" Then
        s_Return=Left(s_Return,Len(s_Return)-1)
      End If
    End If

    If UCase(Trim(a_Val(M_X)))="ATTACHMENTEXTRACT" Then
      If s_Return="" Then
        For M_Y=0 To MyArrayLen(a_Attachments,1)-1
          s_Return=s_Return & a_Attachments(M_Y) & "|"
        Next
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^"
        For M_Y=0 To MyArrayLen(a_Attachments,1)-1
          s_Return=s_Return & a_Attachments(M_Y) & "|"
        Next
      End if
      If Right(s_Return,1)="|" Then
        s_Return=Left(s_Return,Len(s_Return)-1)
      End If
    End If

    If UCase(Trim(a_Val(M_X)))="DATESENT" Then
      If s_Return="" Then
        s_Return=s_DateSent
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_DateSent
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="DATERECEIVED" Then
      If s_Return="" Then
        s_Return=s_DateReceived
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_DateReceived
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="DATEREPLY" Then
      If s_Return="" Then
        s_Return=s_DateReply
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_DateReply
      End if
    End If

    If UCase(Trim(a_Val(M_X)))="REPLYTYPE" Then
      If s_Return="" Then
        s_Return=s_ReplyType
        If Len(s_Return)=0 Then
          s_Return=" "
        End If
      Else
        s_Return=s_Return & "^" & s_ReplyType
      End if
    End If

  End IF
Next

MsgGet=s_Return

Set o_File=Nothing
Set o_FSO=Nothing
End Function


Function MyHexToHexCoded(s_String)
' **********************************************************************************
' Description : Takes a string such as "D0CF" and returns a HEX string which can be
'               compared with characters read from a file
' Created     : 24/12/2005
' Version     : 1.0
' **********************************************************************************
Dim M_X
Dim s_Temp

s_Temp=""
For M_X=1 To Len(s_String) Step 2
  s_Temp=s_Temp & Chr(CLng("&H" & Mid(s_String,M_X,2)))
Next
MyHexToHexCoded=s_Temp
End Function


Function MyVBNumber(s_String)
' **********************************************************************************
' Description : Takes chars read from file and converts to number
' Created     : 24/12/2005
' Version     : 1.0
' **********************************************************************************

MyVBNumber=0
If Len(s_String)=1 Then
  If Asc(Mid(s_String,1,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=254 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=253 Then
    MyVBNumber=-2
  ElseIf Asc(Mid(s_String,1,1))=252 Then
    MyVBNumber=-3
  ElseIf Asc(Mid(s_String,1,1))=251 Then
    MyVBNumber=-4
  Else
    MyVBNumber=Asc(Mid(s_String,1,1))
  End if
ElseIf Len(s_String)=2 Then
  If Asc(Mid(s_String,1,1))=255 And Asc(Mid(s_String,2,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=254 And Asc(Mid(s_String,2,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=253 And Asc(Mid(s_String,2,1))=255 Then
    MyVBNumber=-2
  ElseIf Asc(Mid(s_String,1,1))=252 And Asc(Mid(s_String,2,1))=255 Then
    MyVBNumber=-3
  ElseIf Asc(Mid(s_String,1,1))=251 And Asc(Mid(s_String,2,1))=255 Then
    MyVBNumber=-4
  Else
    MyVBNumber=Asc(Mid(s_String,1,1))+Asc(Mid(s_String,2,1))*256
  End if
ElseIf Len(s_String)=4 Then
  If Asc(Mid(s_String,1,1))=255 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=254 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=253 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 Then
    MyVBNumber=-2
  ElseIf Asc(Mid(s_String,1,1))=252 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 Then
    MyVBNumber=-3
  ElseIf Asc(Mid(s_String,1,1))=251 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 Then
    MyVBNumber=-4
  Else
    MyVBNumber=Asc(Mid(s_String,1,1))+Asc(Mid(s_String,2,1))*256+Asc(Mid(s_String,3,1))*65536+Asc(Mid(s_String,4,1))*16777216
  End If
ElseIf Len(s_String)=8 Then
  If Asc(Mid(s_String,1,1))=255 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 And Asc(Mid(s_String,5,1))=255 And Asc(Mid(s_String,6,1))=255 And Asc(Mid(s_String,7,1))=255 And Asc(Mid(s_String,8,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=254 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 And Asc(Mid(s_String,5,1))=255 And Asc(Mid(s_String,6,1))=255 And Asc(Mid(s_String,7,1))=255 And Asc(Mid(s_String,8,1))=255 Then
    MyVBNumber=-1
  ElseIf Asc(Mid(s_String,1,1))=253 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 And Asc(Mid(s_String,5,1))=255 And Asc(Mid(s_String,6,1))=255 And Asc(Mid(s_String,7,1))=255 And Asc(Mid(s_String,8,1))=255 Then
    MyVBNumber=-2
  ElseIf Asc(Mid(s_String,1,1))=252 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 And Asc(Mid(s_String,5,1))=255 And Asc(Mid(s_String,6,1))=255 And Asc(Mid(s_String,7,1))=255 And Asc(Mid(s_String,8,1))=255 Then
    MyVBNumber=-3
  ElseIf Asc(Mid(s_String,1,1))=251 And Asc(Mid(s_String,2,1))=255 And Asc(Mid(s_String,3,1))=255 And Asc(Mid(s_String,4,1))=255 And Asc(Mid(s_String,5,1))=255 And Asc(Mid(s_String,6,1))=255 And Asc(Mid(s_String,7,1))=255 And Asc(Mid(s_String,8,1))=255 Then
    MyVBNumber=-4
  Else
    MyVBNumber=Asc(Mid(s_String,1,1))+Asc(Mid(s_String,2,1))*256+Asc(Mid(s_String,3,1))*65536+Asc(Mid(s_String,4,1))*16777216+Asc(Mid(s_String,5,1))*4294967296+Asc(Mid(s_String,6,1))*1099511627776+Asc(Mid(s_String,7,1))*281474976710656+Asc(Mid(s_String,8,1))*72057594037927900
  End If
End If
End Function


Function MyArrayLen(MyArray,MyDim)
' *****************************************************************************
' Function    : MyArrayLen
' Arguments   : <MyArray> Array to get length of
'               <MyDim>   Dimension of array to test
' Returns     : Length of array
' Description : Returns the length of an array even if it is null or not
'               defined. UBound does not work on some types of variant array
'               so discovered best to use For Each when dimension 1 and UBound
'               for other dimensions.
' Created     : 20/10/2001 S Currie
' *****************************************************************************
Dim MyLength
MyLength  =0
On Error Resume Next
MyLength=UBound(MyArray,MyDim)
If MyLength<0 Then
  MyLength=0
End If
MyArrayLen=MyLength
End Function


Function MySectorReader(s_SectSize,s_SID,s_FileName)
' **********************************************************************************
' Description : Reads a number of characters from a particular sector in a file
' Arguments   : <s_SectSize>     The size of the sectors to be read
'               <s_SID>          The particluar sector to be read
'               <s_FileName>     The filename which they are to be read from
' Created     : 30/12/2005
' Version     : 1.0
' **********************************************************************************
Dim o_FSO
Dim o_File

' Create object and get the file
Set o_FSO=WScript.CreateObject("Scripting.FileSystemObject")

If Not o_FSO.FileExists(s_FileName) Then
  MySectorReader=""
  Exit Function
End If
If UCase(Right(s_Filename,4))<>".MSG" Then
  MySectorReader=""
  Exit Function
End If

Set o_File=o_FSO.OpenTextFile(s_FileName,1,-1)

' Now read up to the sector
o_File.Skip((s_SID*s_SectSize)+s_SectSize)

' Now read the sector itself
On Error Resume Next
MySectorReader=o_File.Read(s_SectSize)

o_File.Close
Set o_File=Nothing
Set o_FSO=Nothing

End Function

Function MyShortSectorReader(s_ShortSectSize,s_SID,s_Size,a_SSAT,s_ShortSat)
' **********************************************************************************
' Description : Reads a number of characters from the short sector container which
'               is held in the memory variable s_ShortSat. The a_SSAT is a directory
'               array which tell you how to access the s_ShortSat
' Arguments   : <s_ShortSectSize>     The size of the sectors to be read
'               <s_SID>               The particluar sector to be read within s_ShortSat
'               <s_Size>              The size of the value to return
'               <a_SSAT>              The array which contains the details of how to
'                                     access the s_ShortSat
'               <s_ShortSat>          This is the short container stream read from
'                                     the file
' Created     : 31/12/2005
' Version     : 1.0
' **********************************************************************************
Dim M_Y
Dim s_Temp

M_Y=s_SID
s_Temp=Mid(s_ShortSat,s_SID*s_ShortSectSize+1,s_ShortSectSize)

Do While True
  M_Y=a_SSAT(M_Y)
  If M_Y>0 Then
    s_Temp=s_Temp & Mid(s_ShortSat,M_Y*s_ShortSectSize+1,s_ShortSectSize)
  End If
  If Len(s_Temp)>=s_Size Then
    Exit Do
  End If
Loop
MyShortSectorReader=Mid(s_Temp,1,s_Size)
End Function

Function MyLongSectorReader(s_ReturnType,s_SectSize,s_SID,s_Size,s_FileName,s_SAT)
' **********************************************************************************
' Description : Reads a number of characters from the short sector container which
'               is held in the memory variable s_ShortSat. The a_SSAT is a directory
'               array which tell you how to access the s_ShortSat
' Arguments   : <
'               <s_SectSize>          The size of the sectors to be read
'               <s_SID>               The particluar sector to be read within s_ShortSat
'               <s_Size>              The size of the value to return
'               <a_SSAT>              The array which contains the details of how to
'                                     access the s_ShortSat
'               <s_ShortSat>          This is the short container stream read from
'                                     the file
' Created     : 31/12/2005
' Version     : 1.0
' **********************************************************************************
Dim M_Y
Dim s_Temp
Dim o_FSO
Dim o_File
Dim M_X
Dim s_Start
Dim s_Previous
Dim s_Sects

M_X=s_Size
MyLongSectorReader=""
If s_ReturnType="FILE" Then

  ' Create object and the file
  Set o_FSO=WScript.CreateObject("Scripting.FileSystemObject")

  s_Temp=o_FSO.GetSpecialFolder(2) & "\" & o_FSO.GetTempName
  Set o_File=o_FSO.CreateTextFile(s_Temp,True,False)

  M_Y=s_SID
  o_File.Write(MySectorReader(s_SectSize,M_Y,s_FileName))
  M_X=M_X-s_SectSize

  s_Previous=-99
  s_Sects=0
  s_Start=0
  Do While True

    M_Y=MyVBNumber(Mid(s_Sat,(M_Y*4)+1,4))

    If s_Previous = M_Y-1 Then

      s_Previous=M_Y
      s_Sects=s_Sects+1

    ElseIf s_Previous <> M_Y-1 Then

      If s_Sects>0 Then

        M_X=M_X-(s_SectSize*s_Sects)
        o_File.Write(MyMultiSectorReader(s_SectSize,s_Start,s_FileName,s_Sects))

      End If

      s_Previous=M_Y
      s_Sects=1
      s_Start=M_Y

    End If

    If M_X<=0 Then
      Exit Do
    End If

  Loop

  o_File.Close

ElseIf s_ReturnType="VARIABLE" Then

  M_Y=s_SID
  s_Temp=MySectorReader(s_SectSize,M_Y,s_FileName)

  Do While True

    M_Y=MyVBNumber(Mid(s_Sat,(M_Y*4)+1,4))
    If M_Y>0 Then
      s_Temp=s_Temp & MySectorReader(s_SectSize,M_Y,s_FileName)
    End If
    If Len(s_Temp)>=s_Size Then
      Exit Do
    End If
  Loop

  s_Temp=Mid(s_Temp,1,s_Size)

End if
MyLongSectorReader=s_Temp
End Function

Function MyMultiSectorReader(s_SectSize,s_SID,s_FileName,s_Number)
' **********************************************************************************
' Description : Reads a number of characters from a particular sector in a file
' Arguments   : <s_SectSize>     The size of the sectors to be read
'               <s_SID>          The particluar sector to be read
'               <s_FileName>     The filename which they are to be read from
'               <s_Number>       The number of sectors to read
' Created     : 01/01/2006
' Version     : 1.0
' **********************************************************************************
Dim o_FSO
Dim o_File

' Create object and get the file
Set o_FSO=WScript.CreateObject("Scripting.FileSystemObject")

If Not o_FSO.FileExists(s_FileName) Then
  MyMultiSectorReader=""
  Exit Function
End If
If UCase(Right(s_Filename,4))<>".MSG" Then
  MyMultiSectorReader=""
  Exit Function
End If

Set o_File=o_FSO.OpenTextFile(s_FileName,1,-1)

' Now read up to the sector
o_File.Skip((s_SID*s_SectSize)+s_SectSize)

' Now read the sector itself
On Error Resume Next
MyMultiSectorReader=o_File.Read(s_SectSize*s_Number)

o_File.Close
Set o_File=Nothing
Set o_FSO=Nothing
End Function

Function MyGregorianDate(l_Val)
' **********************************************************************************
' Description : Returns a date from a property tag in Outlook properties
' Arguments   : <l_Val>     The VB number to convert
' Created     : 03/02/2007
' Version     : 1.0
' **********************************************************************************
Dim l_FracSecs
Dim l_RemSecs
Dim l_Secs
Dim l_RemMins
Dim l_Mins
Dim l_RemHours
Dim l_Hours
Dim l_RemDays
Dim l_Year
Dim l_RemDays2

l_FracSecs=((l_val/10000000)-INT(l_val/10000000))*10000000
l_RemSecs=l_Val/10000000
l_Secs=Round(((l_RemSecs/60)-INT(l_RemSecs/60))*60,0)
l_RemMins=Int(l_RemSecs/60)
l_Mins=Round(((l_RemMins/60)-INT(l_RemMins/60))*60,0)
l_RemHours=INT(l_RemMins/60)
l_Hours=Round(((l_RemHours/24)-INT(l_RemHours/24))*24,0)
l_RemDays=INT(l_RemHours/24)
l_Year=1601+INT(l_RemDays/365)
l_RemDays2=109572+DateSerial(l_Year,1,1)-DateSerial(1901,1,1)
MyGregorianDate=DateAdd("d",l_RemDays-l_RemDays2,"01/01/" & l_Year)
MyGregorianDate=DateAdd("h",l_Hours,MyGregorianDate)
MyGregorianDate=DateAdd("n",l_Mins,MyGregorianDate)
MyGregorianDate=DateAdd("s",l_Secs,MyGregorianDate)

If Year(MyGregorianDate)<1902 Then
  MyGregorianDate=""
End If
End Function


Function MySubRead(l_Left,l_Right,a_Dir,a_Temp)
' **********************************************************************************
' Description : Reads a directory structure backwards and forwards
' Arguments   : <l_Val>     The directory entry
' Created     : 23/02/2007
' Version     : 1.0
' **********************************************************************************
Dim M_X

For M_X=0 To MyArrayLen(a_Dir,2)-1

  If a_Dir(0,M_X)=l_Left Then


      If a_Dir(3,M_X)<>-1 Then
        MySubRead a_Dir(3,M_X),-1,a_Dir,a_Temp
      End If

    If a_Dir(5,M_X)=-1 Then

      ' Add to final array
      ReDim Preserve a_Temp(8,MyArrayLen(a_Temp,2)+1)

      a_Temp(0, MyArrayLen(a_Temp,2)-1)=a_Dir(0,M_X)
      a_Temp(1, MyArrayLen(a_Temp,2)-1)=a_Dir(1,M_X)
      a_Temp(2, MyArrayLen(a_Temp,2)-1)=a_Dir(2,M_X)
      a_Temp(3, MyArrayLen(a_Temp,2)-1)=a_Dir(3,M_X)
      a_Temp(4, MyArrayLen(a_Temp,2)-1)=a_Dir(4,M_X)
      a_Temp(5, MyArrayLen(a_Temp,2)-1)=a_Dir(5,M_X)
      a_Temp(6, MyArrayLen(a_Temp,2)-1)=a_Dir(6,M_X)
      a_Temp(7, MyArrayLen(a_Temp,2)-1)=a_Dir(7,M_X)

    End If

  End If


Next

For M_X=0 To MyArrayLen(a_Dir,2)-1

  If a_Dir(0,M_X)=l_Left Then

      If a_Dir(4,M_X)<>-1 Then
        MySubRead -1,a_Dir(4,M_X),a_Dir,a_Temp
      End If

  End If

Next

For M_X=0 To MyArrayLen(a_Dir,2)-1

  If a_Dir(0,M_X)=l_Right Then


      If a_Dir(3,M_X)<>-1 Then
        MySubRead a_Dir(3,M_X),-1,a_Dir,a_Temp
      End If

    If a_Dir(5,M_X)=-1 Then
      ' Add to final array
      ReDim Preserve a_Temp(8,MyArrayLen(a_Temp,2)+1)

      a_Temp(0, MyArrayLen(a_Temp,2)-1)=a_Dir(0,M_X)
      a_Temp(1, MyArrayLen(a_Temp,2)-1)=a_Dir(1,M_X)
      a_Temp(2, MyArrayLen(a_Temp,2)-1)=a_Dir(2,M_X)
      a_Temp(3, MyArrayLen(a_Temp,2)-1)=a_Dir(3,M_X)
      a_Temp(4, MyArrayLen(a_Temp,2)-1)=a_Dir(4,M_X)
      a_Temp(5, MyArrayLen(a_Temp,2)-1)=a_Dir(5,M_X)
      a_Temp(6, MyArrayLen(a_Temp,2)-1)=a_Dir(6,M_X)
      a_Temp(7, MyArrayLen(a_Temp,2)-1)=a_Dir(7,M_X)

    End If

  End If

Next

For M_X=0 To MyArrayLen(a_Dir,2)-1

  If a_Dir(0,M_X)=l_Right Then


      If a_Dir(4,M_X)<>-1 Then
        MySubRead -1,a_Dir(4,M_X),a_Dir,a_Temp
      End If

  End If

Next
End Function
All 27comments
Page [ 1 2 3 Next >>  
  04-Apr-2007  18:08   
Cool!
  11-Apr-2007  01:38   
spectacular. any chance you've got this in a .net version?
  30-Apr-2007  04:45   
You saved my day!
  30-Apr-2007  13:08   
Don't have a .Net version but was thinking of doing a Monash/PowerShell version which would be transportable across XP/Vista.

Have done a minor update to fix the detection of flags on emails in Outlook 2000 as they seem to be stored in a random short message storage stream.

Anyway glad it assists, goes to prove that the Compound Message format is easy to decode when you put your mind to it!
  06-Jun-2007  00:29   
Can You explain what does this part of code intend to do? To be specific ,pls tel what does the the hexcode value "0300150C" represents and what is been checked in this statement "If MyVBNumber(Mid(s_String,M_Z+8,1))<>1 And s_Temp<>"" " from the code snippet.



For M_Z=1 To Len(s_String) Step 8
            If Mid(s_String,M_Z,4)=MyHexToHexCoded("0300150C") Then
              If MyVBNumber(Mid(s_String,M_Z+8,1))<>1 And s_Temp<>"" Then
                If MyArrayLen(a_RecipientsTo,1)>1 Then
                  ReDim Preserve a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)-1)
                Else
                  ReDim a_RecipientsTo(0)
                End If
              End If
            End If
          Next


Thanks in Advance.
 
  06-Jun-2007  15:10   
----If Mid(s_String,M_Z,4)=MyHexToHexCoded("0300150C") Then

The above piece of code does the magic of checking each recipient properties:

"__recip_version1.0_#00000000" is the sub storage area within the MSG stream

within this there is a field called:

"_properties_version1.0" which is a hex value

This is a hex coded string which is split into 4 byte parts.

The code goes through the string looking for a HEX sequence of "03 00 15 0C"

The next byte says whether it is a TO, CC or BCC recipient address

The code:

---- If MyVBNumber(Mid(s_String,M_Z+8,1))<>1 And s_Temp<>"" then
assumes that the TO address has already been added to the a_RecipientsTo array way back in:

          a_RecipientsTo(MyArrayLen(a_RecipientsTo,1)-1)=s_String

This code then says is the address REALLY a TO address (i.e. we added it earlier and didn't
really know if it was a TO address)

The code:

---- If MyVBNumber(Mid(s_String,M_Z+8,1))<>1 And s_Temp<>"" Then
checks if it is really a TO address and if it is not it truncates the array by one
effecively removing the wrong address.

s_Temp is a global variable basically meaning in "this recipient" we found a valid
address (but we don't know until checking the byte after 03 00 15 0C that it really is
a TO address.

Convoluted code, but then so it the MSG file format!
  20-Jun-2007  03:17   
The code is really great. I was very helpful for my project (I'm working on an Msg-Viewer, coded with c#). It finally works quite well but the biggest problem I still have is to find out the correct position of each attachment in the mail body. At first I tried to use the sequence as it is stored at the msg-file, but this is not always the correct one. I seems the outlook is storing the attachment in the same sequence as you add it to the msg-file. I read at the internet that there is a property the find out the position of the attachment in the mail body but I couldn't find so I assume that it is stored somewhere at the property (also attachments have one). Does somebody knows where to find and how to decode this information. I'm really wondering how Sean could find out the decoding info for the mail properties - I guess there are even more inside (e.g. priority, ..). I'm also interested in this. Thanks in advance - Soeren
  21-Jun-2007  07:03   
Soeren,

Would be interested in seeing your message viewer. I take it you know there was an MSG viewer with VB6 called the "Compound Document Viewer" with which you could view MSG files. I don' think there was sourcecode with it. There are better things in C# to decode MSG files with than using binary file analysis such as using the IStorage interface. I decoded it mainly using the compound document viewer and Outlook spy. One problem is that the directory structure is stored randomly in the MSG file and you need to re-organise the directory before reading the file. See the piece of code in my VBS called "MySubRead" which re-organises the directory structure in the correct order. Using OutlookSpy you can determine whether the property you want is in the _Properties tag or is separately stored.
The tag you are after is "Importance" hex value 0x17 2=High 1=Normal. Sean.
  25-Jun-2007  03:24   
Thank you for this information. The Outlook Spy was helping me very much to get a better understanding of the msg-file format. As soon as we developed a first stable version I will publish it (we intend to sell it, but for private usage we want to make it free - also the sources).
Soeren.
PS: is there a possibility on this page to upload a Visual Studio project or some screen shots ?
  25-Jun-2007  07:34   
Soeren, no, this site doesn't provide the capability to upload files, and we're not planning to add that capability any time soon. Maybe it's time for you to start blogging! I know a lot of people will be interested to see your results.
Page [ 1 2 3 Next >>