AnalyseMessages

From 40tude Dialog Wiki

This program counts the number of messages from each sender in a group and how many lines are sent by each sender.

This program was mainly done to explore and learn the Dialog scripting language. It can be adapted to fit your needs.


Program AnalyseMessages;
{ Version beta 1.0.5 2003/07/23 - 11:15
  only tested with the default display options of each pane.
  Check the source code or save your data before use.
  Version beta 1.0.6 2003/07/31 - 09:22
  GetSystemMetrics no more needed. Form.position := poScreenCenter replace it
  Version beta 1.0.7. 2003/08/10 - 18:30
    AreHeadersHidden bug correction }

(************************************************************
This program was mainly done to explore and learn the Dialog
scripting language. There are certainly better ways to do the
same things (or better things), but it is a start and all
comments and corrections are wellcome. dsam@alain-guerin.com
*************************************************************)
uses
   forms,
   stdctrls;

CONST
  {constant for WIndows dll imported functions}
//   SM_CXMAXIMIZED = 61;
//   SM_CYMAXIMIZED = 62;
// replaced by aform.position := poScreenCenter;
   MB_OK = 0;
   MB_YesNo = 4;
   MB_ICONQUESTION = 32;
   MB_ICONINFORMATION = 64;
   MB_DEFBUTTON2 = 256;
   IDYES = 6;
   IDNO	 = 7;
   {Directory must exist before use}
   IniFileName = 'C:\Mes Documents\Dialog\MessageAnalyse.ini';
   {Tag to detect a given Header}
   FromHeader = 'From: ';
   LineHeader = 'Lines: ';
   MessageIDHeader = 'Message-ID: ';
   ReferenceHeader = 'References: ';
   SubjectHeader = 'Subject: ';
   {Tab to help display and treat the collected information}
   ValueSeparator = #9;
   {fix font for display result form}
   FixFontName = 'Arial Alternative';
   {width of the column of the collected name information}
   UserNameWidth = 50;
   {Raw maximum number of messageq for which the exact number is searched,
    as it seems there are differences in the number of message estimation
    depending on the display when the estimation is done. As the precise
    number is only needed to show the right progress information just to
    help the user wait the end of the treatment, it is not necessary to
    increase the treatment time of a non precise time just to give a
    precise time of the final treatment :-) }
   MaxPrecisionLimit = 250;

TYPE
   {data structure to group information on Dialog
    Header Pane at the start of the script}
   TMessageInfo = RECORD
      MessageNumber : INTEGER;
      ThreadsWereCollapsed : boolean;
      HeadersWereHidden : boolean;
   END;
   {Percent are use when treatment can stop before 100%,
    ratio (done/total) is use when 100% of treatment will
    be done}
   TProgressMode = (PM_Percent, PM_Ratio);

VAR
   ScriptForm : TForm; {use as a nest fot dummy post and edit}
   DummyMemo : TMemo; {work-around for copyclipboard function for lines}
   OptionForm : TForm; {where settings are collected}
   RespectHeaderState : boolean; {option 1}
   RespectCollapseState : boolean; {option 2}
   DisplayProgress : boolean; {option 3}
   MessageInfo : TMessageInfo;
   PreviousMessageId : string;
   MessageID : string;
   ProgressForm : Tform;  {where progress is displayed}
   ProgressEdit : TEdit;
   ProgressLabel : TLabel;
   Info : TStringList; {to be replace by appropriate data structure for other analysis}
   Halt : boolean; {work around of the propagation of an exception that abort the script}

// replaced by aform.position := poScreenCenter;
//   FUNCTION GetSystemMetrics(nIndex:integer):integer; external 'GetSystemMetrics@user32.dll stdcall';
   {as Screen does not work, it is a way to have the width and height of the screen}

   {clipboard windows functions}
   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';

   FUNCTION MessageBox(hWnd: Cardinal; lpText, lpCaption: PChar; uType: longword): Integer; external 'MessageBoxA@user32.dll stdcall';

   PROCEDURE ClearCLipboard;
   {to avoid side effects: if an empty selection is copyed in the clipboard}
   BEGIN
      OpenClipboard(Application.Handle);
      EmptyClipboard;
      CloseClipboard;
   END;

   PROCEDURE BtClick (Sender : TObject);

   BEGIN
   {be sure it is use with a sender that is a button and that has a parent form}
      TForm(TButton(Sender).Parent).Close
   END;

   PROCEDURE SelectOptions;

   VAR
      {A textfile is not completly available, Tlist property are use to read and
      write text files}
      FileStringList : TStringList;
      {controls of the option form}
      ChBxRespectHeaderState : TCheckBox;
      ChBxRespectCollapseState : TCheckBox;
      ChBxDisplayProgress : TCheckBox;
      LbOptions : TLabel;
      BtOk : TButton;

      FormCaptionHeight : INTEGER;

   BEGIN
      FileStringList := TStringList.create;
      FileStringList.LoadFromFile(IniFileName);
      {init option information if available}
      RespectHeaderState := uppercase(FileStringList.Values['Respect Header State']) = 'TRUE';
      RespectCollapseState := uppercase(FileStringList.Values['Respect Collapse State']) = 'TRUE';
      DisplayProgress := uppercase(FileStringList.Values['Show Progress']) = 'TRUE';
      OptionForm := TForm.Create(Application.MainForm);
      try
      {optionform design}
      OptionForm.Caption := 'Option selection';
      FormCaptionHeight :=OptionForm.Height-OptionForm.ClientHeight;
      LbOptions := TLabel.Create(OptionForm);
      LbOptions.Parent := OptionForm;
      LbOptions.Caption := 'Choose the wished options and press OK';
      OptionForm.Width := LbOptions.Width + LbOptions.Width DIV 3;
      LbOptions.Left := OptionForm.Width DIV 8;
      LbOptions.Top :=(OptionForm.Height-FormCaptionHeight ) DIV 10;
//      OptionForm.Top := (GetSystemMetrics(SM_CYMAXIMIZED) - OptionForm.Height) DIV 2;
//      OptionForm.Left := (GetSystemMetrics(SM_CXMAXIMIZED) - OptionForm.Width) DIV 2;
      OptionForm.position := poScreenCenter;
      ChBxRespectHeaderState := TCheckBox.Create(OptionForm);
      ChBxRespectHeaderState.Parent := OptionForm;
      ChBxRespectCollapseState := TCheckBox.Create(OptionForm);
      ChBxRespectCollapseState.Parent := OptionForm;
      ChBxDisplayProgress := TCheckBox.Create(OptionForm);
      ChBxDisplayProgress.Parent := OptionForm;
      ChBxRespectHeaderState.Left := OptionForm.Width DIV 8;
      ChBxRespectCollapseState.Left := ChBxRespectHeaderState.Left;
      ChBxDisplayProgress.Left := ChBxRespectHeaderState.Left;
      ChBxRespectHeaderState.Top := (OptionForm.Height-FormCaptionHeight ) DIV 5 * 2-LbOptions.Top;
      ChBxRespectCollapseState.Top := (OptionForm.Height-FormCaptionHeight) DIV 5 * 3-LbOptions.Top;
      ChBxDisplayProgress.Top := (OptionForm.Height-FormCaptionHeight) DIV 5 * 4-LbOptions.Top;
      ChBxRespectHeaderState.Caption := 'Respect &Header State';
      ChBxRespectHeaderState.Width := LbOptions.Width;
      ChBxRespectCollapseState.Caption := 'Respect &Collapse State';
      ChBxRespectCollapseState.Width := LbOptions.Width;
      ChBxDisplayProgress.Caption := 'Show &Progress';
      ChBxDisplayProgress.Width := LbOptions.Width;
      ChBxRespectHeaderState.Checked := RespectHeaderState;
      ChBxRespectCollapseState.Checked := RespectCollapseState;
      ChBxDisplayProgress.Checked  :=DisplayProgress;
      BtOk := TButton.Create(OptionForm);
      BtOk.Parent := OptionForm;
      BtOk.Caption := '&Ok';
      BtOk.Top := ChBxDisplayProgress.Top+ChBxDisplayProgress.Height+BtOk.Height DIV 2;
      BtOk.Left  := (OptionForm.Width-BtOk.Width) DIV 2;
      BtOk.OnClick := @BtClick;
      OptionForm.ActiveControl := BtOK;
      {option selection by user}
      OptionForm.ShowModal;
      {options backup}
      RespectHeaderState := ChBxRespectHeaderState.Checked;
      RespectCollapseState := ChBxRespectCollapseState.Checked;
      DisplayProgress :=ChBxDisplayProgress.Checked;
      FileStringList.Clear;
      IF RespectHeaderState THEN
         FileStringList.Add('Respect Header State=TRUE')
      ELSE
         FileStringList.Add('Respect Header State=FALSE');
      IF RespectCollapseState THEN
         FileStringList.Add('Respect Collapse State=TRUE')
      ELSE
         FileStringList.Add('Respect Collapse State=FALSE');
      IF DisplayProgress THEN
         FileStringList.Add('Show Progress=TRUE')
      ELSE
         FileStringList.Add('Show Progress=FALSE');
      FileStringList.SaveToFile(IniFileName);
      finally
         OptionForm.Free;
         {we hope that also frees the children of the form}
      end;
   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 DisplayProgress THEN
      BEGIN
         IF Not ProgressForm.visible THEN
         BEGIN
         {the user can abort the treatment by closing the progress window and
          answering yes to the message box}
            IF MessageBox(0, 'Abort ?', 'User interruption',
               MB_YesNo OR MB_ICONQUESTION   OR MB_DEFBUTTON2) = IDYes
            THEN
            BEGIN
         {abort program}
               Halt := True;
               Exit;
            END
            ELSE
         {restore progress window}
             ProgressForm.Show
         END
         {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
   END;

   PROCEDURE ProgressFormOn(ProgressInfo : String);
   {Show the progressform with an adapted caption}
   BEGIN
      IF  DisplayProgress THEN
      BEGIN
         ProgressForm.Caption := ProgressInfo;
         ProgressForm.Show
      END;
   END;

   FUNCTION AreHeadersHidden(var LocDummymemo : tmemo):boolean;

   VAR
      index : integer;

   BEGIN
      result := true;
      IF LocDummyMemo.Lines.count > 5 THEN
      {IF  less than 6 lines, headers are not displayed}
      BEGIN
        {a scan of all line 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 a blank line after them}
         BEGIN
            index := index+1;
            result := Pos('Newsgroups: ', LocDummyMemo.Lines.strings[index]) = 0
         END;
      END;
   END;

   PROCEDURE GetMessageBody (VAR LocDummymemo : tmemo);

   BEGIN
     {Select the message body, select all text and copy it in a data struture
      where text can be analysed}
      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 SkipToNextNonEmptyBodyMessage(VAR LocDummymemo : tmemo):boolean;

   VAR
      PreviousTitle : string;
      DummyEdit : TEdit;
      Title : String;

   BEGIN
      {copy from the TitlePane does not work if display is locked}
      unlockdisplay;
      LocDummymemo.Clear;
      DummyEdit := TEdit.Create(ScriptForm);
      try
      DummyEdit.Parent := ScriptForm;
      ADo('HeaderlistPane');
      Ado('Copy');
      DummyEdit.PasteFromClipboard;
      Title := DummyEdit.Text;
      PreviousTitle := '';
      REPEAT
         ADo('NextMessage');
         GetMessageBody(LocDummyMemo);
         previousTitle := Title;
         DummyEdit.Clear;
         ADo('HeaderlistPane');
         Ado('Copy');
         DummyEdit.PasteFromClipboard;
         Title := DummyEdit.Text;
      UNTIL  (LocDummymemo.Lines.Count <> 0) {non empty body}
      OR (Title = PreviousTitle); {last message in pane}
      result := (Title <> PreviousTitle) AND (LocDummymemo.Lines.Count > 0);
      finally
      lockdisplay;
      DummyEdit.free;
      end;
   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
            Result := LocDummymemo.lines.Strings[index] {at least the headertitle}
         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 := ExtractHeaderLine('Message-ID:', LocDummymemo);
   end;

   FUNCTION GetMessageNumberEstimation(LocDummyMemo : TMemo) : INTEGER;

   BEGIN
      {it 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 lines}
      ADo('HeaderlistPane');
      Ado('SelectAll');
      Ado('Copy');
      LocDummyMemo.PasteFromClipboard;
      Result := LocDummyMemo.Lines.Count;
   END;


   FUNCTION GetGroupMessageNumber(VAR LocDummyMemo : TMemo) : INTEGER;

   VAR
     RawTotal : INTEGER;

   BEGIN
      LocDummyMemo.Clear;
      Result :=0;
      ProgressFormOn('Actual # check');
      RawTotal := GetMessageNumberEstimation(LocDummyMemo);
      {ADo('HeaderlistPane'); done in GetMessageNumberEstimation}
      ADo('FirstMessage');
      PreviousMessageId:='';
      GetMessageBody(LocDummyMemo);
      MessageID := GetMessageID(LocDummyMemo);
      IF RawTotal > MaxPrecisionLimit THEN
         Result := RawTotal - Rawtotal DIV 10 {while not :-)}
       ELSE
       BEGIN
      {Count all messages from the first to the last}
         WHILE MessageID <> PreviousMessageId DO
         BEGIN
            Result := Result+1;
            ShowProgress(Result,RawTotal,PM_Percent);
            IF Halt THEN
               Exit;
            PreviousMessageId:=MessageID;
            ADo('NextMessage');
            GetMessageBody(DummyMemo);
            MessageID :=GetMessageId(Dummymemo);
            IF MessageID = '' THEN
         {empty body message}
               IF SkipToNextNonEmptyBodyMessage(Dummymemo) THEN
               {if false, the last message is reached and is empty}
                  MessageID :=GetMessageId(Dummymemo);
         END;
      END;
      ProgressForm.Hide;
   END;

   FUNCTION AreThreadsCollapsed(VAR LocDummyMemo : TMemo) : boolean;
   {If 'sort by' is not one of the thread options, the threads are not expanded
    but the expande and collapse commands have no action and all messages
    can be analysed so the result of this function has no action on the
    result of analyse.
    If 'sort by' is one of the thread options, we have to detect if the threads
    are expanded or not, if we want : a) treat all messages b) let the display
    more or less as we found it before treatment}
   VAR
      Buffer : string;
      DummyEdit : TEdit;
      PreviousMessageId : string;
      MessageID : string;
      Found : boolean;
      MessageCounter : INTEGER;
      RawTotal : INTEGER;

   BEGIN
      result := false;
      ProgressFormOn('Thread state scan');
      DummyEdit := TEdit.Create(ScriptForm);
      try
      DummyEdit.Parent := ScriptForm;
      RawTotal := GetMessageNumberEstimation(LocDummyMemo);
      {ADo('HeaderlistPane'); done in GetMessageNumberEstimation}
      ADo('FirstMessage');
      GetMessageBody(LocDummyMemo);
      MessageCounter := 0;
      PreviousMessageId :='';
      MessageID := GetHeaderInfo(MessageIDHeader, LocDummyMemo);
      IF MessageID = '' THEN
         {empty body message}
         IF SkipToNextNonEmptyBodyMessage(Dummymemo) THEN
         BEGIN
{           GetMessageBody(DummyMemo); }
            MessageID :=GetMessageId(Dummymemo);
         END;
      {Search a post that has a follow-up}
      Found := false;
      WHILE (MessageID <> PreviousMessageId) AND Not Found DO
      BEGIN
         MessageCounter :=MessageCounter+1;
         ADo('NextMessage');
         {a follow up has the reference of the previous message in reference}
         Found :=  POS(PreviousMessageID,ExtractHeaderLine(ReferenceHeader,LocDummyMemo)) > 0;
         PreviousMessageId :=MessageID;
         GetMessageBody(LocDummyMemo);
         ShowProgress(MessageCounter, RawTotal, PM_Percent);
         IF Halt THEN
            Exit;
         MessageID :=  GetHeaderInfo(MessageIDHeader, LocDummyMemo);
         IF MessageID = '' THEN
         {empty body message}
            IF SkipToNextNonEmptyBodyMessage (Dummymemo) THEN
            BEGIN
{               GetMessageBody(DummyMemo); }
               MessageID :=GetMessageId(Dummymemo);
            END;
      END;
      IF Found THEN
      BEGIN
         ADo('PreviousMessage');
         unlockdisplay; {if not copy does not work}
         ADo('HeaderlistPane');
         Ado('Copy');
         DummyEdit.clear;
         DummyEdit.PasteFromClipboard;
         Buffer := DummyEdit.Text;
         Result := ((POS(chr(9),Buffer) = 1) AND (pos('[',Buffer) = 2));
         lockdisplay;
      END
      ELSE
         Result := True;
      finally
      DummyEdit.Free;
      ProgressForm.Hide;
      end
   END;


   PROCEDURE AddInfo (VAR LInfo : TStringList; LName,LLineNumber : string);
 { to be adapted depending on the data structure and analyse to be done}
   VAR
      Buffer : STRING;
      PrevLineCount : integer;
      PrevCount : integer;
   {This procedure sums for each participant the number of posts and the total
    number of lines sent}
   BEGIN
      Buffer := LInfo.Values[LName];
      IF Buffer = '' THEN
      {new entry : init counter to 1 and add info}
         LInfo.Add(LName+'='+'1'+ValueSeparator+LLineNumber)
      ELSE
      BEGIN
         PrevCount := StrToInt(Copy(Buffer,1,pos(ValueSeparator,Buffer)-1));
         {Previous info is decoded}
         PrevLineCount := StrToInt(Copy(Buffer, pos(ValueSeparator,Buffer)+1,Length(buffer)-pos(ValueSeparator,Buffer)));
         {count of posts increased? countof lines is summed and info replaced}
         LInfo.Values[LName] := IntToStr(PrevCount+1)+ValueSeparator+IntToStr(PrevLineCount+strtoint(LLineNumber));
      END;
   END;

   PROCEDURE ADoMessage(VAR LocDummymemo : tmemo;VAR LInfo : TStringList);
 { to be adapted depending on the data structure and analyse to be done}

   VAR
      BufferFrom : string;
      BufferLine : string;
      Position : INTEGER;

   BEGIN
      {Who is the sender ?}
      BufferFrom := GetHeaderInfo( FromHeader, LocDummymemo);
      {do appropriate treatment to the analyse purpose}
      Position := Pos('<', BufferFrom);
      {here we try to extract the name of the message from : header without e-address}
      IF Position > 0 THEN
         BufferFrom := Copy(BufferFrom, 1, Position-1);
      Position := Pos('@', BufferFrom);
      IF Position > 0 THEN
         IF pos('.',BufferFrom) > Position THEN
         {@ could be use in a name like F@ust by funny guys.
          But it will be seen as an address start if a dot something is also present.
          Coping with all cases is above computer (programmer) competence }
            BufferFrom := Copy(BufferFrom, 1, Position-1);
      {If name is between quotes, delete quotes}
      BufferFrom := Trim(BufferFrom);
      Position := Length(BufferFrom);
      IF Position > 1 THEN
         IF (BufferFrom[1]='"') AND (BufferFrom[ Position ]='"') THEN
            BufferFrom := copy(BufferFrom,2, Position - 2);
      {length ajustment to have a well design display}
      BufferFrom := PadR(BufferFrom, UserNameWidth);
      BufferFrom := Copy(BufferFrom, 1,UserNameWidth);
      {Number of writen lines is extracted}
      BufferLine := GetHeaderInfo(LineHeader, LocDummymemo);
      {sum the info with previous information}
      AddInfo(LInfo, BufferFrom, BufferLine);
   END;

   PROCEDURE AnalyseAllMessages(VAR LocDummymemo : tmemo);

   {never hide headers in this procedure and the called procedure, as the header
    must always be displayed to analyse messages}

   VAR
      MessageCounter : INTEGER;

   BEGIN
      MessageCounter:=0;
      ADo('FirstMessage');
      GetMessageID(DummyMemo);
      PreviousMessageId := '';
      MessageID:=GetMessageId(Dummymemo);
      IF MessageID = '' THEN
      {Empty message body : exclude from analysis}
        SkipToNextNonEmptyBodyMessage(Dummymemo);
   {display a windows to help waiting the end of the treatment}
      ProgressFormOn('Message Analysis');
   {analyse all messages in group}
      WHILE (MessageID <> PreviousMessageId) DO
      BEGIN
         ADoMessage(DummyMemo, Info);
         MessageCounter := MessageCounter+1;
         ShowProgress(MessageCounter,MessageInfo.MessageNumber,PM_Ratio);
         IF Halt then Exit;
         ADo('NextMessage');
         GetMessageBody(DummyMemo);
         PreviousMessageId:=MessageID;
         MessageID := GetMessageId(Dummymemo);
         IF MessageID = '' THEN
         {empty body message}
            IF SkipToNextNonEmptyBodyMessage(Dummymemo) THEN
            BEGIN
               GetMessageBody(DummyMemo);
               MessageID :=GetMessageId(Dummymemo);
            END;
      END;
      ProgressForm.Hide;
   END;

   FUNCTION maxi(a,b : integer):integer;

   BEGIN
      if a > b then
         result := a
      else
         result := b
   END;

   PROCEDURE DisplayResult(var LocInfo : TStringList);

   VAR
      DisplayMemo : TMemo; {to be replace by  appropriate display structure for other analysis}
      LabelName : TLabel;
      LabelPost : TLabel;
      LabelLines: TLabel;
      LabelMessageNumber : TLabel;
      EditMessageNumber : TEdit;
      BtQuit : TButton;
      LabelsHeight : INTEGER;
      Index : INTEGER;
      InfoBuffer : string;
      SortedList :TStringList;

   BEGIN
      IF LocInfo.Count = 0 THEN
      {if no group is selected or group messages have no body (far from perfect :-)}
         messageBox(0, 'Nothing to display',
             'Data Collection Failure' ,MB_OK OR MB_ICONINFORMATION )
      ELSE
      BEGIN
         {Create form to display results}
         {Label created here to have a canvas available}
         LabelName := TLabel.Create(ScriptForm);
         {I had problems when trying to sort the non empty info list}
         SortedList := TStringList.Create;
         try
         SortedList.Sorted := true;
         LabelName.Parent := ScriptForm;
         LabelName.Font.Name :=  FixFontName;
         LabelsHeight := LabelName.Canvas.TextHeight('j')+2;
         ScriptForm.width :=  maxi((application.mainform.width - application.mainform.width div 5),
            UserNameWidth+LabelName.Canvas.TextWidth('10000 ')*2);
         ScriptForm.height :=  application.mainform.height - application.mainform.height div 5;      ScriptForm.top := (application.mainform.height - ScriptForm.height) DIV 2;
         ScriptForm.left := (application.mainform.width - ScriptForm.width) DIV 2;
         DisplayMemo := TMemo.create(ScriptForm);
         try
         DisplayMemo.Parent := ScriptForm;
         DisplayMemo.Font.Name := FixFontName;
         DisplayMemo.Width := maxi(ScriptForm.Width *2 DIV 3,
                              LabelName.Canvas.TextWidth('M')*UserNameWidth+
                              LabelName.Canvas.TextWidth('10000 10000 '));
         DisplayMemo.Height := ScriptForm.ClientHeight-LabelsHeight-LabelName.Canvas.TextHeight('M')*3;
         DisplayMemo.Left := (ScriptForm.width-DisplayMemo.width) DIV 2;
         DisplayMemo.Top := (LabelsHeight-1)*2;
         {Modify data info to fit the display and be copy n paste in another application}
         FOR Index := 0 TO LocInfo.Count-1 DO
         BEGIN
            InfoBuffer := LocInfo.strings[Index];
            insert(' '#9,InfoBuffer, UserNameWidth+1);
            LocInfo.strings[Index]:= InfoBuffer;
         END;
         {sort info whithout problem}
         SortedList.AddStrings(LocInfo);
         DisplayMemo.Lines := SortedList;
         DisplayMemo.ReadOnly := true;
         LabelName.Top := DisplayMemo.Top-(LabelsHeight*3)DIV 2;
         LabelName.Left := DisplayMemo.Left;
         LabelName.Caption := '&User name';
         LabelName.FocusControl := DisplayMemo;
         LabelPost := TLabel.Create(ScriptForm);
         try
         LabelPost.Parent := ScriptForm;
         LabelPost.Top := LabelName.Top;
         LabelPost.Font.name := FixFontName;
         LabelPost.Left := LabelName.Left+ LabelName.Canvas.TextWidth(LocInfo.strings[0])+1;
         LabelPost.Caption := 'Post #';
         LabelLines:= TLabel.Create(ScriptForm);
         try
         LabelLines.Parent := ScriptForm;
         LabelLines.Top := LabelName.Top;
         LabelLines.Font.name := FixFontName;
         LabelLines.Left := LabelPost.Left+ LabelPost.Canvas.TextWidth('123456789');
         LabelLines.Caption := 'Lines #';
         LabelMessageNumber:= TLabel.Create(ScriptForm);
         try
         LabelMessageNumber.Parent := ScriptForm;
         LabelMessageNumber.Top := DisplayMemo.Top+DisplayMemo.Height+ 1;
         LabelMessageNumber.Left:= 10;
         LabelMessageNumber.Font.name := FixFontName;
         LabelMessageNumber.Caption := '&Number of Messages: ';
         EditMessageNumber := TEdit.Create(ScriptForm);
         LabelMessageNumber.FocusControl :=EditMessageNumber;
         try
         EditMessageNumber.Parent := ScriptForm;
         EditMessageNumber.Top := LabelMessageNumber.Top;
         EditMessageNumber.Left := LabelMessageNumber.Left+LabelMessageNumber.Width+2;
         EditMessageNumber.Text := IntToStr(MessageInfo.MessageNumber);
         EditMessageNumber.ReadOnly := True;
         BtQuit := TButton.Create(ScriptForm);
         BtQuit.Parent := ScriptForm;
         BtQuit.Caption := '&Quit';
         BtQuit.Top := LabelMessageNumber.Top;
         BtQuit.Left:= (ScriptForm.Width - BtQuit.Width) DIV 2;
         BtQuit.OnClick := @BtClick;
         ScriptForm.Showmodal;
         {I don't know if a form release its children or not}
         finally
         EditMessageNumber.free;
         end;
         finally
         LabelMessageNumber.Free;
         end;
         finally
         LabelLines.free;
         end;
         finally
         LabelPost.free;
         end;
         finally
         DisplayMemo.free;
         end;
         finally
         LabelName.free
         end;
      END;
   END;

   PROCEDURE SetProgressFormPosition;

   BEGIN
      ProgressForm.Top := Application.MainForm.Top;
      ProgressEdit.parent:=ProgressForm;
      {place the progressform in the middle of the screen}
//      ProgressForm.Left := (GetSystemMetrics(SM_CXMAXIMIZED) - ProgressForm.Width) DIV 2;
//      ProgressForm.Top := (GetSystemMetrics(SM_CYMAXIMIZED) - ProgressForm.Height) DIV 2;
      ProgressForm.position := poScreenCenter;
      ProgressEdit.left:=(ProgressForm.width-ProgressEdit.width) div 2;
      ProgressEdit.top:=(ProgressForm.height-ProgressEdit.height) div 2;
      ProgressEdit.ReadOnly := true;
   END;

Begin
   SelectOptions;
   ScriptForm := tform.create(Nil);
   try
   ADo('AddMarker');
   lockdisplay;
   DummyMemo := tmemo.Create(ScriptForm);
   try
   DummyMemo.Parent := ScriptForm;
   {have a large enought width to avoid wrap around lines}
   DummyMemo.Width := Application.Mainform.width*2;
   {have a mark to go back where we come from}
   ProgressForm:=tform.create(nil);
   try
   ProgressEdit:=Tedit.create(ProgressForm);
   ProgressEdit.Parent := ProgressForm;
   ProgressLabel := TLabel.Create(ProgressForm);
   ProgressLabel.Parent := ProgressForm;
   SetProgressFormPosition;
   ProgressLabel.Caption := 'To abort, first close the window';
   ProgressLabel.Top := ProgressForm.ClientHeight-ProgressLabel.Height*2;
   {header must be displauyed to have all the needed information}
   GetMessageBody(DummyMemo);
   {if header are not displayed, 'getmessageid' return an empty string}
   MessageInfo.HeadersWereHidden := GetMessageID(DummyMemo) = '';
   IF Halt THEN
      Exit;
   {If they were hidden, display them}
   IF MessageInfo.HeadersWereHidden THEN
      ADo('ShowHeaders');
   {store the expand state information}
   MessageInfo.ThreadsWereCollapsed := AreThreadsCollapsed(DummyMemo);
   {IF not, expand them, and if at least one thread is expanded, expand all}
   IF Halt THEN
      Exit;
    ADo('ExpandAllThreads')
   {it's too time consumming and to complicated to store, thread by thread
    the expanse/collapse status}
   MessageInfo.MessageNumber := GetGroupMessageNumber(DummyMemo);
   {prepare data collection}
   Info := TStringList.Create;
   try
   AnalyseAllMessages(DummyMemo);
   IF Halt THEN
      Exit;
   IF MessageInfo.Threadswerecollapsed AND RespectCollapseState THEN
      ADo('CollapseAllThreads');
   IF MessageInfo.HeaderswereHidden AND RespectHeaderState then
      ADo('ShowHeaders');
   Finally
   Progressedit.free;
   Progressform.free;
   end;
   DummyMemo.Clear;
   DummyMemo.Hide;
   DisplayResult(Info);
   finally
   Info.free;
   end;
   finally
   DummyMemo.free;
   end;
   finally
   unlockdisplay;
   ADo('GoToPreviousMarker');
   ScriptForm.free;
   end;
End.