//*********************************************************************
//*                   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 ]--------------------------------