Netdigest

From 40tude Dialog Wiki

Contents

Netdigest

Send a posting to netdigest with a few clicks.


Installation

Copy the script below and paste it as 'Custom Script'. Save and compile the script. I recommend to assign a shortcut to the script, so you can send a posting to netdigest with 2 keystrokes.


Configuration

If you want to use the script with a not german netdigest, then you have to change the email-address to which the posting have to be sent. You find a constant called Netdigest in line 29 of the script. Please change this to the required value.


Using the script

If you have assigned a shortcut, select the message you want to send to netdiges, press your shortcut and send the new message.


Hints & Warnings


The Script

// ---------------------------------------------------------------- //
// ---  Netdigest (email) © by Kai Juerges  ----------------------- //
// ---------------------------------------------------------------- //
// ---  Based on Reply2All © by Kai Juerges  ---------------------- //
// ---  Slightly[tm] amended by Dirk Straka ;©)  ------------------ //
// ---------------------------------------------------------------- //
// ---  Any bugs, questions, hints?  Please come to either  ------- //
// ---  de.comm.software.40tude-dialog or send me an email.  ------ //
// ---  kai@juerges.de  ------------------------------------------- //
// ---------------------------------------------------------------- //
// ---  This script is beta!  Use on your own risk.  -------------- //
// ---  Please check the mail before sending!  -------------------- //
// ---------------------------------------------------------------- //

Program Netdigest;

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

//
// set E-Mail for Netdigest here
//

const
   Netdigest = 'de-alt-netdigest@moderators.dana.de';

// ---------------------------------------------------------------- //
// 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 Newsgroups header seen so far
   found_Date := false;                          // No Date header seen so far
   // Minimum header lines
   //   1. From   2. Newsgroups   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('NEWSGROUPS: ', 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()

// 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;


procedure SetClipbrd(
   const dummyMemo    : TMemo;
   const text         : String
);
begin
      dummyMemo.Clear;
      dummyMemo.Text := text;
      dummyMemo.SelectAll;
      dummyMemo.CopyToClipboard      
end;

//
// Paste Header in Message
//
procedure InsertHeader(
   const dummyMemo    : TMemo;
   const text         : String
);
begin
      SetClipbrd (dummyMemo, text);
      PKeySAC(86, false,false, true);            // <Ctrl>V =~ Paste
      PKeySAC(13, false,false, false);            // Enter
end;


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

//
// declare needed vars
//
var
   dummyForm     : TForm;
   dummyMemo     : TMemo;
   dummyMemo2    : TMemo;
   HeaderLineCnt : Integer;

   hdrNewsgroups : String;
   hdrDate       : String;
   hdrSubject    : String;
   hdrMessageId  : String;
   hdrFrom       : String;   

begin
   //
   // initialization
   //
   HeaderLineCnt := 0;

   //
   // 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
   dummyMemo2         := tmemo.Create( dummyForm );
   dummyMemo2.Parent  := dummyForm;
   dummyMemo2.Visible := false;
   dummyMemo2.Width   := 2048;                    // chars per line
   //
   // Now, let's do it!  ;o)
   // We'll fetch the header lines ...
   //
   GetMsgBody( dummyMemo );
   GetMsgBody( dummyMemo2 );
   if not CountHeaderLines( dummyMemo, HeaderLineCnt ) then begin
      ADo( 'ShowHeaders' );
      GetMsgBody( dummyMemo );
      Ado( 'ShowHeaders' );
      CountHeaderLines( dummyMemo, HeaderLineCnt );
   end  // if
   else begin
      ADo( 'ShowHeaders' );
      GetMsgBody( dummyMemo2 );
      Ado( 'ShowHeaders' );
   end;
   
   hdrFrom := GetHeader('From', dummyMemo, HeaderLineCnt );
   hdrDate := GetHeader('Date', dummyMemo, HeaderLineCnt);
   hdrSubject := GetHeader('Subject', dummyMemo, HeaderLineCnt);
   hdrMessageId := GetHeader('Message-Id', dummyMemo, HeaderLineCnt);
   hdrNewsgroups := GetHeader('Newsgroups', dummyMemo, HeaderLineCnt);

   ADo('NewEmailMessage');
   application.processmessages;

   lockdisplay;
   application.processmessages;
   try
   //
   // paste the Subject
   //
      SetClipbrd (dummyMemo, '[' + hdrNewsgroups + '] ' + hdrSubject);
      application.processmessages;
      PKeySAC(86, false,false, true);            // <Ctrl>V =~ Paste
      application.processmessages;

   //
   // paste the To-Field
   //
      PKeySAC( 9, false, false, false);           // <Tab>
      PKeySAC( 9, false, false, false);           // <Tab>
      application.processmessages;
      SetClipbrd (dummyMemo, Netdigest);
      application.processmessages;
      PKeySAC(86, false,false, true);            // <Ctrl>V =~ Paste
      application.processmessages;

   //
   // Go to editor-window
   //
      PKeySAC( 9, false, false, false);           // <Tab>
      PKeySAC( 9, false, false, false);           // <Tab>
      PKeySAC(36, false, false, false);           // No Sig
      PKeySAC( 9, false, false, false);           // <Tab>
      PKeySAC( 9, false, false, false);           // <Tab>
      PKeySAC( 9, false, false, false);           // <Tab>
      PKeySAC( 9, false, false, false);           // <Tab>

   //
   // paste the Headers
   //

      application.processmessages;
      InsertHeader(dummyMemo, 'From: ' + hdrFrom);
      application.processmessages;
      InsertHeader(dummyMemo, 'Subject: ' + hdrSubject);
      application.processmessages;
      InsertHeader(dummyMemo, 'Newsgroups: ' + hdrNewsgroups);
      application.processmessages;
      InsertHeader(dummyMemo, 'Date: ' + hdrDate);
      application.processmessages;
      InsertHeader(dummyMemo, 'Message-Id: ' + hdrMessageId);
      application.processmessages;

   //
   // paste the Message itself
   //
      PKeySAC(13, false,false, false);            // Enter
      dummyMemo2.SelectAll;
      dummyMemo2.CopyToClipboard      
      application.processmessages;
      PKeySAC(86, false,false, true);            // <Ctrl>V =~ Paste

   finally
      unlockdisplay;
   end;  // try
end.  // bye baby!
Begin
End.

Greets, Kai