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.