PostShow
From 40tude Dialog Wiki
Contents |
OnBeforeSavingMessage and PostShow scripts (v1.4)
With these two scripts you can have a memo to show the list of the arrived replies to your posts, within a specified range of depth, e.g.: 1 for direct replies, 2 to include also replies to direct replies, and so on...
Of course, to achieve it you must have a unique FQDN in your posts.
Be aware that replies identification is established upon your FQDN, and that your own messages won't be registered in the memo.
In the first row of every note you can see its depth (indented differently by its number) and the number of the note (inside square brackets).
In addition, every note displays the fields you do want to see: From (reply's author), NG (newsgroup or newsgroups list where the reply was sent), Subject (message subject), Date (date and time of the reply) and Message-ID (identifier of the reply). All these fields appear in the memo by default.
It's also possible to specify which newsgroups you don't want to be monitored by the scripts: this is useful for high traffic newsgroups, where the number of the replies could be very high, and the memo would be jammed. Therefore, if the newsgroup name is in your exclusion list, no one reply in that newsgroup (also crossposted) will be registered in the memo. This way you can winnow the replies to you.
You can also choose what happens if you call PostShow when the memo is still empty: to hear a sound of your choice, or to have the empty memo displayed.
In addition, when the memo is displayed you have the following choices:
- to delete all the list (with the "Reset All" button);
- to delete one note (double-clicking on its number or dragging the mouse over it, and eventually pressing the "Delete Note" button);
- to go to the message (double-clicking on its Message-ID and pressing Ctrl+V and Enter in the following window);
- to keep the list (with the "Continue" button, or "Enter", or "Esc").
You'll create a button in the toolbar and/or a hotkey to call the PostShow script.
Be careful to not delete the notes while you're downloading the message bodies, because you could delete the new notes that the script is writing.
Every script needs that you set some information: the path of your choice for the file Post.txt, your unique FQDN, the path for your preferred sounds if you want them, or, without sounds, if you want the memo displayed even if there are no replies. Furthermore, if you want you can put your preferences for other aspects: the depth until the replies will be registered (by default is 4), the list of newsgroups to exclude (by default is empty), the fields you want to be displayed (by default all 6 are recorded), the colors, the font, the font size and style, the window size...
To do it, read the comments in the settings section of both the scripts.
You don't have to create the file Post.txt: the script PostShow creates it, if it doesn't exist.
Tested successfully on Dialog 2.0.15.1 (Beta 38)
Many thanks to Enrico C and daRkSidE for their hard work of "beta testers" :-) and their helpful hints.
Thanks also to Alien321 who solved a problem I had when the References in the headers could fold.
28 April 2005 Update
It's available an include script for the OnBeforeSavingMessage event, see OBSav for PostShow.
Remember however that you still need the PostShow.ds script (see Section 2 in this page).
1) OnBeforeSavingMessage
In Event Scripts copy this code in OnBeforeSavingMessage, then save and compile:
program OnBeforeSavingMessage; //(v1.4)
//---------------------------- Settings ---------------------------------//
const
filePost = 'C:\Programmi\40tude Dialog\Post.txt';
// write your path for the file that will be created by this script
myFQDN = 'ID-187316.user.uni-berlin.de';
// write your FQDN
depth = 4;
// set your preferred depth
ExcludeNG = '';
// enter (comma separated) the newsgroups names for which you don't
// the replies to be registered by the script; for example:
// 'alt.discussions.aboutall, it.litigi.senzafine, free.it.chat';
// commas are essential, spaces around commas aren't regarded.
withFrom = true; //author recorded? true / false
withNG = true; //newsgroup recorded? true / false
withSubj = true; //subject recorded? true / false
withDate = true; //date and time recorded? true / false
withMsgID = true; //Message-ID recorded? true / false
//-------------------------- End Settings -------------------------------//
//(you don't need to change anything else in this script)
function GetReferences(Message: TStringList): string;
var
i: integer;
tempStr:String;
begin
i:=0;
result:='';
while (i < Message.count-1) do
begin
if pos('References: ', Message.Strings[i])>0 then
begin
tempStr:=copy(Message.Strings[i],pos('<',Message.Strings[i]),Length(Message.Strings[i])-1);
i := i+1;
while (i < Message.count-1) and (pos(': ',Message.Strings[i])=0) do
begin
tempStr:=tempStr+Message.Strings[i];
i := i+1;
end; //while
break;
end; //if
i:=i+1;
end; //while
result:=tempStr;
end;
function isFollowingMine(Message: TStringList): boolean;
var
s: string;
begin
s:=GetReferences(Message);
if pos(myFQDN, s)>0 then result:=true
else result:=false;
end;
function WhichDepth(Message: TStringList): integer;
var
i,c,p,thisDepth: integer;
s,t: string;
listFQDN: TStringList;
begin
thisDepth:=0;
s:=GetReferences(Message);
listFQDN:=TStringList.Create();
try
while length(s)>0 do
begin
p:=pos ('>', s);
t:=copy(s,1,p);
listFQDN.Add(t);
s:=copy(s,p+2,length(s)-p-1);
end; //while
c:=listFQDN.Count;
i:=c-1;
while i>=0 do
begin
if pos(myFQDN, listFQDN.Strings[i])>0 then
begin
thisDepth:=c-i;
break;
end; //if
i:=i-1;
end; //while
finally
listFQDN.free;
end; //try
result:=thisDepth;
end;
function GetMsgID(Message: TStringList): string;
var
i: integer;
begin
i:=0;
result:='';
while i < Message.count-1 do
begin
if pos('Message-ID:', Message.strings[i])>0 then break;
i:=i+1;
end; //while
result:=Message.strings[i];
end;
function isMine(Message: TStringList): boolean;
var
mid: string;
begin
mid:=GetMsgID(Message);
if pos(myFQDN, mid)>0 then result:=true
else result:=false;
end;
function GetMessageFrom(Message: TStringList): string;
var
i: integer;
begin
i:=0;
result:='';
while i < Message.count-1 do
begin
if pos('From:', Message.strings[i])>0 then break;
i:=i+1;
end; //while
result:=Message.strings[i];
end;
function GetMessageNG(Message: TStringList): string;
var
i, p: integer;
tempStr:String;
begin
i:=0;
p:=0;
result:='';
while i < Message.count-1 do
begin
p:=pos('Newsgroups: ', Message.Strings[i]);
if p>0 then
begin
tempStr:=copy(Message.Strings[i],p+12,Length(Message.Strings[i])-11);
i := i+1;
while (i < Message.count-1) and (pos(': ',Message.Strings[i])=0) do
begin
tempStr:=tempStr+Message.Strings[i];
i := i+1;
end; //while
break;
end; //if
i:=i+1;
end; //while
result:=tempStr;
end;
function isExcludedNG(s: string): boolean;
var
i, j, c1, c2, p: integer;
temp, t: string;
found: boolean;
listNG, listExcNG: TStringList;
begin
listNG:=TStringList.Create();
listExcNG:=TStringList.Create();
temp:='';
t:='';
found:=false;
try
temp:=s;
while pos(',', temp)>0 do
begin
p:=pos(',', temp);
t:=copy(temp,1,p-1);
listNG.Add(t);
temp:=copy(temp,p+1,length(temp)-p);
end; //while
listNG.Add(temp);
temp:=trim(ExcludeNG);
while pos (',', temp)>0 do
begin
p:=pos (',', temp);
t:=copy(temp,1,p-1);
listExcNG.Add(t);
temp:=trim(copy(temp,p+1,length(temp)-p));
end; //while
listExcNG.Add(temp);
c1:=listNG.Count;
c2:=listExcNG.Count;
i:=0
while (i < c1) and (not found) do
begin
for j:=0 to c2-1 do
begin
if listNG.Strings[i]=listExcNG.Strings[j] then
begin
found:=true;
break;
end; //if
end; //for j
i:=i+1;
end; //while
finally
listNG.free;
listExcNG.free;
end; //try
result:=found;
end;
function GetMessageSubject(Message: TStringList): string;
var
i: integer;
begin
i:=0;
result:='';
while i < Message.count-1 do
begin
if pos('Subject:', Message.strings[i])>0 then break;
i:=i+1;
end; //while
result:=Message.strings[i];
end;
function GetMessageDate(Message: TStringList): string;
var
i: integer;
begin
i:=0;
result:='';
while i < Message.count-1 do
begin
if pos('Date:', Message.strings[i])>0 then break;
i:=i+1;
end; //while
result:=Message.strings[i];
end;
procedure OnBeforeSavingMessage(var Message: TStringlist; Servername: string; IsEmail: boolean);
var
inf, ns, cod, sep1, sep2, indent, ng: string;
list: TStringList;
num,d,i: integer;
begin
ng:=GetMessageNG(Message);
if not(isMine(Message) or IsEmail or isExcludedNG(ng)) then
//is a post not sent by me in a not excluded NG
begin
num:=0;
list := TStringList.Create();
try
d:=WhichDepth(Message);
if (isFollowingMine(Message) and (d<=depth) and (d>0)) then //is a reply inside depth
begin
sep2:=StringOfChar('-', 50);
if fileexists(filePost) then
begin
list.LoadFromFile(filePost);
for i:=0 to list.Count-3 do
if pos(sep2, list.strings[i])<>0 then num:=num+1;
end; //found num of existing notes
ns:=IntToStr(num+1);
if Length(ns)=1 then cod:='[0'+ns+']' else cod:='['+ns+']';
indent:=StringOfChar(' ', 3*(d-1));
sep1:=StringOfChar('-', 3*(d-1))+'D='+IntToStr(d)+StringOfChar('-', 50-3*d);
inf:=sep1+cod+sep2+#13+#10+indent;
if withFrom then inf:=inf+GetMessageFrom(Message)+#13+#10+indent;
if withNG then inf:=inf+'NG: '+GetMessageNG(Message)+#13+#10+indent;
if withSubj then inf:=inf+GetMessageSubject(Message)+#13+#10+indent;
if withDate then inf:=inf+GetMessageDate(Message)+#13+#10+indent;
if withDate then inf:=inf+GetMsgID(Message)+#13+#10;
list.Add(inf);
list.SaveToFile(filePost);
end; //if
finally
list.Free;
end; //try
end; //if
end;
begin
end.
2) PostShow
Create a new Custom Script, name it PostShow, copy the following code, save, compile and create a button/hotkey for it:
Program PostShow; //(v1.4)
uses Forms, StdCtrls;
//---------------------------- Settings ---------------------------------//
const
filePost = 'C:\Programmi\40tude Dialog\Post.txt';
// write your path, the same you wrote in OnBeforeSavingMessage.
withSound1 = true;
// a sound opening the memo? true / false.
withSound0 = false;
// a sound when the memo is empty? true / false.
withMemo = true;
// otherwise the empty memo? true / false.
// (to get it, withSound0 must be false)
soundFile1 = 'C:\windows\media\chimes.wav';
// write your path, and your favorite sound.
soundFile0 = 'C:\Programmi\40tude Dialog\no.wav';
// write your path, and your favorite sound to notify you that the memo is empty.
fColor = clGreen;
// font color; other possibilities are:
// clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clLime, clLtGray,
// clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow.
wBGcolor = clWhite;
// background color; look at the previous color names.
wWidth = 610;
// window width (pixels).
wHeight = 410;
// window height (pixels).
fName = 'Verdana';
// font name; you can change it with another on your box:
// look at "Settings - General Settings - View" for a list of your fonts.
fSize = 8;
// font size.
fItalic = false;
// italic text? true / false
fBold = false;
// bold text? true / false
//-------------------------- End Settings -------------------------------//
//(you don't need to change anything else in this script)
//----------------------------- Info ---------------------------------//
{Create a button in the toolbar and/or a hotkey to call the PostShow script.
When the memo is displayed you have the following choices:
* to delete all the list (with the "Reset" button);
* to delete one note (double-clicking on its number or dragging the mouse over it,
and eventually pressing the "Del Note" button);
* to go to the message (double-clicking on its Message-ID and pressing Ctrl+V and Enter in the following window);
* to keep the list (with the "Continue" button, or "Enter", or "Esc").
Be careful to not delete the notes while you're downloading the message bodies: you could delete the new
notes that the script is writing.}
//-------------------------- End Info -------------------------------//
var
list: TStringList;
num: integer;
PostForm : TForm;
PostMemo : TMemo;
PostBtContinue : TButton;
PostBtReset: TButton;
PostBtDelNote: TButton;
function PlaySound(Filename: PChar; Options: LongWord): Boolean;
external 'sndPlaySoundA@winmm.dll stdcall';
function isMIDselected(m: string): boolean;
var i: integer;
begin
for i:=1 to PostMemo.Lines.Count-1 do
begin
if (pos('Message-ID:',PostMemo.Lines[i])>0) and (pos(m,PostMemo.Lines[i])>0)
and (pos('<',m)>0) then
begin
result:=true;
break;
end
else result:=false;
end;//for
end;
procedure BtPostContinueClick(Sender: TObject);
begin
PostForm.Close;
end;
procedure BtPostResetClick(Sender: TObject);
begin
PostMemo.Text:='';
PostForm.Caption := 'There are no replies.';
PostMemo.Lines.SaveToFile(filePost);
BtPostContinueClick(Sender);
end;
procedure CaptionForm;
begin
case num of
0:
begin
PostForm.Caption := 'There are no replies.';
PostBtReset.enabled:=false;
PostBtDelNote.enabled:=false;
end;
1:
PostForm.Caption := 'There is one reply:';
else
PostForm.Caption := 'There are ' + IntToStr(num) + ' replies:';
end;
end;
function isValid(var s: string): boolean;
var p: integer;
begin
p:=Pos(#13+#10, s);
if p>5 then s:=copy(s,1,p-1);
if Pos(StringOfChar('-', 40), s)>0 then result:=true
else result:=false;
end;
procedure BtPostDelNoteClick(Sender: TObject);
var
note, ns, cod, sep1, sep2, ds: string;
list: TStringList;
i, j, d, n: integer;
begin
sep2:=StringOfChar('-', 50);
note:='';
note:=PostMemo.SelText;
if (note<>'') and isValid(note) then
begin
list := TStringList.Create();
try
list.LoadFromFile(filePost);
for i:=0 to (list.Count-1) do
begin
if pos(note, list.Strings[i])<>0 then break;
end;
list.Delete(i);
j:=i;
n:=0;
while (j < list.Count-1) and (pos('---[', list.Strings[j])=0) do
begin
n:=n+1;
j:=j+1;
end;
for j:=i+n-1 downto i do
list.Delete(j);
if j=list.Count-2 then list.Delete(j+1);
PostMemo.Lines.Assign(list);
n:=list.Count-1;
num:=0;
for i:=0 to n do
if (pos('---[', list.Strings[i])>0) then
begin
num:=num+1;
ns:=IntToStr(num);
if Length(ns)=1 then cod:='[0'+ns+']'
else cod:='['+ns+']';
d:=pos('D=', list.Strings[i]);
ds:=copy(list.Strings[i],d,3);
sep1:=StringOfChar('-', d-1)+ds+StringOfChar('-', 48-d);
list.Strings[i]:=sep1+cod+sep2;
end;
CaptionForm;
PostMemo.Lines.Assign(list);
DeleteFile(filePost);
list.SaveToFile(filePost);
finally
list.Free;
end;
end
else
begin
note:='To delete a note, first double click on its number, please,'+#13+#10+#13+#10;
note:=note+'or drag your mouse to select at least half of its first row.';
Application.MessageBox(note, 'Info', 1);
end;
end;
procedure MemoDblClick(Sender: TObject);
var
msg: string;
begin
msg:='';
msg:=PostMemo.SelText;
if (msg<>'') and (isMIDselected(msg)) then
begin
PostMemo.CopyToClipboard;
Ado('FindMessageID');
PostForm.Close;
end;
end;
Procedure BuildForm;
begin
PostForm := TForm.Create(nil);
PostForm.Height := wHeight;
PostForm.Width := wWidth;
PostForm.position := poScreenCenter;
PostForm.BorderStyle := bsSingle;
PostMemo := TMemo.Create(PostForm);
PostMemo.Parent := PostForm;
PostMemo.Top := 10;
PostMemo.Left := 10;
PostMemo.Height := PostForm.ClientHeight-60;
PostMemo.Width := PostForm.ClientWidth-20;
PostMemo.ScrollBars := ssBoth;
PostMemo.Color := wBGcolor;
PostMemo.Font.Size := fSize;
PostMemo.Font.Name := fName;
PostMemo.Font.Color := fColor;
PostMemo.Font.Style := [];
if fItalic then PostMemo.Font.Style := PostMemo.Font.Style + [fsItalic];
if fBold then PostMemo.Font.Style := PostMemo.Font.Style + [fsBold];
PostMemo.TabStop := false;
PostMemo.ReadOnly := true;
PostBtReset := TButton.Create(PostForm);
PostBtReset.Parent := PostForm;
PostBtReset.Top := PostMemo.Top+PostMemo.Height+PostBtReset.height/2;
PostBtReset.Left := PostForm.Width DIV 2 - PostBtReset.Width-50;
PostBtReset.Caption := '&Reset All';
PostBtReset.OnClick := @BtPostResetClick;
PostBtContinue := TButton.Create(PostForm);
PostBtContinue.Parent := PostForm;
PostBtContinue.Caption := '&Continue';
PostBtContinue.TabOrder := 0;
PostBtContinue.Cancel := true;
PostBtContinue.OnClick := @BtPostContinueClick;
PostBtContinue.Top := PostBtReset.Top;
PostBtContinue.Left := PostBtReset.Left+80;
PostBtDelNote := TButton.Create(PostForm);
PostBtDelNote.Parent := PostForm;
PostBtDelNote.Caption := '&Delete Note';
PostBtDelNote.OnClick := @BtPostDelNoteClick;
PostBtDelNote.Top := PostBtReset.Top;
PostBtDelNote.Left := PostBtContinue.Left+80;
PostMemo.OnDblClick := @MemoDblClick;
end;
procedure FillMemo;
var
sep: string;
i: integer;
begin
list := TStringList.Create();
try
if fileexists(filePost) then
begin
num := 0;
sep:=StringOfChar('-', 50);
list.LoadFromFile(filePost);
PostMemo.Lines.Assign(list);
for i:=0 to list.Count-1 do
if Pos(sep, list.strings[i])<>0 then num:=num+1;
end
else
begin
PostMemo.Text:='';
PostMemo.Lines.SaveToFile(filePost);
end;
finally
list.free;
end;
end;
Begin
try
BuildForm;
FillMemo;
if num>0 then
begin
if withSound1 then PlaySound(soundFile1, 1);
CaptionForm;
PostForm.ShowModal;
end
else
begin
if withSound0 then PlaySound(soundFile0, 1)
else if withMemo then
begin
CaptionForm;
PostForm.ShowModal;
end;
end;
finally
PostForm.free;
end;
End.
Maria Luisa C 28 Aprile 2005