-
Jan 16th, 2022, 05:43 PM
#1
Thread Starter
Frenzied Member
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
-
Jan 16th, 2022, 07:29 PM
#2
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
-
Jan 16th, 2022, 07:36 PM
#3
Thread Starter
Frenzied Member
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.
-
Jan 16th, 2022, 09:59 PM
#4
Thread Starter
Frenzied Member
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
-
Jan 17th, 2022, 05:52 AM
#5
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.
-
Jan 17th, 2022, 04:03 PM
#6
Thread Starter
Frenzied Member
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|