Re: 40tude Dialog: Export Script for current group or folder (including Sent)

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.