ScriptCustomizePost

From 40tude Dialog Wiki

It allows to insert a prompt in the first line of the post, depending on the news goup name. So that gives a possible language adaptation of the prompt.

This script also add a tag Dialog, between square brackets in the subject, also depending on news group name.

Tag addition has side effect for donating people. See Tag in subject new posts script

Dialog version: 2.0.5.1

program OnBeforeSendingMessage;

type
   TLanguage = (LFrench, LEnglish, LGerman);
   TDayTime = (DTMorning, DTDay, DTAfternoon, DTEvening, DTNight);


function FindLanguage(VAR List : TStringList; LanguageFileName: string; NewsHeader : string): boolean;

begin
   list.LoadFromFile(LanguageFileName);
   Result := list.indexof(NewsHeader) > -1
(*  where each line is a newsgroup in the language tested:

Newsgroups: news.software.readers
Newsgroups: carlokok.public.pascalscript

This function could be modify to avoy to have 'Newsgroups: ' in each line of the text file by deleting it from Newsheader *)
end;


function SelectLanguage(NewsHeader : String):TLanguage;

var
   list: TStringList;


begin
   Result := LFrench;
   list := TStringList.Create();
   IF FindLanguage(List,'C:\Mes documents\English groups.txt',NewsHeader) THEN
      Result := LEnglish
   ELSE
      IF FindLanguage(List,'C:\Mes documents\German groups.txt',NewsHeader) THEN
      	Result := LGerman;
   list.free;

(* or in code option:
   IF (POS('news.software.readers', NewsHeader) > 0)
   OR (POS('carlokok.public.pascalscript', NewsHeader) > 0) THEN
      Result := LEnglish;
but it is case sensitive in this way ;-)
*)
end;

function SelectTime(NewsHeader : String): TDayTime;

VAR
   hour : BYTE;

begin
   delete(NewsHeader,1,pos(':',NewsHeader));
   delete(NewsHeader,1,pos(':',NewsHeader)-3);
   delete(NewsHeader,pos(':',NewsHeader),Length(NewsHeader)-2);
   hour := strtoint(NewsHeader);
   case hour of
   4: result := DTMorning;
   5: result := DTMorning;
   6: result := DTMorning;
   7: result := DTMorning;
   8: result := DTDay;
   9: result := DTDay;
   10: result := DTDay;
   11: result := DTDay;
   12: result := DTDay;
   13: result := DTDay;
   14: result := DTAfternoon;
   15: result := DTAfternoon;
   16: result := DTAfternoon;
   17: result := DTAfternoon;
   18: result := DTEvening;
   19: result := DTEvening;
   20: result := DTEvening;
   21: result := DTEvening;
   22: result := DTEvening;
   else
      result := DTNight
   end;
end;

function IsNewsmanagerGroup(Header :string) : boolean;

var
   list: TStringList;
begin
   Result := LFrench;
   list := TStringList.Create();
   List.LoadFromFile('C:\Mes documents\Newsreader.txt');
   Result := List.Indexof(Header) > -1;
   List.free;
end;


function IsAFirstPost(var Message: TStringlist) : boolean;

VAR
   HeaderCount : INTEGER;

BEGIN
   HeaderCount := 0;
   WHILE (HeaderCount < Message.count) AND (pos('References: ', Message.Strings[[HeaderCount]]) <> 1) DO
   begin
      writeln(Message.Strings[[HeaderCount]]);
      HeaderCount:=HeaderCount+1;
   end;
   writeln('HC '+inttostr(HeaderCount)+'MC '+inttostr(Message.count));
   Result := HeaderCount = Message.count
END;

function OnBeforeSendingMessage(var Message: TStringlist; Servername: string; IsEmail: boolean):boolean;

var
   HeaderCount : INTEGER;
   InsertionPlace : INTEGER;
   InsertionContent : String;
   SubjectReplacement:string;
   Language : TLanguage;
   TimePeriod : TDayTime;
   Supersedes: boolean;


begin
//Your code goes here
//Return false to prevent sending the passed message
   IF NOT IsEMail THEN
   BEGIN
      HeaderCount := 0;
      WHILE (HeaderCount < Message.count) AND (pos('Newsgroups:', Message.Strings[[HeaderCount]]) <> 1) DO
         HeaderCount:=HeaderCount+1;
      IF HeaderCount < Message.count THEN
      BEGIN
         Language := SelectLanguage(Message.Strings[[HeaderCount]]);
         IF IsNewsmanagerGroup(Message.Strings[[HeaderCount]]) AND IsAFirstPost(Message) THEN
         BEGIN
            HeaderCount := 0;
            WHILE (HeaderCount < Message.count) AND (pos('Subject:', Message.Strings[[HeaderCount]]) <> 1) DO
               HeaderCount:=HeaderCount+1;
            IF HeaderCount < Message.count THEN
            BEGIN
            	SubjectReplacement:=Message.Strings[[HeaderCount]];
            	{I think there is no need for a test to know if the tag is present, as nobody will do by hand
            	something that is automated}
        	Insert('[[Dialog]] ',SubjectReplacement, 10);
        	Message.Delete(HeaderCount);
        	Message.Insert(HeaderCount, SubjectReplacement);
            END;
         END;
      END;
      HeaderCount := 0;
      TimePeriod := DTDay;
      WHILE (HeaderCount < Message.count) AND (pos('User-Agent: 40tude_Dialog', Message.Strings[[HeaderCount]]) <> 1) DO
      BEGIN
         IF pos('Date:', Message.Strings[[HeaderCount]]) = 1 THEN
            TimePeriod := SelectTime(Message.Strings[[HeaderCount]]);
         IF Pos('Supersedes:',Message.Strings[[HeaderCount]]) = 1 THEN
            Supersedes:=true;
         HeaderCount:=HeaderCount+1;
      END;
      IF HeaderCount < Message.count THEN
         InsertionPlace:=HeaderCount + 2;
      InsertionContent :='';
      case Language of
         LFrench :
            case TimePeriod of
               DTMorning :
                  InsertionContent :='Bon Matin,';
               DTDay :
                  InsertionContent :='Bonjour,';
               DTAfternoon :
                  InsertionContent :='Bon(ne) apr�s-midi,';
               DTEvening :
                  InsertionContent :='Bonsoir,';
               DTNight :
                  InsertionContent :='Bonne nuit,';
            end;
         LEnglish:
            InsertionContent :='Hello,';
         LGerman:
            InsertionContent :='Guten Tag,';
      end;
      IF NOT Supersedes AND (InsertionPlace > 0) AND (InsertionPlace < Message.Count) AND (InsertionContent <>'') THEN
         message.insert (InsertionPlace, InsertionContent);
   END;
   result:=true;
end;

begin
end.