GetMessageReference

From 40tude Dialog Wiki

This script reads informations in the selected message headers and build a reference giving the message ID, the author and his address and the date and time of posting. This script will help referencing a third message in the follow up of a post, for example to help somebody to retrieve an old post.

This script was done by Alain Guerin (dsgmr@alain-guerin.com). For a customised version that includes automatic adaptation to the language in use in the newsgroup, look at [website].

---

Warning

This script will not work correctly with Dialog 2.0.14.1. If you can fix this, feel free to update the script.

---

Program GetMessageReference;

{ Version beta 1.0.1 2003/08/27 - 15:15
  compile and run with Dialog version 2.0.5.1
  Check the source code or save your data before use.}

uses
   Forms,
   StdCtrls;

CONST
   {Tag to detect a given Header}
   MessageIDHeader = 'Message-ID: ';
   DateHeader = 'Date: ';
   FromHeader = 'From: ';

VAR
  {dummy controls to paste and copy}
   DummyForm : TForm;
   DummyMemo : TMemo;
   MessageID : string;
   HeadersAreHidden : Boolean;
   Reference : 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;
   {to avoid side effects: if an empty selection must be copyed in the clipboard}
   BEGIN
      OpenClipboard(0);
      EmptyClipboard;
      CloseClipboard;
   END;

   PROCEDURE GetMessageBody (VAR LocDummymemo : tmemo);

   BEGIN
     {Select the message body, select all text and copy it}
      LocDummyMemo.Clear;
      {As copy does nothing if the selection is empty, ClearClipboard avoid side effects
      when a messagebody is empty}
      ClearCLipboard;
      ADo('ArticlePane');
      ADo('SelectAll');
      Ado('Copy');
      LocDummyMemo.PasteFromClipboard;
   END;

   FUNCTION ExtractHeaderLine( HeaderTag : String;VAR LocDummymemo : tmemo): string;

   VAR
      index : integer;

   BEGIN
      Index := 0;
      Result := '';
      WHILE (Index < LocDummymemo.Lines.count-1) AND (Result = '') DO
      {When headers are displayed, there is always an empty line after the last header,
      so Index is always under LocDummymemo.Lines.count-1 for the last header}
      BEGIN
      {detect if a given header is present}
         IF POS(HeaderTag,LocDummymemo.lines.Strings[index]) = 1 THEN
         BEGIN
            Result := LocDummymemo.lines.Strings[index]; {Get found info}
            IF Result = HeaderTag THEN
            {May be a word wrap problem, add following lines}
            BEGIN
               Index := index+1;
               WHILE (Index < LocDummymemo.Lines.count-1)
               AND (POS(': ',LocDummymemo.lines.Strings[index])=0) DO
               BEGIN
                  Result := Result +LocDummymemo.lines.Strings[index+1];
                  index := index+1
               END
            END
         END
         ELSE
            Index := Index+1;
      END;
   END;

   FUNCTION GetHeaderInfo( HeaderTag : String;VAR LocDummymemo : tmemo): string;

   BEGIN
      {GetHeader  line and delete header tag}
      Result := ExtractHeaderLine( HeaderTag, LocDummymemo);
      delete(Result, 1, length(HeaderTag));
   END;


   FUNCTION GetMessageId(VAR LocDummymemo : tmemo): string;

   begin
      result := GetHeaderInfo(MessageIDHeader, LocDummymemo);
   end;

   FUNCTION AreHeadersHidden(var LocDummymemo : tmemo):boolean;

   VAR
      index : integer;

   BEGIN
      Result := true;
      {IF  less than  or equal to 10 lines, headers are hidden}
      IF LocDummyMemo.Lines.count > 10 THEN
      {at least, there are lines to search if headers are displayed}
      BEGIN
        {a scan of all lines is done to see if an always existing header is diplayed}
         index := 0;
         WHILE (Index < LocDummyMemo.Lines.count -1) and result DO
        {index is smaller than count-1 if header are displayed as there is always
         a blank line after them}
         BEGIN
            index := index+1;
            result := Pos('Newsgroups: ', LocDummyMemo.Lines.strings[index]) = 0
         END;
      END;
   END;

   PROCEDURE BuildDummyContainers;

   BEGIN
      DummyMemo := tmemo.Create(DummyForm);
      DummyMemo.Parent := DummyForm;
      {have a large enought width to avoid wrap around lines}
      {freeze if not called from the script window : versions prior to 2.0.6.0
       for further version, remove the comment mark and delete the unecessary line}
      // DummyMemo.Width := Application.Mainform.width;
      DummyMemo.Width := 1000;
   END;

Begin
   DummyForm := tform.Create(nil);
   try
   BuildDummyContainers;
   GetMessageBody(DummyMemo);
   HeadersAreHidden := AreHeadersHidden(DummyMemo);
   {headers must be displayed to get messageID}
   IF HeadersAreHidden THEN
      ADo('ShowHeaders');
   GetMessageBody(DummyMemo);
   MessageID := GetMessageID(DummyMemo);
   {delete the < and > signs around message ID}
   MessageID := copy(MessageID, 2, length(MessageID)-2);
   {extract author and time}
   Reference := 'from '+GetHeaderInfo(FromHeader, DummyMemo)+' on '+GetHeaderInfo(DateHeader, DummyMemo);
   Reference := 'message <URL:News:'+MessageId+'> '+Reference;
   ClearClipboard;
   DummyMemo.Clear;
   DummyMemo.Lines.Add(Reference);
   DummyMemo.SelectAll;
   DummyMemo.CopyToClipboard;
   IF HeadersAreHidden THEN
      Ado('ShowHeaders');
   beep;
   finally
   Dummyform.free;
   end;
End.