NonAnsweredPosts

From 40tude Dialog Wiki

This script will detect and (book)mark posts that started a thread and never had an answer.


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

{ Version beta 1.0.3 2003/08/13 - 08:15
  compile and run with Dialog version 2.0.5.1
  Check the source code or save your data before use.
  Version beta 1.0.4 2003/08/15 - 08:16
  Additions:
     Clearing of marker list to avoid side effect on empty result
     A new date check to be more monkey proof
     Opening of bookmark list at the end as I am very lazy}

{**************************************************************
 This program can (book)mark all messages that never had an
 answer.
 It is a tool for good samaritans that would like to help
 authors of isolated, orphan messages like those I so often
 let on servers :-/
 To avoid too a long processing time, there is a test period
 filter. The more recent and smaller period, the faster.
 I had to use tricks to test the sort options and restore
 them as I found no nicer way. There is a great risk they
 are version depending, mainly FUNCTION  SetCheckRevSortBy.
               contact: dsnap@alain-guerin.com
 **************************************************************}

 {*************************************************************
    WARNING:
  all messages can be marked as read depending on the settings.
 **************************************************************}

uses
   Forms,
   StdCtrls,
   ExtCtrls;

CONST
   {Tag to detect a given Header}
   MessageIDHeader = 'Message-ID: ';
   ReferenceHeader = 'References: ';
   DateHeader = 'Date: ';
   {virtual key for postkey procedures}
   VK_HOME = $24;
   VK_DOWN = $28;
   {Selected orphan message marker}
   Flag = 'AddBookmark';
   {can be change to another flag that fit user needs: 'Watch' | 'Keep' | 'Ignore'
    depending also on the Views available to show only selected messages.
    Given a flag, it is let to the user to purge the group from existing flags before
    running the script, i.e. deleting all bookmarks in our case}

TYPE
   TProgressMode = (PM_Percent, PM_Ratio);

VAR
   Scriptform : tForm;
   LbFrom : TLAbel;
   EdFrom : TEdit;
   LbTo : TLAbel;
   EdTo : TEdit;
   PnStatusBar : TPanel;
   BtOk : TButton;
   ATimer : TTimer;
   DummyForm : TForm;
   DummyMemo : TMemo;
   StartDate : String;
   EndDate : String;
   ViewInUse : STRING;
   SortInUse : String;
   ReverseOrder : boolean;
   FirstMessageID : string;
   LastMessageID : string;
   MessageID : string;
   HeadersAreHidden : Boolean;
   FirstReferenceList : TStringList;
   FirstReference : STRING;
   InformationForm : Tform;
   InformationEdit : TEdit;
   InformationDone : Boolean;
   ProgressForm : Tform;
   ProgressEdit : TEdit;
   BtProgressAbort : TButton;
   MessageNumber : INTEGER;
   DoneNumber : INTEGER;
   Halt : boolean;

   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(Application.Handle);
      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;

   FUNCTION GetFirstReference(LocDummyMemo : TMemo):String;

   BEGIN
      Result := GetHeaderInfo(ReferenceHeader,LocDummyMemo);
      IF Result > '' THEN
      {Extract the first reference from references}
         delete(result, pos('>',result)+1,length(result)-pos('>',result));
   END;

   FUNCTION GetMessageNumberEstimation(LocDummyMemo : TMemo) : INTEGER;

   BEGIN
      {Result is not always exactly the right number depending on the size of the pane and
       if the number of messages is greater or smaller than the line number of pane}
      ADo('HeaderlistPane');
      Ado('SelectAll');
      Ado('Copy');
      LocDummyMemo.PasteFromClipboard;
      {un-selectall}
      Result := LocDummyMemo.Lines.Count;
      ADo('PreviousMessageInHistory');
      ADo('NextMessageInHistory');
   END;

   PROCEDURE InformationFormClose (Sender: TObject; var Action: TCloseAction);

   BEGIN
   {as showmodal cannot be use if another task has to be run in the same time,
    with the same code, a boolean mark avoid the ability to close the information
    window before the end of the message number evaluation}
      IF InformationDone then
         Action:= CaHide
      ELSE
         Action := CaNone;
   END;

   PROCEDURE BuildInformationForm;

   {As select all can be time consumming for a group with thousand of messages,
    a message window will help waiting}

   BEGIN
      InformationForm := TForm.Create(Nil);
      InformationForm.Position := PoScreenCenter;
      InformationForm.OnCLose := @InformationFormClose;
      InformationForm.Caption := 'Waiting';
      InformationEdit := TEdit.Create(InformationForm);
      InformationEdit.Parent := InformationForm;
      InformationEdit.ReadOnly := true;
      InformationEdit.Text := 'Message Number Estimation';
      InformationEdit.Width := InformationForm.Canvas.TextWidth(InformationEdit.Text+'   ');
      InformationEdit.Top := (InformationForm.height - InformationEdit.Height) DIV 2;
      InformationEdit.Left := (InformationForm.width - InformationEdit.Width) DIV 2;
   END;

   PROCEDURE ProgressFormClose  (Sender: TObject; var Action: TCloseAction);
   {as there is no halt procedure, a boolean flag is set to have a sideway
    to replace it and propagate the halt to the main program}
   BEGIN
      halt:= true;
      Action:= CaHide;
   END;


   PROCEDURE BtAbortClick(Sender: TObject);

   BEGIN
      TForm(TButton(Sender).Parent).Close;
   END;

   PROCEDURE ShowProgress(NewNumber, Total : INTEGER; Mode : TProgressMode );
   {far from perfect but enought to let the user wait the end of the treatment}
   BEGIN
      {if message number estimation is wrong, hide the mistake}
      IF NewNumber > Total THEN
         Total := NewNumber;
     {display progress}
      CASE Mode OF
         PM_Percent {percent}: ProgressEdit.Text := intToStr(round(NewNumber/Total*100))+'%';
         PM_Ratio {ratio}: ProgressEdit.Text := intToStr(NewNumber)+'/'+Inttostr(Total);
      END
   END;

   PROCEDURE SetProgressFormStructure;

   BEGIN
      ProgressEdit:=Tedit.create(ProgressForm);
      ProgressEdit.Parent := ProgressForm;
      BtProgressAbort := TButton.Create(ProgressForm);
      BtProgressAbort.Parent := ProgressForm;
      ProgressForm.Top := Application.MainForm.Top;
      ProgressEdit.parent:=ProgressForm;
      {place the progressform in the middle of the screen}
      ProgressForm.position := poScreenCenter;
      {and progressedit in the middle of the form}
      ProgressForm.OnClose :=@ProgressFormClose;
      ProgressEdit.left:=(ProgressForm.width-ProgressEdit.width) div 2;
      ProgressEdit.top:=(ProgressForm.height-ProgressEdit.height) div 2;
      ProgressEdit.ReadOnly := true;
      {and abort button, bottom}
      BtProgressAbort.Caption := '&Abort';
      BtProgressAbort.Left:= (ProgressForm.width-BtProgressAbort.width) div 2;
      BtProgressAbort.Top := ProgressForm.ClientHeight-BtProgressAbort.Height*2;
      ProgressForm.ActiveControl := BtProgressAbort;
      BtProgressAbort.OnClick := @BtAbortClick;
   END;

   FUNCTION GetViewInUse : STRING;

   BEGIN
      IF AChecked('View1') THEN
         Result := 'View1'
      ELSE IF  AChecked('View2') THEN
         Result := 'View2'
      ELSE IF  AChecked('View3') THEN
         Result := 'View3'
      ELSE IF  AChecked('View4') THEN
         Result := 'View4'
      ELSE IF  AChecked('View5') THEN
         Result := 'View5'
      ELSE IF  AChecked('View6') THEN
         Result := 'View6'
      ELSE IF  AChecked('View7') THEN
         Result := 'View7'
      ELSE IF  AChecked('View8') THEN
         Result := 'View8'
      ELSE IF  AChecked('View9') THEN
         Result := 'View9'
      ELSE IF  AChecked('View10') THEN
         Result := 'View10'
   END;

   FUNCTION GetSortOrder:String;

   VAR
      AForm : TForm;
      DummyEdit : TEdit;

   BEGIN
      {select the sort listbox}
      ADo('FocusSortDropdownList');
      {get displayed info}
      Ado('Copy');
      AForm := TForm.create(Nil);
      try
      DummyEdit := TEdit.Create(AForm);
      DummyEdit.Parent := AForm;
      DummyEdit.PasteFromClipboard;
      Result:= DummyEdit.Text;
      finally
         AForm.Free;
      end;
   END;


   PROCEDURE SetSortOrder(InitialValue : String);

   VAR
      AForm : TForm;
      DummyEdit : TEdit;

   BEGIN
      AForm := TForm.create(Nil);
      try
      DummyEdit := TEdit.Create(AForm);
      DummyEdit.Parent := AForm;
      {select the sort listbox}
      ADo('FocusSortDropdownList');
      {goto first line}
      postkey(VK_Home,false,false,false,false,false,false,false,true);
      {get first line}
      Ado('Copy');
      DummyEdit.PasteFromClipboard;
      WHILE DummyEdit.text <>  InitialValue DO
      BEGIN
         {skip to next line, until match}
         postkey(VK_Down,false,false,false,false,false,false,false,true);
         DummyEdit.Text:='';
         {get info}
         Ado('Copy');
         DummyEdit.PasteFromClipboard;
         {a security, just in case the initialvalue is corrupted or false}
         IF 'Thread, Av.Score, Rev. Date' = DummyEdit.Text THEN
            Break;
      END;
      finally
         AForm.Free;
      end;
   END;

   FUNCTION  SetCheckRevSortBy(Checked : boolean): boolean;

   { Set RevSortBy checkbox to the state define in checked and
     return the previous state}

   VAR
      AWincontrol : TWinControl;

   BEGIN
      AWincontrol := TWinControl(Application.MainForm.Controls [0]);
      AWincontrol := TWinControl(AWincontrol.Controls [0]);
      AWincontrol := TWinControl(AWincontrol.Controls [0]);
      AWincontrol := TWinControl(AWincontrol.Controls [0]);
      AWincontrol := TWinControl(AWincontrol.Controls [1]);
      AWincontrol := TWinControl(AWincontrol.Controls [0]);
      AWincontrol := TWinControl(AWincontrol.Controls [0]);
      AWincontrol := TWinControl(AWincontrol.Controls [3]);
      Result := TCheckBox(AWincontrol).Checked;
      TCheckBox(AWincontrol).Checked:= Checked;
   END;

   PROCEDURE ATimerOnTimer(Sender : TObject);

   BEGIN
      {a timer will restore original info after the display of an error message}
      TTimer(Sender).Enabled := false;
      PnStatusBar.Caption :='Enter From and To dates';
   END;


   FUNCTION YYMMDDToDDMMYY(ADate : string):String;

   BEGIN
      Result := copy(ADate,7,2)+'/'+copy(ADate,4,2)+'/'+copy(Adate,1,2);
   END;

   PROCEDURE ScriptFormClose (Sender: TObject; var Action: TCloseAction);

   VAR
      ADateFrom : TDateTime;
      ADateTo : TDateTime;

   BEGIN
      {prevent the window to be closed}
      Action :=CaNone;
      StartDate :=EdFrom.Text;
      EndDate :=EdTo.Text;
      {transformation is made to validate the date with StrToDate}
      try
      ADateFrom:=StrToDate(YYMMDDToDDMMYY(StartDate));
      try
      ADateTo:=StrToDate(YYMMDDToDDMMYY(EndDate));
      IF ADateFrom > ADateTo THEN
      BEGIN
         Beep;
         PnStatusbar.caption := 'From must be equal or less than To'
      END
      ELSE
         IF ADateTo > Now THEN
         BEGIN
            Beep;
            PnStatusbar.caption := 'Dates must be equal or less than Today';
            ATimer.Enabled := true;
         END
         ELSE
         {no problem: canclose}
            Action :=CaHide;
      except
         Beep;
         PnStatusBar.Caption := 'Date To : not a date';
         ATimer.Enabled := true;
      end;
      except
         Beep;
         PnStatusBar.Caption := 'Date From : not a date';
         ATimer.Enabled := true;
      end;
   END;

   PROCEDURE BuildScriptForm;

   BEGIN
      ScriptForm.position := poScreenCenter;
      ScriptForm.OnCLose := @ScriptFormClose;
      LbFrom := TLabel.Create(ScriptForm);
      LbFrom.parent := ScriptForm;
      LbFrom.Caption := '&From (yy/mm/dd):';
      LbFrom.Left := 5;
      LbFrom.top := LbFrom.Height;
      LbFrom.Width := LbFrom.Canvas.TextWidth('From (yy/mm/dd):');
      EdFrom := TEdit.Create(ScriptForm);
      EdFrom.Parent := ScriptForm;
      EdFrom.Top := LbFrom.Top;
      EdFrom.Left := LbFrom.Left+LbFrom.Width;
      EdFrom.Width := LbFrom.Canvas.TextWidth(' 99/99/99 ');
      EdFrom.Text :=  FormatDateTime('yy/mm/dd',Now-10);  {edit for new default gap}
      LbFrom.FocusControl := EdFrom;
      LbTo := TLabel.Create(ScriptForm);
      LbTo.parent := ScriptForm;
      Lbto.Caption := '&To (yy/mm/dd):';
      LbTo.Left :=EdFrom.Left+EdFrom.Width+10;
      LbTo.Top := LbFrom.Top;
      LbTo.Width := LbFrom.Canvas.TextWidth('To (yy/mm/dd):');
      EdTo := TEdit.Create(ScriptForm);
      EdTo.Parent := ScriptForm;
      EdTo.Top := LbFrom.Top;
      EdTo.Left := LbTo.Left+LbTo.Width;
      EdTo.Width := LbFrom.Canvas.TextWidth(' 99/99/99 ');
      EdTo.Text :=  FormatDateTime('yy/mm/dd',Now-4); {Edit for new default end date}
      LbTo.FocusControl := EdTo;
      ScriptForm.Width := EdTo.Left+EdTo.Width+15;
      BtOk := TButton.Create(ScriptForm);
      BtOk.Parent := ScriptForm;
      BtOk.Left := (ScriptForm.Width-BtOk.Width) DIV 2;
      BtOk.Top := LbFrom.Top+LBFrom.Height+BtOk.Height DIV 2;

      BtOk.Caption := '&Ok';
      BtOk.ModalResult := mrOk;
      PnStatusBar := TPanel.Create(ScriptForm);
      PnStatusBar.Parent := ScriptForm;
      PnStatusBar.Height := 22;
      ATimer := TTimer.Create(ScriptForm);
      ATimer.Interval := 3000;
      ATimer.OnTimer := @ATimerOnTimer;
      ScriptForm.ClientHeight := BtOk.Top+BtOk.Height+PnStatusBar.Height*3 DIV 2;
      PnStatusBar.Align := alBottom;
      ScriptForm.ActiveControl := BtOk;
      PnStatusbar.caption := 'Enter From and To dates';
   END;

   PROCEDURE MessageByDateDecreasingOrder;

   BEGIN
      {sort message by date, reverse order}
      ADo('FocusSortDropdownList');
      postkey(ord('D'),false,false,false,false,false,false,false,false);
      ReverseOrder := SetCheckRevSortBy(false);
      ADo('RefreshView');
   END;

   FUNCTION FormatStrToStrDate(ADay, AMonth, AYear : string) : String;

   VAR
      NumMonth : String;

   BEGIN
      WHILE Length(ADay) < 2 DO
         ADay := '0'+ADay;
      AMonth := uppercase(AMonth);
      IF AMonth = 'JAN' THEN NumMonth := '01'
      ELSE IF AMonth = 'FEB' THEN NumMonth := '02'
      ELSE IF AMonth = 'MAR' THEN NumMonth := '03'
      ELSE IF AMonth = 'APR' THEN NumMonth := '04'
      ELSE IF AMonth = 'MAY' THEN NumMonth := '05'
      ELSE IF AMonth = 'JUN' THEN NumMonth := '06'
      ELSE IF AMonth = 'JUL' THEN NumMonth := '07'
      ELSE IF AMonth = 'AUG' THEN NumMonth := '08'
      ELSE IF AMonth = 'SEP' THEN NumMonth := '09'
      ELSE IF AMonth = 'OCT' THEN NumMonth := '10'
      ELSE IF AMonth = 'NOV' THEN NumMonth := '11'
      ELSE IF AMonth = 'DEC' THEN NumMonth := '12';
      AYear := InttoStr(StrToInt(AYear) mod 100);
      WHILE Length(AYear) < 2 DO
         AYear := '0'+AYear;
      Result := AYear+'/'+NumMonth+'/'+ADay
   END;

   FUNCTION GetStandardizeMemoDate(VAR LocDummyMemo :TMemo):string;

   VAR
      SDay : string;
      SMonth : String;
      SYear  : String;

   BEGIN
      Result := GetHeaderInfo(DateHeader, LocDummyMemo);
      {delete day of week string, if any}
      IF Length(Result) > 0 THEN
         IF Result[1] > '9' THEN
            delete(Result, 1, pos(' ',Result));
      SDay := copy(Result,1, pos(' ',Result)-1);
      delete(Result, 1, pos(' ',Result));
      SMonth := copy(Result,1, pos(' ',Result)-1);
      delete(Result, 1, pos(' ',Result));
      SYear := copy(Result,1, pos(' ',Result)-1);
      Result := FormatStrToStrDate(SDay,SMonth,SYear);
   END;

   PROCEDURE BuildReference(LocDummyMemo: TMemo);

   BEGIN
      FirstReference := GetFirstReference(LocDummyMemo);
      IF FirstReference <> '' THEN
         FirstReferenceList.Add(FirstReference)
   END;

   PROCEDURE FindNewestEndDateAndBuildReferenceList(LocDummyMemo: TMemo);

   VAR
      MemoDate : String;

   BEGIN
      ProgressForm.Caption := 'Find newest End Date';
      MemoDate := GetStandardizeMemoDate(LocDummyMemo);
      MessageID := GetMessageID(LocDummyMemo);
      WHILE (MemoDate > EndDate ) AND  (MessageID <> LastMessageID) DO
      BEGIN
         BuildReference(DummyMemo);
         ADo('NextMessage');
         GetMessageBody(LocDummyMemo);
         IF LocDummyMemo.Lines.Count > 0 THEN
         BEGIN
            MemoDate := GetStandardizeMemoDate(LocDummyMemo);
            DoneNumber := DoneNumber+1;
            ShowProgress(DoneNumber,MessageNumber,Pm_Percent);
            MessageID := GetMessageID(LocDummyMemo);
         END;
         IF Halt THEN
            Exit;
      END;
   END;

   PROCEDURE FindOldestStartDateAndBuildReferenceList(LocDummyMemo: TMemo);

   VAR
      MemoDate : String;

   BEGIN
      ProgressForm.Caption := 'Building reference list';
      ShowProgress(DoneNumber,MessageNumber,Pm_Percent);
      MemoDate := GetStandardizeMemoDate(LocDummyMemo);
      MessageID := GetMessageID(LocDummyMemo);
      WHILE ( MemoDate >= StartDate) AND (MessageID <> LastMessageID) DO
      BEGIN
         BuildReference(DummyMemo);
         ADo('NextMessage');
         GetMessageBody(LocDummyMemo);
         IF LocDummyMemo.Lines.COunt > 0 THEN
         BEGIN
            MemoDate := GetStandardizeMemoDate(LocDummyMemo);
            DoneNumber := DoneNumber+1;
            ShowProgress(DoneNumber,MessageNumber,Pm_Percent);
            MessageID := GetMessageID(LocDummyMemo);
         END;
         IF Halt THEN
            Exit;
      END;
   END;


   PROCEDURE MarkNonAnsweredMessages( var LocDummyMemo : TMemo);

   BEGIN
      ProgressForm.Caption := 'Marking Singleton';
      {actual message number is known : pm_ratio shows it}
      ShowProgress(DoneNumber,MessageNumber,Pm_Ratio);
      {Mark all first message that is not referenced by another message}
      WHILE MessageID <> FirstMessageID DO
      BEGIN
         MessageID := GetMessageID(LocDummyMemo);
         {skip messages with body not loaded}
         IF  LocDummyMemo.Lines.Count > 0 THEN
           {No reference: first of a dscussion}
            IF GetHeaderInfo(ReferenceHeader, LocDummyMemo) = '' THEN
           {No reference to it: singleton}
              IF FirstReferenceList.IndexOf(MessageID)=-1 THEN
                  Ado(Flag);
         ADo('PreviousMessage');
         GetMessageBody(DummyMemo);
         DoneNumber := DoneNumber+1;
         ShowProgress(DoneNumber,MessageNumber,Pm_Ratio);
         IF Halt THEN
            Exit;
      END;
     {proceed newest post}
      IF GetHeaderInfo(ReferenceHeader, DummyMemo) = '' THEN
         IF FirstReferenceList.IndexOf(MessageID)=-1 THEN
               Ado(Flag)
   END;

   PROCEDURE BuildDummyContainers;

   BEGIN
      DummyMemo := tmemo.Create(DummyForm);
      DummyMemo.Parent := DummyForm;
   {have a large enought width to avoid wrap around lines}
      DummyMemo.Width := Application.Mainform.width;
   END;

Begin
   {just to avoid a bad swich when no record match}
   ADo('ClearMarkerList');
   {have a mark to go back where we come from}
   ADo('AddMarker');
   ScriptForm := tform.create(Nil);
   {Store info on view in use}
   ViewInUse := GetViewInUse;
   try
   {have all messages available}
   ADo('View1');{if View1 was modified from default, adaptation required}
   BuildScriptForm;
   {structure to store the message that are first reference in references}
   FirstReferenceList := TStringList.Create;
   FirstReferenceList.Sorted := True; {to avoid duplicates}
   ScriptForm.ShowModal;
   DummyForm := tform.Create(nil);
   try
   BuildDummyContainers;
   ProgressForm:=tform.create(nil);
   try
   SetProgressFormStructure;
   {do estimation of the number of messages to process}
   InformationForm := TForm.Create(nil);
   try
   BuildInformationForm;
   InformationDone := false;
   InformationForm.Show;
   MessageNumber:=GetMessageNumberEstimation(DummyMemo);
   InformationDone := true;
   InformationForm.Hide;
   finally
   InformationForm.Free;
   end;
   lockdisplay;
   SortInUse := GetSortOrder;
   MessageByDateDecreasingOrder;
   try
   {Show the progressform with an adapted caption}
   ProgressForm.Caption := 'Find Range to test';
   ProgressForm.Show
   ShowProgress(0,MessageNumber,Pm_Percent);
   {pick the first message ID as stop mark}
   ADo('FirstMessage');
   GetMessageBody(DummyMemo);
   {at least one non empty body message must be in the
   group to avoid infinite loop.
   It's under user responsibility}
   WHILE DummyMemo.Lines.Count = 0 DO
   {skip all empty body message from the begining}
   BEGIN
      Ado('NextMessage');
      GetMessageBody(DummyMemo);
      DoneNumber := DoneNumber+1;
      ShowProgress(DoneNumber,MessageNumber,Pm_Percent);
      IF Halt THEN
         Exit;
   END;
   ADo('AddMarker'); {first non empty message}
   HeadersAreHidden := AreHeadersHidden(DummyMemo);
   IF HeadersAreHidden THEN
   {Header not displayed, display them}
      ADo('ShowHeaders');
   try
   Ado('LastMessage');
   GetMessageBody(DummyMemo);
   WHILE (DummyMemo.Lines.Count = 0) DO
   {skip all empty body message from the end}
   BEGIN
      Ado('PreviousMessage');
      GetMessageBody(DummyMemo);
      DoneNumber := DoneNumber+1;
      ShowProgress(DoneNumber,MessageNumber,Pm_Percent);
      IF Halt THEN
         Exit;
   END;
   LastMessageID :=  GetMessageID(DummyMemo);
   Ado('GotoPreviousMarker');  {back to first non empty message}
   GetMessageBody(DummyMemo);
   FindNewestEndDateAndBuildReferenceList(DummyMemo);
   IF Halt THEN
      Exit;
   {stop mark on newest message in date range}
   FirstMessageID := GetMessageID(DummyMemo);
   {Skip and part of out of range messages are no more in message count}
   MessageNumber := MessageNumber-DoneNumber;
   DoneNumber:=0;
   {build the first reference message list for targeted messages}
   FindOldestStartDateAndBuildReferenceList(DummyMemo);
   IF Halt THEN
      Exit;
   MessageNumber := DoneNumber+1; {only messages between date targets}
   DoneNumber := 0;
   MarkNonAnsweredMessages(DummyMemo);
   ProgressForm.Hide;

   finally
   SetCheckRevSortBy(ReverseOrder)
   IF HeadersAreHidden 	THEN
      Ado('ShowHeaders');
   end;
   finally
   unlockdisplay;
   SetSortOrder(SortInUse);
   end;
   finally
   Progressform.free;
   {and to see the results, if the flag is 'AddBookmark'}
   ADo('Bookmarks');
   end;
   finally
   FirstReferenceList.free;
   dummyform.free;
   IF Halt then
     writeln('Aborted by User')
   end;
   finally
   ATimer.free;
   ScriptForm.free;
   Ado(ViewInUse);
   ADo('GoToPreviousMarker');
   ADo('HeaderlistPane');
   Ado('RefreshView');
   end;
end.