OBSavForPostShow
From 40tude Dialog Wiki
_OBSav_forPostShow_include script
Introduction and notes
The original version of PostShow crowds the "OnBeforeSavingMessage" script with a bunch of code, so I thought it was better to have an include file for it.
Note however that you still need the PostShow.ds custom script, which, called by you with an hotkey or a button, will display the data collected by this "_OBSav_forPostShow_include" script.
Once you have created the "_OBSav_forPostShow_include" script as explained below in the "Setup the script" section, you'll have to add only two lines to your "OnBeforeSavingMessage" script:
{$I _OBSav_forPostShow_include}
and
BuildPostText(Message, IsEmail);
It will look like this:
program OnBeforeSavingMessage;
{$I _OBSav_forPostShow_include}
procedure OnBeforeSavingMessage(var Message: TStringlist; Servername: string; IsEmail: boolean);
begin
BuildPostText(Message, IsEmail);
// other calls to other scripts
end;
begin
end.
Note also that every time you need to change something in the settings of the "_OBSav_forPostShow_include" custom script, you have to compile again the "OnBeforeSavingMessage" event script to apply the changes.
Setup the script
Create a new custom script, name it "_OBSav_forPostShow_include" (without the quotes), delete all the content in the right side of the script editor, then copy and paste into it the following code. Remember to write your preferences in the Setting section inside the script. Then Save, but don't compile it.
// include file for the OnBeforeSavingMessage event, to prepare what the PostShow script needs.
// (v1.6) 28 Aprile 2005 by MLC
//---------------------------- Settings ---------------------------------//
const
filePost = 'C:\Programmi\40tude Dialog\Post.txt';
// write your path for the file that will be created by this script
myFQDN = 'maluc.it';
// write your FQDN.
depth = 4;
// set your preferred depth (greater than 0).
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 BuildPostText(Message: TStringList; 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
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))+'P='+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;
Maria Luisa C 28 Aprile 2005