Supersede for message from 2024-05-10 08:58:18 +0200
corrected typo in message box text
added a bit more detail to some comments for better understanding
-----------------------------------------------------------------------------
This morning I came up with some ideas to improve the script. The following version should be a bit more robust and versatile. Creation of *.mbox files
now is the default. Settings are adjusted to ensure best re-import into
40tude Dialog. Other programs may need other settings.
Compilation will issue a warning when FullEscape is set to True in the Const section of the script. This is intended behavior and can safely be ignored.
Bernd
-----------------------------------------------------------------------------
// =================================================================
// Export messages from current Dialog group or folder to text file.
// =================================================================
//
// View and filter settings are respected. Collapsed threads are
// (temporarily) expanded to include all messages.
//
// Empty messages (= without body etc.) are skipped. If the last
// message in the Headers pane of the current group/folder is empty,
// the export is likely to be incomplete. (Export stops then at the
// first _other_ message without body.)
//
// Appropriate message viewing options should be activated before
// executing the script (= "text/plain" with "Show all Headers" or
// "Raw message view" activated or off).
//
// Script settings should be adjusted below (= in the Const section
// of the script; esp. FilePath and MBox.
Program ExportMessages;
Uses
StdCtrls, Forms, Textfile;
Const
// ============================================================================ // Edit Script settings here if necessary:
// ============================================================================
SeeProgress = True; // False: Display updates are disabled
// (faster, but somewhat intrasparent)
FilePath = 'C:\Temp\'; // include backslash last character
FileNamePrefix = '4D_';
FileExtension = '.mbox'; // include leading dot character
MBox = True; // True: try to write *.mbox-compatible file
// *.mbox comes in different varieties; Dialog needs the following
// option set to True for successful re-import:
FullEscape = True; // don't require empty previous line to escape "From "
// The following settings are ignored when [MBox = True] is set:
DividerChar = '='; // print a whole line with DividerChar between messages;
// (use ' ' for omitting the printing of divider lines;
// in this case, EmptyRows will only be applied once)
EmptyRows = 1; // number of empty rows prior and after each divider line // ============================================================================ // End of editable Script settings section
// ============================================================================
Var
iCount: Integer;
iCountEmpty: Integer;
bFirst: Boolean;
bLastIsEmpty: Boolean;
bToggleRaw: Boolean;
sGroupName: String;
sFileName: String;
sDateTime: String;
sDivider: String;
txtForm: TForm;
txtMemo: TMemo;
txtMemo_Last: TMemo;
txtMemo_Print: TMemo;
sMsg: String;
Function EmptyClipboard:boolean; external '
EmptyClipboard@user32.dll stdcall'; Function OpenClipboard(hWndNewOwner: INTEGER):boolean; external '
OpenClipboard@user32.dll stdcall';
Function CloseClipboard:boolean; external '
CloseClipboard@user32.dll stdcall';
Procedure ClearClipboard;
Begin
OpenClipboard(0);
EmptyClipboard;
CloseClipboard;
end;
Procedure InitMemos;
Begin
txtForm := TForm.Create(Nil);
txtMemo := TMemo.Create(txtForm);
txtMemo.Parent := txtForm;
txtMemo.Width := 30000; // max [pixels] (reduces auto-wrap for long lines)
txtMemo_Last := TMemo.Create(txtForm);
txtMemo_Last.Parent := txtForm;
txtMemo_Last.Width := 30000;
txtMemo_Print := TMemo.Create(txtForm);
txtMemo_Print.Parent := txtForm;
txtMemo_Print.Width := 30000;
End;
Procedure CheckSetMBox;
Var
iCnt1: Integer;
iCnt2: Integer;
Begin
iCnt1 := txtMemo_Last.Lines.Count
If sGroupName = 'Sent'
Then ADo('ShowHeaders') // folder Sent doesn't support RawView
Else ADo('RawView');
ADo('SelectAll');
ClearClipboard;
Ado('Copy');
txtMemo_Last.Clear;
txtMemo_Last.PasteFromClipboard;
iCnt2 := txtMemo_Last.Lines.Count
// If RawView wasn't active, then toggling it (in this case: switching it on)
// should have added a couple of Header lines to the view:
bToggleRaw := iCnt1 + 3 < iCnt2
If Not bToggleRaw Then // restore previous RawView state
Begin
If sGroupName = 'Sent'
Then ADo('ShowHeaders')
Else ADo('RawView');
ADo('SelectAll');
ClearClipboard;
Ado('Copy');
txtMemo_Last.Clear;
txtMemo_Last.PasteFromClipboard;
End;
End;
Function DividerLines(): String;
var
iCnt: Integer;
sTmp: String;
Begin
If MBox Then
Result := #13 + #10
Else
Begin
For iCnt := 1 To EmptyRows Do
sTmp := sTmp + #13 + #10;
If DividerChar = ' ' Then
Result := sTmp + #13 + #10
Else
Result := sTmp + StringOfChar(DividerChar, 80) + sTmp + #13 + #10;
End;
End;
Function GetGroupName(): String;
Var
sTmp: String;
iPos: Integer;
Begin
ADo('NewgroupPane');
ClearClipboard;
ADo('Copy');
txtMemo.Clear;
txtMemo.PasteFromClipboard;
sTmp := txtMemo.Lines[0];
Repeat
iPos := Pos(#09, sTmp);
sTmp := Copy(sTmp, iPos + 1, Length(sTmp) - iPos);
Until iPos = 0;
Result := sTmp;
End;
Procedure InitPrintMemo;
Var
iRow: Integer;
iCnt: Integer;
iLength: Integer;
bEmpty: Boolean;
sPrefix: String;
sFrom: String;
sDate: String;
Begin
txtMemo_Print.Text := txtMemo.Text;
If MBox Then
Begin
bEmpty := False;
// Escape all occurrences that might (falsely) interpreted as an
// Envelope-From inside the message body
For iRow := 0 To txtMemo.Lines.Count - 1 Do
Begin
iLength := Length(txtMemo.Lines[iRow]);
If (bEmpty Or FullEscape) And (iLength > 4) Then
For iCnt := iLength - 4 DownTo 0 Do
Begin
sPrefix := StringOfChar('>', iCnt) + 'From '
If Pos(sPrefix, txtMemo.Lines[iRow]) = 1 Then
Begin
txtMemo_Print.Lines[iRow] := '>' + txtMemo.Lines[iRow];
Break;
End;
End;
bEmpty := iLength = 0;
End;
// Try to recreate an Envelope-From for the message:
For iRow := 0 To txtMemo.Lines.Count - 1 Do
If Pos('From: ', txtMemo.Lines[iRow]) = 1 Then
Begin
sFrom := txtMemo.Lines[iRow];
sFrom := 'From ' + Copy(sFrom, 7, Length(sFrom) - 6);
Break;
End;
For iRow := 0 To txtMemo.Lines.Count - 1 Do
If Pos('Date: ', txtMemo.Lines[iRow]) = 1 Then
Begin
sDate := txtMemo.Lines[iRow];
sDate := Copy(sDate, 7, Length(sDate) - 6);
Break;
End;
txtMemo_Print.Lines.Insert(0, sFrom + ' ' + sDate);
End;
End;
Procedure WriteTxtFile;
Var
txtFile: TextFile;
Begin
AssignFile(txtFile, sFileName);
If FileExists(sFileName)
Then Append(txtFile)
Else Rewrite(txtFile);
If Not bFirst Then TextWrite(txtFile, sDivider);
InitPrintMemo;
TextWrite(txtFile, txtMemo_Print.text);
CloseFile(txtFile);
End;
Begin
InitMemos;
iCount := 0;
iCountEmpty := 0;
bFirst := True;
sDivider := DividerLines();
sGroupName := GetGroupName();
If Not SeeProgress Then LockDisplay;
sDateTime := FormatDateTime('yyyymmdd_hhnn', Now);
sFileName := FilePath + FileNamePrefix + sGroupName + '_' + sDateTime + FileExtension;
txtMemo.Clear;
txtMemo.Lines.Add(StringOfChar('º', 20) + ' DUMMY ' + StringOfChar('º', 20));
Try
ADo('ExpandAllThreads');
ADo('ArticlePane');
ADo('LastMessage');
ADo('SelectAll');
ClearClipboard;
Ado('Copy');
txtMemo_Last.Clear;
txtMemo_Last.PasteFromClipboard;
If MBox Then CheckSetMBox;
bLastIsEmpty := txtMemo_Last.Lines.Count = 0;
If bLastIsEmpty Then
txtMemo_Last.Lines.Add(StringOfChar('º', 20) + ' EMPTY MESSAGE ' + StringOfChar('º', 20));
ADo('FirstMessage');
While txtMemo.Text <> txtMemo_Last.Text Do
Begin
If Not bFirst Then ADo('NextMessage');
ADo('SelectAll');
ClearClipboard;
Ado('Copy');
txtMemo.Clear;
txtMemo.PasteFromClipboard;
If txtMemo.Lines.Count = 0 Then
Begin
txtMemo.Lines.Add(StringOfChar('º', 20) + ' EMPTY MESSAGE ' + StringOfChar('º', 20));
iCountEmpty := iCountEmpty + 1;
End
Else
WriteTxtFile;
iCount := iCount + 1;
bFirst := False;
End;
Finally
// Clean up (Expanded thread state likely differs from start situation,
// but the thread list should at least look reasonably tidy...)
ADo('CollapseAllThreads');
ADo('FirstMessage');
If bToggleRaw Then
If sGroupName = 'Sent'
Then ADo('ShowHeaders')
Else ADo('RawView');
UnlockDisplay;
txtForm.Free;
End;
sMsg := IntToStr(iCount) + ' message(s) exported to: ' + #10 + sFileName;
sMsg := sMsg + #10+#10 + IntToStr(iCountEmpty) + ' empty message(s) [= without body etc.] skipped.';
Application.MessageBox(sMsg, 'Export finished', 0);
If bLastIsEmpty Then
Begin
sMsg := 'Please note: Last message in list was empty.' + #10 + 'Therefore, the export is probably incomplete.';
Application.MessageBox(sMsg, 'Warning!', 1);
End;
End.
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)