Boxquote-fup2-and-xpost-warning

From 40tude Dialog Wiki

This script is a merged OnBeforeSending-Script, containing the following scripts:

Please read the introductions for every script linked above, to configure this merged script correctly. Otherwise it may not work! For help on using boxquotes, have a look here.


program OnBeforeSendingMessage;

uses Textfile;

// ** Introduction for XPost/Fup2-Message
// ** change message as you want to
const
  MessageXPost = 'X'+#39+'Posted to:';
  MessageFup2  = 'F'+#39+'up2:';

// Boxquote-Config
const
        StartLine_close_box = 'box:';
        StartLine_open_box = 'box_o:';
        Separator = '-';

        bq1a=',';
        bq1b='-';
        bq1c='.';
        bq2a='|';
        bq2c='|';
        bq3a=''+#39+'';
        bq3b='-';
        bq3c=''+#39+'';

        LineWidthTop    = 4;
        LineWidthBottom = 4;

        maxint= 2147483647;
        s_no_bq=0;
        s_bq_title=1;
        s_bq_content=2;

                   
// f'up2 warning
// ** Begin of code
Procedure XPost_and_FUp2_Information (var Message: TStringlist;
Servername: string; IsEmail: boolean);
var
  FUP2,
  XPost,
  Header: boolean;
  i,
  SigLine: integer;
  s,
  Fup2Group,
  XPostGroups: string;
begin
  if IsEmail=true then exit;
  FUP2:=false;
  XPost:=false;
  Header:=true;
  SigLine:=0;
  for i:=0 to Message.count-1 do
    begin;
    s:= message.strings[i];
    if s='' then header:=false;
    if header=true then
      begin;
      if Pos('Followup-To:',s)>0 then
        begin;
        FUP2:=true;
        Fup2Group:=copy(s,13,length(s)-12);
//      WriteToLog(MessageFup2+Fup2Group,1);
        end;
      if Pos('Newsgroups:',s)>0 then
        if Pos(',',s)>0 then
          begin;
          XPost:=true;
          XPostGroups:=copy(s,12,length(s)-11);
//        WriteToLog(MessageXPost+XPostGroups,1);
          end;
      end
    else
      if s='-- ' then
        SigLine:=i;
//  WriteToLog('Analysierte Zeile: '+s,1);
    end;
  if FUP2=true then
    if Sigline=0 then
      Message.Add(MessageFup2+Fup2Group)
    else
      Message.Insert(Sigline,MessageFup2+Fup2Group);
  if XPost=true then
    if Sigline=0 then
      Message.Add(MessageXPost+XPostGroups)
    else
      Message.Insert(Sigline,MessageXPost+XPostGroups);
  if (FUP2=true) or (XPost=true) then
    if Sigline=0 then
      Message.Add('')
    else
      Message.Insert(SigLine,'');
end;

function StringReplaceM(S, OldPattern, NewPattern: string;replaceall,ignorecase:boolean): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if IgnoreCase then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (ReplaceAll) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

function RepeatChar(c : char;Count : integer) : string;
var i:integer;
begin
  if count<0 then count:=0;
  SetLength(Result,Count);
  for i:=1 to count do Result[i]:=c;
end;


function CountChars(s : string;c:char) : integer;
var i : integer;
begin
  Result := 0;
  for i := 1 to Length(s) do if s[i]=c then Result:=result+1;
end;

procedure boxquote(var Message: TStringlist);
var i,j,k:integer;
    state:word;
    bq_startline:integer;
    bq_title:string;
    bq_content:string;
    maxwidth:integer;
    sl:Tstringlist;
    CloseBox:Boolean;
    
begin
state:=s_no_bq;
i:=0;
bq_startline:=-1;
while i<=message.count-1 do
    begin
    case state of
    s_no_bq: begin
             if (message.strings[i]=StartLine_close_box) or (message.strings[i]=StartLine_open_box) then
                begin
                 if message.strings[i] = StartLine_close_box then
                  CloseBox := true
                  else
                  CloseBox := false;
                 bq_startline:=i;
                 bq_title:='';
                 bq_content:='';
                 maxwidth:=1;
                 state:=s_bq_title;
                end
             end;
    s_bq_title: begin
                if message.strings[i]=Separator then state:=s_bq_content
                                                else bq_title:=trim(bq_title+' '+message.strings[i]);
                end;
    s_bq_content: begin
                  if message.strings[i]=Separator then
                        begin
                        state:=s_no_bq;
                        if length('['+bq_title+']')>maxwidth then maxwidth:=length('['+bq_title+']') + 6;
                        //delete the raw boxquote
                        for j:=bq_startline to i do message.delete(bq_startline);
                        //middle part
                        bq_content:=stringreplacem(#13#10+bq_content,#13#10,#13#10+bq2a+' ',true,false);
                        delete(bq_content,1,2);
                        //first line
                        if bq_title<>'' then bq_content:=bq1a+RepeatChar(bq1b,LineWidthTop)+' ['+bq_title+'] '+#13#10+bq_content
                                        else bq_content:=bq1a+RepeatChar(bq1b,LineWidthTop)+#13#10+bq_content;
                        //last line
                        bq_content:=bq_content+#13#10+bq3a+RepeatChar(bq3b,LineWidthBottom);
                        sl:=Tstringlist.create;
                        try
                        sl.text:=bq_content;
                        //close the box
                        if CloseBox then
                         for j:=0 to sl.count-1 do
                            begin
                            k:=maxwidth-length(sl.strings[j]);
                            if j=0 then sl.strings[j]:=sl.strings[j]+repeatchar(bq1b,k+3)+bq1c
                            else if j=sl.count-1 then sl.strings[j]:=sl.strings[j]+repeatchar(bq3b,k+3)+bq3c
                            else sl.strings[j]:=sl.strings[j]+repeatchar(' ',k+3)+bq2c;
                            end;
                        message.insert(bq_startline,trim(sl.text));
                        i:=bq_startline;
                        finally
                        sl.free;
                        end;
                        end
                        else
                        begin
                        if bq_content='' then bq_content:=message.strings[i]
                                         else bq_content:=bq_content+#13#10+message.strings[i];
                        if length(message.strings[i])>maxwidth then maxwidth:=length(message.strings[i]);
                        end;
                  end;
    end; //case
    i:=i+1;
    end;
end;

// Event OnBeforeSendingMessage
function OnBeforeSendingMessage(var Message: TStringlist; Servername:
string; IsEmail: boolean):boolean;
begin;
  result:=true;
  if message.count<500 then boxquote(message);
  XPost_and_FUp2_Information(Message, Servername, IsEmail);
end;
 begin
 end.

Enrico Bauer