//********************************************************************* //* PostShow_OBSaving 2020-06-04 * //* >> OnBeforeSavingMessage << * //* * //* Dieses Script zeichnet alle ankommenden ANTWORTEN auf DEINE * //* Artikel mit den wichtigsten Headern in einer Datei auf. * //* Jene Datei ist dann mit dem Script "PostShow.ds" unter Dialog * //* abrufbar. +++ !!EIN FQDN IST UNBEDINGT ERFORDERLICH!! +++ * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : unbekannt; ueberarbeitet am: 04.06.2020 * //* Autoren : unbekannt * //* * //* DateiName : _i_OBSaveM_PostShow.ds * //* Einbindung: {$I _i_OBSaveM_PostShow.ds} * //* Aufruf : Not_Error := PostShow_OBSaving (Not_Error, Message, * //* IsEmail, Error_Func); * //********************************************************************* Procedure Init_PostShow_OBSaving (var filePost : String; var myFQDN : String; var depth : Integer; var ExcludeNG : String; var withFrom : Boolean; var withNG : Boolean; var withSubj : Boolean; var withDate : Boolean; var withMsgID : Boolean ); begin //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} // write your path for the file that will be created by this script // only Pathfinder //filePost := DialogRootDir + 'Post.txt'; // without Pathfinder filePost := 'D:\MyPrograms\Dialog\' + 'Post.txt'; // write your FQDN myFQDN := 'Exemple_FQDN'; // + ', example2.my-fqdn.de'; // + ', example3.my-fqdn.de'; // + ', example4.my-fqdn.de'; // set your preferred depth depth := 1; // 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. ExcludeNG := ''; //author recorded? withFrom := true; //author recorded? true / false //newsgroup recorded? true / false withNG := true; //subject recorded? true / false withSubj := true; //date and time recorded? true / false withDate := true; //Message-ID recorded? true / false withMsgID := true; //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} end; //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} //--[ START Function PostShow_OBSaving ]------------------------------- 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(myFQDN : String; Message : TStringList ): boolean; var s: string; begin s:=GetReferences(Message); if pos(myFQDN, s)>0 then result:=true else result:=false; end; function WhichDepth(myFQDN : String; 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(myFQDN : String; 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(ExcludeNG : String; 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; Function PostShow_OBSaving ( fbkResult : Boolean; Message : TStringlist; IsEmail : Boolean; Error_Func : String ) : Boolean; var inf, ns, cod, sep1, sep2, indent, ng: string; list : TStringList; num,d,i : integer; filePost : String; MyFQDN : TStringList; my_FQDN_Str : String; CommaPos : Integer; k : Integer; depth : Integer; ExcludeNG : String; withFrom : Boolean; withNG : Boolean; withSubj : Boolean; withDate : Boolean; withMsgID : Boolean; begin // Rückgabewert entsprechend vorheriger Scriptprobleme setzen Result := fbkResult; // Wenn bereits irgendein Script einen Fehler verursacht hat, // dann muss der User benachrichtigt werden If not Result Then begin WriteToLog ('==== ANFANG =======================================' ,4); WriteToLog ('Script *** PostShow_OBSaving *** wird weiterhin ausgefuehrt' ,4); WriteToLog ('Script ' + Error_Func + ' hat diese WARNUNG verursacht!' ,4); WriteToLog ('==== ENDE =========================================' ,4); end; if Message.Count > 0 Then begin Init_PostShow_OBSaving (filePost, my_FQDN_Str, depth, ExcludeNG, withFrom, withNG, withSubj, withDate, withMsgID); ng:=GetMessageNG(Message); i := 0; Try MyFQDN := TStringlist.Create; if ansipos ( ',', My_FQDN_Str) = 0 then begin MyFQDN.Add ( LowerCase ( TrimLeft (My_FQDN_Str ))); end // if else begin CommaPos := 0; for k := 1 to length ( My_FQDN_Str ) do begin If My_FQDN_Str[k] = ',' then begin MyFQDN.Add ( LowerCase ( TrimLeft (copy ( My_FQDN_Str, CommaPos + 1, k - ( CommaPos + 1 ))))); CommaPos := k; end; // if if k = length ( My_FQDN_Str ) then MyFQDN.Add ( LowerCase ( TrimLeft (copy ( My_FQDN_Str, CommaPos + 1, k - CommaPos )))); end; // for end; // else WriteToLog ('ANZAHL FQDN''s: ' + IntToStr(MyFQDN.Count),3); For k := 0 to MyFQDN.Count - 1 do begin WriteToLog ('FQDN: ' + MyFQDN[k],3); if not(isMine(myFQDN[k], Message) or IsEmail or isExcludedNG(ExcludeNG, ng)) then begin //is a post not sent by me in a not excluded NG num:=0; try list := TStringList.Create(); d:=WhichDepth(myFQDN[k], Message); if (isFollowingMine(myFQDN[k], Message) and (d<=depth) and (d>0)) then begin //is a reply inside depth 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 withMsgID then inf:=inf+GetMsgID(Message)+#13+#10; list.Add(inf); list.SaveToFile(filePost); end; //if finally list.free end; // try - finally end; //if end; // for Except // Bei Problemen den User benachrichtigen. begin WriteToLog ('FEHLER im Script *** PostShow_OBSaving ***' ,4); WriteToLog ('From : ' + GetHeader('From: ', Message), 4); WriteToLog ('Newsgroups : ' + GetHeader('Newsgroups: ', Message), 4); WriteToLog ('Date : ' + GetHeader('Date: ', Message), 4); WriteToLog ('Message-ID : ' + GetHeader('Message-ID: ', Message), 4); Error_Func := '*** PostShow_OBSaving ***'; Result := false; end; // Except Finally MyFQDN.Free; end; //Try ... Except ... Finaölly } end; //if end; //--[ ENDE Function PostShow_OBSaving ]--------------------------------