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