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.


PostShow.png

In addition, when the memo is displayed you have the following choices:

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