PureBasic Forums - English

Code: Select all

 Global HeaderOffset.l
 
 Structure MHT_Extract
  ContentType.s
  ContentEncoding.s
  OffsetStart.l
 EndStructure
 
 Global NewList Mappings.MHT_Extract()
 
 ProcedureDLL MHT_Extract(File.s,Path.s)
  
  If ReadFile(0,File.s)
   
   CurrentLine = 1
   Repeat
    Line.s = Trim(ReadString(0))
    HDstring.s = LCase(Trim(StringField(Line,1,":")))
    If HDstring = "from"
     HeaderComplete + 1
    EndIf
    If HDstring = "this is a multi-part message in mime format."
     HeaderComplete + 1
    EndIf
    If FindString(RemoveString(HDstring,Chr(32),1),"boundary",0)
     Boundary.s = StringField(Line,3,"=")
     Boundary.s = Left(Boundary,Len(Boundary)-1)
     HeaderComplete + 1
    EndIf

    If CurrentLine = 12
     ProcedureReturn -1 ;This is not a valid file
    EndIf
    CurrentLine + 1            ;This is a kind of a timeout, if we don't find
                               ;the data we need in the first 12 lines, there's
                               ;no use to continue to parse the file.
   Until HeaderComplete = 3 
   

   ;Now start mapping out the crap inside the file
   While Not Eof(0)
    Line.s = ReadString(0)
    BoundaryCalc.s = Trim(StringField(Line,2,"="))
    If BoundaryCalc = Trim(Boundary)
     
     Repeat
      Str.s = ReadString(0)
      BoundaryCalc2.s = Trim(StringField(Str,2,"="))
      Select LCase(StringField(Str,1,":"))
       Case "content-type"
        CType.s = Trim(StringField(StringField(Str,2,":"),1,"/"))
       Case "content-transfer-encoding"
        CEnc.s = Trim(LCase(StringField(Str,2,":")))
       Default
        ;Nothing here
      EndSelect
      CurrentLine + 1
     Until Str = ""
     
     If CEnc.s = "base64"
      AddElement(Mappings())
      Mappings()\OffsetStart       = CurrentLine
      Mappings()\ContentType       = CType.s
      Mappings()\ContentEncoding.s = CEnc.s
     EndIf
     
    EndIf
    CurrentLine + 1
   Wend

   ForEach Mappings()
    FileSeek(0,0)
    For Run = 1 To Mappings()\OffsetStart
     ReadString(0)
    Next
    Repeat
     Line.s = Trim(ReadString(0))
     Data64.s + Line
    Until Trim(Line) = ""
    
    If CreateFile(1,Path+Str(FilesExt)+"."+Mappings()\ContentType)
     Data64Len = Len(Data64)
     EstimatedLength = Int(1.35 * Data64Len)
     *Depacked = AllocateMemory(EstimatedLength)
     FinalLength = Base64Decoder(@Data64,Data64Len,*Depacked,EstimatedLength)
     WriteData(1,*Depacked,FinalLength)
     CloseFile(1)
     Data64 = ""
     FilesExt + 1
    EndIf

   Next
  
  EndIf
 
 EndProcedure