Results 1 to 6 of 6

Thread: Fairly long shot question

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2010
    Posts
    1,462

    Fairly long shot question

    This isn't totally VB6 but something VB6 could be used for. Sorry if too offtopic but maybe someone has done this or has some knowledge about it.

    I 'd like to extract text attachments from Thunderbird email.
    I've copied the mail folder to another location and can see The headers etc. in HexEditor.
    I know there's 22 messages and each has a small text attachment.
    So far I can't find anything to identify the Start-End of each message and parts of it look encoded.

    Can anyone help with this and how to decode? Thanks

  2. #2
    Frenzied Member
    Join Date
    Jun 2015
    Posts
    1,053

    Re: Fairly long shot question

    If I recall Thunderbird supports a plug-in framework probably in JavaScript. That would be the easiest place to start. If you really want to parse the raw toc file thunderbird is open source I’m sure you can grab the structures from there and convert to vb but it will be some work

  3. #3

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2010
    Posts
    1,462

    Re: Fairly long shot question

    Thanks, but I don't know Javascript and it may be a bridge too far for me.
    There is an Add-On (Filtaquilla) that Google says will do what I want, but I installed it and couldn't get it to work.
    I'll keep plugging away, I can probably id the start.end of msgs but will be stumped over what encoding method.

  4. #4

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2010
    Posts
    1,462

    Re: Fairly long shot question

    I have succeeded... a bit of a hack extracting the base64 encoded section but then decoded with advice here

    https://www.linkedin.com/pulse/excel...cle-card_title

  5. #5
    PowerPoster yereverluvinuncleber's Avatar
    Join Date
    Feb 2014
    Location
    Norfolk UK (inbred)
    Posts
    2,235

    Re: Fairly long shot question

    You could share your code/solution so others may benefit or at least see it?
    https://github.com/yereverluvinunclebert

    Skillset: VMS,DOS,Windows Sysadmin from 1985, fault-tolerance, VaxCluster, Alpha,Sparc. DCL,QB,VBDOS- VB6,.NET, PHP,NODE.JS, Graphic Design, Project Manager, CMS, Quad Electronics. classic cars & m'bikes. Artist in water & oils. Historian.

    By the power invested in me, all the threads I start are battle free zones - no arguing about the benefits of VB6 over .NET here please. Happiness must reign.

  6. #6

    Thread Starter
    Frenzied Member
    Join Date
    Jun 2010
    Posts
    1,462

    Re: Fairly long shot question

    Oh, OK. I didn't think it worthy of sharing. Extracting the base64 section is very primitive and could be better. Also the format may be dependent on my ISP or POP3 spec.
    Code:
    Private Sub cmdUpdates_Click()
         'Write email text attachments to Folder
        On Error GoTo Err_Tel
        Dim fname As String
        Dim theData As Variant
        Dim ff As Integer
        Dim i As Integer
        Dim x As Integer
        Dim y As Integer
        Dim Dat As String
        Dim DestName As String
        Dim Log As String
        Dim Done As Integer
         
         'This is the Thunderbird Mail Folder & File
        fname = "C:\Users\Test\AppData\Roaming\Thunderbird\Profiles\98v8wen0.default\Mail\pop3.orcon.net.nz\Updates"
        ff = FreeFile
        
            Open fname For Input As #ff
                theData = Input(LOF(ff), ff)
            Close #ff
           
        theData = Split(theData, "Content-Type:MIME-Version:X-MS-Exchange-AntiSpam-MessageData-ChunkCount:X-MS-Exchange-AntiSpam-MessageData-0:X-MS-Exchange-AntiSpam-MessageData-1")
        If MsgBox("Found " & UBound(theData) & " emails", vbYesNo + vbQuestion, "Process Attachements") = vbYes Then
    
            For i = 1 To UBound(theData)
                x = InStr(theData(i), "Content-Disposition: attachment; filename=")
                Dat = Mid(theData(i), x + 33)
                DestName = ExtractName(Left(Dat, 30))
                x = InStr(Dat, ": base64")
                Dat = Mid(Dat, x + 9)
                y = InStr(Dat, "--_004_")
                Dat = Mid(Dat, 1, y - 1)
                Dat = Replace(Dat, Chr$(10), "")
                Dat = Replace(Dat, Chr$(13), "")
                Dat = DecodeBase64(Dat)
               Open "J:\Imail\T\Imports\" & DestName For Output As #ff
                    Print #ff, Dat
               Close #ff
               Done = Done + 1
    icont:
            Next
            Log = Done & " files Done" & vbCrLf & Log
            MsgBox Log
        End If
        
        Exit Sub
    Err_Tel:
        If Err = -2147024809 Then
                Log = Log & "Could not process " & DestName & vbCrLf
                Resume icont
            Else
                MsgBox Err & vbCrLf & Err.Description
                Resume Next
        End If
    End Sub
    
    Function DecodeBase64(b64$)
        Dim b
        With CreateObject("Microsoft.XMLDOM").createElement("b64")
            .DataType = "bin.base64": .Text = b64
            b = .nodeTypedValue
            With CreateObject("ADODB.Stream")
                .Open: .Type = 1: .Write b: .Position = 0: .Type = 2: .Charset = "utf-8"
                DecodeBase64 = .ReadText
                .Close
            End With
        End With
    End Function
    
    Function ExtractName(s) As String
        On Error GoTo err_e
        Dim i As Integer
        i = InStr(s, Chr$(34))
        s = Mid(s, i + 1)
        i = InStr(s, Chr$(34))
        ExtractName = Left(s, i - 1)
        Exit Function
    err_e:
    End Function
    I did find error -2147024809 (some kind of parsing error) was present on one of the first 50 I did). Couldn't see what nor what was different about it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width