Reply2all

From 40tude Dialog Wiki

Please read the Postkey script warning page before trying out this script.

Contents

Reply2all

Adds the ability to reply to all recipients (To, CCs etc.) of an E-Mail message.


Installation

Copy the script below and paste it as 'Custom Script'. Use 'Show Button Config' to assign a shortcut - preferably <Shift>R.

Configuration

Edit the script in the procedure 'SetMyAddresses' below. You must enter your own adresses (or parts of them, if the parts are unique), so the mails will not be sent to yourself. You can determine up to 255 addresses. This limit (which applies to the max. number of Cc and To addresses, too) can be altered with MAX_ADDRESSES.

Special notice for Greek users: If you use the greek language version, you must set MAIL_OPT_KEY, too.


Hints & Warnings


The Script

// ---------------------------------------------------------------- //
// ---  Reply to all (email) by Kai Juerges  ---------------------- //
// ---  Slightly[tm] amended by Dirk Straka ;o)  ------------------ //
// ---------------------------------------------------------------- //
// ---  Any bugs, questions, hints?  Please come to either  ------- //
// ---  de.comm.software.40tude-dialog or send us an email.  ------ //
// ---------------------------------------------------------------- //
// ---  This script is beta!  Use on your own risk.  -------------- //
// ---  Please check the receiving addresses before sending!  ----- //
// ---------------------------------------------------------------- //
// ---  Instructions:  -------------------------------------------- //
// ---  Edit the script in the procedure "SetMyAddresses" below.  - //
// ---  You should enter your own adresses (or parts of them, ----- //
// ---  if the parts are unique), so the mails will not be sent --- //
// ---  to yourself.  You can determine up to 255 addresses.  ----- //
// ---  This limit (which applies to the max. number of Cc and  --- //
// ---  To addresses, too) can be changed with MAX_ADDRESSES.  ---- //
// ---------------------------------------------------------------- //
// ---  SPECIAL NOTICE FOR GREEK USERS:  If you use the greek  ---- //
// ---  language version, you must set MAIL_OPT_KEY, too.  -------- //
// ---------------------------------------------------------------- //
// ---  Tested with 40tude-Dialog Version 2.0.14.1 (Beta 37)  ----- //
// ---------------------------------------------------------------- //

Program ReplyToAll;

// ---------------------------------------------------------------- //
// Initialisation of programm

//
// declare needed Windows-internals
//
uses
   Forms,
   StdCtrls;

const
   MAX_ADDRESSES = 255;      // Maximum number of My- and Cc-Addresses
   MAIL_OPT_KEY  = 79;       // set to 931 (greek S) for greek version,
                             // or to 79 (M) for all others.
//
// We want to use Arrays of String as parameter
//
type
   TLotsOfAdrs = Array [1..MAX_ADDRESSES] of String;

//
// Enter your mail addresses (or unique(!) parts of them) here,
// following the given examples - pay attention to the index,
// it must be consecutive, as an empty one indicates 'end of list',
// You can enter up to "MAX_ADDRESSES" (default: 255) entries.
// Hint:  The address strings are NOT case sensitive - and it
// is strongly recommended to have at least the "@" included.
//
procedure SetMyAdresses( out MyAddress : TLotsOfAdrs );
begin
   You_have_not_yet_entered_your_Mailaddresses - afterwards delete this line.
   MyAddress[1] := 'maxmustermann@';
   MyAddress[2] := '@example.com';
   MyAddress[3] := 'max@example.com';
end;


// ---------------------------------------------------------------- //
// ------------   Initialization of program finished   ------------ //
// --------   No user maintainable parts below this line   -------- //
// ---------------------------------------------------------------- //


// ---------------------------------------------------------------- //
// Subroutines for header retrieval

//
// Copy message body to dummyMemo
//
procedure GetMsgBody(
   var dummyMemo : TMemo
);

begin
   lockdisplay;
   try
      dummyMemo.Clear;
      ADo( 'ArticlePane' );
      ADo( 'SelectAll' );
      ADo( 'Copy' );
      dummyMemo.PasteFromClipboard;
   finally
      unlockdisplay;
   end;  // try
end;  // procedure GetMsgBody()


//
// Get specified header field (e. g. 'From', 'To' or 'Cc') from message
//
function GetHeader(
   const FieldName     : String;
   const dummyMemo     : TMemo;
   const HeaderLineCnt : Integer
): string;

var
      i, j, k   : Integer;
      colonpos  : Integer;   // pos of colon, to determine header name length
      found_next_header : Boolean;

begin
   result := '';
   found_next_header := false;
   FieldName := Uppercase( FieldName );          // header field names are NOT case sensitive  :o(
   for i:=0 to HeaderLineCnt do begin
      if (Pos(FieldName+': ', Uppercase(dummyMemo.Lines[i])) = 1) then begin
         colonpos := Pos( ':', dummyMemo.Lines[i] );
         result := Copy( dummyMemo.Lines[i], colonpos+2, Length(dummyMemo.Lines[i]) );
         //
         // Got first line of given header type - now check if next line is continuation
         // or next header.  If it's the next header field, there will be a colon terminated
         // keyword.  Following RFC 822 field names must be composed of printable ASCII
         // characters (i. e., characters that have values between 33. and 126., decimal,
         // except colon).
         //
         for j:=i+1 to HeaderLineCnt do begin
            for k:=1 to Length(dummyMemo.Lines[j]) do begin
               if (dummyMemo.Lines[j][k] = ':') and (k > 1) then begin
                  found_next_header := true;
                  break;
               end;  // if
               if    (Ord(dummyMemo.Lines[j][k]) < 33)
                  or (Ord(dummyMemo.Lines[j][k]) > 126)
               then begin
                  break;
               end;  // if
            end;  // for
            if found_next_header then break;
            result := result + dummyMemo.Lines[j];
         end;  // for
      end;  // if ": "
   end;  // for
end;  // function GetHeader()


//
// Check if headers are visible in message pane.
// If so, set HeaderLineCnt, otherwise return false.
//
function CountHeaderLines(
   const dummyMemo : TMemo;
   out   cnt       : Integer
): boolean;

var
   i          : Integer;
   found_From : Boolean;
   found_To   : Boolean;
   found_Date : Boolean;

begin
   cnt    := 0;
   result := false;                              // Default: No headers visible
   found_From := false;                          // No From header seen so far
   found_To   := false;                          // No To header seen so far
   found_Date := false;                          // No Date header seen so far
   // Minimum header lines (as defined in RFC 822):
   //   1. From   2. To   3. Date
   // Attention:  Header field names are NOT case sensitive!  :o(
   if dummyMemo.Lines.count > 2 then begin
      for i:=0 to dummyMemo.Lines.count do begin
         if (Pos('FROM: ', Uppercase(dummyMemo.Lines.strings[i])) = 1)
            then found_From := true;
         if (Pos('TO: ', Uppercase(dummyMemo.Lines.strings[i])) = 1)
            then found_To   := true;
         if (Pos('DATE: ', Uppercase(dummyMemo.Lines.strings[i])) = 1)
            then found_Date := true;
         if    (dummyMemo.Lines.strings[i] = '')   // end of header section
            or (found_From and found_To and found_Date)  // no need to search longer
         then begin
            break;
         end;
      end;  // for
      result := (found_From and found_To and found_Date);
   end;  //if

   if result then begin
      for i:=1 to dummyMemo.Lines.count do begin
         if dummyMemo.Lines.strings[i] = '' then begin
            cnt := i;
            break;
         end;  // if
      end;  // for
   end  // if
end;  // function CountHeaderLines()


//
// Split address line into single address entries
// (e. g. to be able to "clean" or filter them afterwards)
//
procedure ParseAddresses(
   const AddressString : String;
   var   MailStrings   : TLotsOfAdrs;
   var   Addresses     : TLotsOfAdrs;
   var   cnt           : Integer
);

var
   i, last_i  : Integer;
   is_quoted  : Boolean;
   backslash  : Boolean;
   last_quote : Char;

begin
   if AddressString <> '' then begin
      is_quoted  := false;                       // no quote seen so far
      backslash  := false;                       // no backslash seen so far
      last_quote := ' ';                         // active quote char
      last_i     := 0;                           // end of last address (i. e. position of comma)
      for i:=1 to Length( AddressString ) do begin
         if backslash then begin
            backslash := false;
            continue;                            // skip the escaped char unconditionally
         end;
         if AddressString[i] = Chr(47) (* Backslash *) then begin
            backslash := true;                   // next one has to be skipped!
            continue;                            // No need to proceed.  ;o)
         end;  // if
         //
         // we have to skip quoted phrases, too ...
         //
         if    (AddressString[i] = '"')
            or (AddressString[i] = '(')
            or (AddressString[i] = ')')
            or (AddressString[i] = Chr(39))      // Single Quote - really skip?!?
         then begin
            if    ( last_quote = ' ' )
               or ( last_quote = AddressString[i] )
               or ((last_quote = '(') and (AddressString[i] = ')'))
            then begin
               is_quoted := not is_quoted;
               if is_quoted then begin
                  last_quote := AddressString[i];
               end   // then
               else begin
                  last_quote := ' ';
               end;  // else
            end;  // if
            continue;                            // quote chars are of no interest
         end;  // if
         if is_quoted then continue;             // skip quoted phrases

         if (AddressString[i] = ',') then begin  // found end of address
            cnt := cnt + 1;
            MailStrings[cnt] := Copy( AddressString, last_i+1, i-last_i-1 );
            last_i := i + 1;
         end  // then
         else begin
            //
            // if we come along here, we have found a char of the real mail address
            // --> we memorize this one for the MyAddresses test ...
            //
            if AddressString[i] = '<' then begin // that's where the address starts, thus ...
               Addresses[cnt+1] := '';           // ... previous text was not the mail address
            end;
            Addresses[cnt+1] := Addresses[cnt+1] + Copy(AddressString, i, 1);
            if (i = Length(AddressString)) then begin
               cnt := cnt + 1;
               MailStrings[cnt] := Copy( AddressString, last_i+1, i-last_i );
            end;  // if
         end;  // else
      end;  // for
   end;  // if
end;  // procedure ParseAddresses()


//
// Concatenate Mail Addresses,
// Suppress MyAddresses
// and paste the result to clipboard
//
procedure SetAddressString(
   const MyAddress     : TLotsOfAdrs;
   const MailStrings   : TLotsOfAdrs;
   const Addresses     : TLotsOfAdrs;
   const AddressCount  : Integer;
   var   AddressString : String;
   var   dummyMemo     : TMemo
);

var
    i, j  : Integer;
    found : Boolean;                             // found one of MyAddresses

begin
   AddressString := '';
   for i:=1 to AddressCount do begin
      found := false;
      for j:=1 to MAX_ADDRESSES do begin
         if MyAddress[j] = '' then break;
         if pos(Lowercase(MyAddress[j]), Lowercase(Addresses[i])) <> 0 then begin
            found := true;
            break;
         end;  // if
      end;  // for
      if found then begin
         continue;
      end;
      if AddressString = ''
         then AddressString := MailStrings[i]
         else AddressString := AddressString + ', ' + MailStrings[i];
   end;  // for


   dummyMemo.Clear;
   dummyMemo.Text := AddressString;
   dummyMemo.SelectAll;
   dummyMemo.CopyToClipboard;
end;  // procedure SetAddressString()


// Subroutines for header retrieval finished
// ---------------------------------------------------------------- //


//
// Just a more convenient interface for PostKey()
//
procedure PKeySAC(
   const key   : Integer;
   const shift : Boolean;
   const alt   : Boolean;
   const ctrl  : Boolean
);
begin
   PostKey(key, shift, alt, ctrl, false, false, false, false, false);
end;


// ---------------------------------------------------------------- //
// ------------------------   Main   ------------------------------ //
// ---------------------------------------------------------------- //

//
// declare needed vars
//
var
   i             : Integer;
   dummyForm     : TForm;
   dummyMemo     : TMemo;
   // prevMemo      : TMemo;                     // FFS - disabled
   AddressString : String;
   HeaderLineCnt : Integer;
   AddressCount  : Integer;
   MailStrings   : TLotsOfAdrs;
   Addresses     : TLotsOfAdrs;
   MyAddress     : TLotsOfAdrs;

begin
   //
   // initialization
   //
   AddressCount  := 0;
   HeaderLineCnt := 0;
   for i:=1 to MAX_ADDRESSES do MyAddress[i] := '';
   SetMyAdresses( MyAddress );

   //
   // initialize dummyMemo (buffer for MSG headers)
   //
   dummyForm         := tForm.Create( nil );
   dummyForm.Visible := false;
   dummyMemo         := tmemo.Create( dummyForm );
   dummyMemo.Parent  := dummyForm;
   dummyMemo.Visible := false;
   dummyMemo.Width   := 2048;                    // chars per line

   //
   // initialize prevMemo (buffer for previous clipboard content)
   //
   // prevMemo         := tmemo.Create( dummyForm );
   // prevMemo.Parent  := dummyForm;
   // prevMemo.Visible := false;

   //
   // First save current clipboard content
   //
   // prevMemo.Clear;
   // prevMemo.PasteFromClipboard;

   //
   // Now, let's do it!  ;o)
   // We'll fetch the header lines ...
   //
   GetMsgBody( dummyMemo );
   if not CountHeaderLines( dummyMemo, HeaderLineCnt ) then begin
      ADo( 'ShowHeaders' );
      GetMsgBody( dummyMemo );
      Ado( 'ShowHeaders' );
      CountHeaderLines( dummyMemo, HeaderLineCnt );
   end;  // if

   //
   // Search for "To" and "Cc" and extract mail addresses
   //
   AddressString := GetHeader( 'To', dummyMemo, HeaderLineCnt );
   ParseAddresses( AddressString, MailStrings, Addresses, AddressCount );

   AddressString := GetHeader( 'Cc', dummyMemo, HeaderLineCnt );
   ParseAddresses( AddressString, MailStrings, Addresses, AddressCount );

   SetAddressString( MyAddress, MailStrings, Addresses, AddressCount, AddressString, dummyMemo );

   //
   // Now we've got the addresses (in clipboard), let's start the editor ...
   //
   // ADoLater( 'ReplyByEmail' );                 // Paste fails with ADoLater()
   ADo( 'ReplyByEmail' );

   //
   // ... then change to the header pane,
   // go down to Cc field (10 times <Tab>),
   // paste the Addresses
   // and switch back to the edit pane ...
   //
   lockdisplay;
   try
      PKeySAC(MAIL_OPT_KEY, false, true, false );// <Alt>O =~ show options tab
      PKeySAC( 9, true, false, true );           // <Shift><Ctrl><Tab> =~ attechments tab
      PKeySAC( 9, true, false, true );           // <Shift><Ctrl><Tab> =~ headers tab
      for i:=1 to 10 do
         PKeySAC( 9, false, false, false );      // Tab =~ goto Cc field
      PKeySAC(86, false,false, true);            // <Ctrl>V =~ Paste
      // Sleep( 150 );                           // to no avail.  :o((
      PKeySAC( 9, true, false, true);            // <Shift><Ctrl><Tab> =~ MSG tab
      PKeySAC( 9, true, false, false);           // <Shift><Tab>
      PKeySAC( 9, true, false, false);           // <Shift><Tab> =~ Goto edit pane

      //
      // Restore previous clipboard content
      //
      // prevMemo.SelectAll;                     // FFS:  overwrites Cc-Addresses in clipboard ...
      // prevMemo.CopyToClipboard;               //       ... faster than they can be pasted.  :o((
   finally
      unlockdisplay;
   end;  // try
end.  // byebye!


Greets, Dirk Straka