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 and for help on making footnotes look here.
program OnBeforeSendingMessage;
uses Textfile;
program OnBeforeSendingMessage;
// 1.: Add X-Post & FUp2 indication
// 2.: X-Now-Playing using AMIP
// 3.: Cancel-Lock
// 4.: Change any header and define a trailing text at the end of the header
// 5.: Footnote Support
// 6.: BoxQuote Support
// Example:
// box_o:
// Box-Title
// -
// aslkdjl aksdj lkajsd lkjalsdkj lakj sadalksjd
// lkqjlakjasl dlakjsd lkjaslkdj laksjdlk ajsldkj
// lkaj sdlkjalskjd lkajsd lkjaldskj lkajsdl kjas
// -
//
// If you use Footnotes in BoxQuotes, you have to put an <<
// (ConstRewrapToLine) at the end of your boxquoted text.
// Otherwise, your BoxQuote will be destroyed.
const
//
// Add X-Post & FUp2 indication:
// configure your preferred Messages here:
//
MessageXPost = 'X'+#39+'Posted to:'; // X-Post-Prefix
MessageFup2 = 'F'+#39+'Up2:'; // FUp2-Prefix
//
// Footnote-Support:
// configure your settings here:
//
ConstFootnoteHead = true;
ConstFootnoteHeadTxt = 'Footnotes:';
ConstFootnoteHeadUnderline = '=';
ConstEmptyLine = false;
ConstStartupFootnote = '#fn#';
ConstEndFootnote = '##';
ConstReWrapEdge = 73;
ConstMultiLine = '%%';
ConstRewrapToLine = '<<';
ConstComments = '//';
ConstEmptyLineBeforeFootnote = false;
//
// BoxQuote-Support:
// configure your settings here:
//
StartLine_close_box = 'box:';
StartLine_open_box = 'box_o:';
Separator = '-';
//
// Path for X-Now-Playing with AMIP
// please adapt to your local configuration
//
path='c:\programme\winamp5\plugins\np\winamp_sig.txt';
//
// Script: Change User-Agent
// configure your settings here:
//
// set the header you want to change here, e.g. 'User-Agent'
ChangeHeader = 'User-Agent:';
AddOnChangeHeader = 'YOU'RE TEXT GOES HERE'; // DEFINE YOUR TEXT
// change header in emails and/or postings?
// set to 'true' or 'false' accordingly:
ChangeInEmails = true;
ChangeInNews = true;
//
// Script: Cancel-Lock
// configure your password here:
CLSecret = ''; // must be filled with some password
// --------------------------------------------------------------- //
// ---- No user maintainable parts below this line -------------- //
// --------------------------------------------------------------- //
MaxInt = 2147483647;
//
// Flags to indicate the buttons contained in the message box:
//
MB_OK = 0; // 1 button: OK.
MB_OKCancel = 1; // 2 buttons: OK and Cancel.
MB_AbortRetryIgnore = 2; // 3 buttons: Abort, Retry, and Ignore.
MB_VbYesNoCancel = 3; // 3 buttons: Yes, No, and Cancel.
MB_YesNo = 4; // 2 buttons: Yes and No.
MB_RetryCancel = 5; // 2 buttons: Retry and Cancel.
//
// Flags to display an icon in the message box:
//
MB_IconCritical = 16; // stop-sign
MB_IconQuestion = 32; // question-mark
MB_IconExclamation = 48; // exclamation-point
MB_IconInformation = 64; // lowercase i in a circle
//
// BoxQuote Constants
//
bq1a=',';
bq1b='-';
bq1c='.';
bq2a='|';
bq2c='|';
bq3a=''+#39+'';
bq3b='-';
bq3c=''+#39+'';
LineWidthTop = 4;
LineWidthBottom = 4;
s_no_bq=0;
s_bq_title=1;
s_bq_content=2;
type
hashsum = array[1..20] of byte;
function CLalfab64( num : Byte ) : Char;
begin
if num < 26
then result := chr(num+ord('A'))
else if num < 52
then result := chr(num+ord('a')-26)
else if num < 62
then result := chr(num+ord('0')-52)
else if num = 62
then result := '+'
else result := '/';
end;
function CLb64enc( var buf : Hashsum) : String;
var
wynik : String;
i : Byte;
begin
wynik := '123456789012345678901234567=';
for i := 0 to 5 do begin
wynik[4*i+1] := CLalfab64( buf[3*i+1] div 4 );
wynik[4*i+2] := CLalfab64( (buf[3*i+1] mod 4) * 16 + buf[3*i+2] div 16 );
wynik[4*i+3] := CLalfab64( (buf[3*i+2] mod 16) * 4 + buf[3*i+3] div 64 );
wynik[4*i+4] := CLalfab64( buf[3*i+3] mod 64 );
end;
wynik[25] := CLalfab64( buf[19] div 4 );
wynik[26] := CLalfab64( (buf[19] mod 4) * 16 + buf[20] div 16 );
wynik[27] := CLalfab64( (buf[20] mod 16) *4 );
result := wynik;
end;
function GetLastError() : Integer;
external 'GetLastError@kernel32.dll stdcall';
procedure Blad(
var Message : TStringList;
nazwa : String
);
var
i, nrbledu : Integer;
begin
nrbledu := GetLastError;
for i:=0 to Message.count-1 do begin
if Message.strings[i] = '' then begin
Message.Insert(i,'X-CL-Error: '+nazwa+' '+IntToStr(nrbledu));
break;
end;
end;
end;
function CryptAcquireContext( var hProv: LongWord; pszContainer, pszProvider: PChar;
dwProvType, dwFlags: LongWord ): Boolean;
external 'CryptAcquireContextA@advapi32.dll stdcall';
function CryptCreateHash( hProv: LongWord; Algid: Integer; hKey: LongWord;
dwFlags: LongWord; var hHash: LongWord ): Boolean;
external 'CryptCreateHash@advapi32.dll stdcall';
function CryptHashData( hHash: LongWord; pbData: PChar;
dwDataLen: LongWord; dwFlags: LongWord ): Boolean;
external 'CryptHashData@advapi32.dll stdcall';
function CryptGetHashParam( hHash: LongWord; dwParam: LongWord; var pbData: hashsum;
var pdwDataLen: LongWord; dwFlags: LongWord ): Boolean;
external 'CryptGetHashParam@advapi32.dll stdcall';
function CryptDestroyHash( hHash: LongWord ) : Boolean;
external 'CryptDestroyHash@advapi32.dll stdcall';
function CryptReleaseContext( hProv: LongWord; dwFlags: LongWord ): Boolean;
external 'CryptReleaseContext@advapi32.dll stdcall';
function CLsha1( var Message: TStringList; tekst: string; var hash: hashsum ): Boolean;
var
pProv, pHash : LongWord;
dlugosc : LongWord;
begin
result := false;
if not CryptAcquireContext(pProv, '', '', 1, 0)
then if not CryptAcquireContext(pProv, '', '', 1, 8) then begin
Blad(Message,'CryptAcquireContext');
exit;
end;
if not CryptCreateHash(pProv,32772,0,0,pHash)
then Blad(Message,'CryptCreateHash')
else begin
dlugosc := strlen(tekst);
if not CryptHashData(pHash,tekst,dlugosc,0)
then Blad(Message,'CryptHashData')
else begin
dlugosc := 20;
if not CryptGetHashParam(pHash,2,hash,dlugosc,0)
then Blad(Message,'CryptGetHashParam')
else if dlugosc = 20
then result := true
else Blad(Message,'BadHashLength'+' '+IntToStr(dlugosc));
end;
if pHash = 0
then Blad(Message,'HashIsZero')
else if not CryptDestroyHash(pHash)
then Blad(Message,'CryptDestroyHash');
end;
if pProv = 0
then Blad(Message,'ProviderIsZero')
else if not CryptReleaseContext(pProv, 0)
then Blad(Message,'CryptReleaseContext');
end;
procedure CLAdd(
var Message : TStringList;
i : Integer;
lock : Boolean
);
var
j : Integer;
mid,pom : String;
hash : Hashsum;
sum : String;
begin
j := Pos( '<', Message.strings[i] );
pom := Copy( Message.strings[i], j+1, pos('>', Message.strings[i])-j-1 );
mid := StringOfChar (' ', Length(pom)+Length(CLSecret) );
StrCopy( mid, pom );
StrCat( mid, CLSecret );
if not CLSHA1(Message,mid,hash)
then exit;
sum := CLb64enc( hash );
if lock then begin
mid := sum;
if not CLSHA1( Message, mid, hash )
then exit;
sum := CLb64enc(hash);
end;
for j:=0 to Message.count-1 do
if Message.strings[j] = '' then begin
if lock
then Message.Insert(j,'Cancel-Lock: sha1:'+sum)
else Message.Insert(j,'Cancel-Key: sha1:'+sum);
break;
end;
end;
procedure CLMain( var Message : TStringlist );
var
i : Integer;
begin
if Length(CLSecret) = 0 then begin
Blad(Message,'EmptyPassword');
exit;
end;
for i:=0 to Message.count-1 do
if Pos( 'Subject: [Cancel control message]', Message.strings[i]) = 1
then break;
if i < Message.count-1 then begin
CLAdd(Message,i,false);
exit;
end;
for i:=0 to Message.count-1 do
if pos('Message-ID:', Message.strings[i]) = 1
then break;
if i < Message.count-1
then CLAdd(Message,i,true);
for i:=0 to Message.count-1 do
if pos('Supersedes:', Message.strings[i]) = 1
then break;
if i < Message.count-1
then CLAdd(Message,i,false);
end;
//
// Change User-Agent
//
procedure ChangeAnyHeader(
Message : TStringlist;
IsEmail : Boolean
);
var
i : Integer;
s : String;
begin
if (IsEmail and ChangeInEmails)
or ((not IsEmail) and ChangeInNews)
then begin
s := Message.text;
i := 1;
while( Message.Strings[i] <> '' ) do begin
if Pos( ChangeHeader, Message.Strings[i] ) = 1 then begin
Message.Strings[i] := Message.Strings[i] + AddOnChangeHeader;
s := Message.text;
end;
i := i + 1;
end; // while
message.text := s;
end;
end;
//
// Introduction for XPost/Fup2-Message
// change message as you want to
//
procedure XPost_and_FUp2_Information(
var Message : TStringlist;
const IsEmail : Boolean
);
var
FUP2, XPost, Header : Boolean;
i, SigLine : Integer;
s, Fup2Group, XPostGroups : String;
begin
// if IsEmail then exit; // unREM if not for Emails
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; // scan only headers
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 begin
if Pos( ',', s ) > 0 then begin
XPost := true;
XPostGroups := Copy( s, 12, Length(s)-11 );
// WriteToLog(MessageXPost+XPostGroups,1);
end;
end;
end
else begin
if s = '-- ' then SigLine := i;
end;
// WriteToLog( 'Analysierte Zeile: '+s, 1 );
end;
if FUP2 or XPost then Message.Add( '' );
if FUP2 then begin
if Sigline = 0
then Message.Add( MessageFup2+Fup2Group )
else Message.Insert( Sigline, MessageFup2+Fup2Group );
end;
if XPost then begin
if Sigline = 0
then Message.Add( MessageXPost+XPostGroups )
else Message.Insert( Sigline, MessageXPost+XPostGroups );
end;
if FUP2 or XPost then begin
if Sigline = 0
then Message.Add( '' )
else Message.Insert( SigLine, '' );
end;
end; // procedure XPost_and_FUp2_Information()
//
// X-Now-Playing-Script
//
procedure XNowPlaying_with_AMIP( var Message : TStringlist );
var
fi : Textfile;
st : String;
begin
if FileExists( path ) then begin
AssignFile( fi, path );
Reset( fi );
TextReadln( fi, st );
CloseFile( fi );
message.insert(1, 'X-Now-Playing: ' + st );
end;
end;
//
// program Footnotes - Date: 2004/11/05
//
function MessageBox( hWnd : Cardinal; lpText, lpCaption : PChar; uType : longword ) : Integer;
external 'MessageBoxA@user32.dll stdcall';
function GetText(
var Txt : TStringlist;
var FoundLine : Integer;
var FoundPosi : Integer;
var CurrLine : Integer;
var CurrPosi : Integer
) : String; // Function by Mirko D. Walter
var
res : String;
i : Integer;
bposi : Integer;
begin
result :='';
res := '';
if FoundLine = CurrLine then begin
res := Copy( txt.strings[foundline], FoundPosi, CurrPosi - FoundPosi );
end
else begin
BPosi := FoundPosi;
for i := FoundLine to CurrLine do begin
if i < CurrLine then begin
res := Res + Trim( Copy(txt.strings[i], BPosi, MaxInt) ) + ' ';
BPosi := 0;
end
else begin
res := res + Copy( txt.strings[i], 1, CurrPosi-1 );
end;
end;
end;
//
// Multine-Special-Character?
//
BPosi := AnsiPos( ConstMultiLine, res );
if BPosi > 0 then begin
repeat
//
// if the following characters are #13#10
// then do no linebreak, simply remove
// 1234567890123
// ABCDEF%%gaga#
//
if Copy( res, BPosi + Length(ConstMultiLine), 2 ) = #13#10
then res := Copy( res, 1, BPosi - 1 )
+ #13#10
+ Trim( Copy(res, BPosi + Length(ConstMultiLine), MaxInt) )
else res := Copy( res, 1, BPosi - 1 )
+ #13#10
+ #13#10
+ Trim( Copy(res, BPosi + Length(ConstMultiLine), MaxInt) );
BPosi := AnsiPos( ConstMultiLine, res );
until BPosi <= 0;
res := Trim( res );
end;
result := Trim( res );
end; // function GetText()
function Rewrap_Str(
StrL : String;
WEdge : Integer;
FootNote : Boolean
) : String;
var
Space_Old : Integer;
Space_New : Integer;
i : Integer;
Space_Pos : Integer;
Break_L : Boolean;
begin
Space_Old := 1;
Space_New := 1;
Space_Pos := WEdge;
if Copy( StrL, Length(StrL), 1 ) <> ' '
then StrL := StrL + ' ';
if AnsiPos( ConstRewrapToLine, StrL ) > 0
then Delete( StrL, AnsiPos(ConstRewrapToLine, StrL), 2 );
for i:=1 to Length( StrL ) do begin
if (StrL[i] = ' ') and (i > 1) and (i < Length(StrL)) then begin
if StrL[i+1] = ' ' then begin // found double blank
if (StrL[i-1] <> '.') // it's perfectly fine to
and (StrL[i-1] <> '?') // have double blanks after
and (StrL[i-1] <> '!') // punctuation marks (at
and (StrL[i-1] <> ':') // least beyond sentence
and (StrL[i-1] <> ';') // delimiters).
then begin // but otherwise not!
Delete( StrL, i, 1 );
end;
end;
end;
end;
i := 0;
while i <= Length( StrL ) do begin
i := i + 1;
if (Copy(StrL, i, 1) = ' ')
or (Copy(StrL, i, 4) = (#13#10 + #13#10))
then begin
Break_L := false;
Space_Old := Space_New;
Space_New := i;
if Copy( StrL, i , 4 ) = (#13#10 + #13#10) then begin
Insert( ' ', StrL, i + 4 );
Break_L := true;
if Space_New < Space_Pos then begin
Space_Pos := i + 4 + WEdge;
Space_Old := i + 4;
Space_New := i + 4;
i := i + 4;
end;
end;
if (Space_New >= Space_Pos)
and (Space_old <= Space_Pos)
then begin
if (Space_New = Space_Pos)
and (Length(StrL) > Space_Pos)
then begin
if Footnote = false then begin
Delete( StrL, Space_New, 1 );
Insert( #13#10, StrL, Space_New );
Space_Pos := Space_New + WEdge + 1;
end
else begin
Insert( #13#10 + ' ', StrL, Space_New );
if Break_L then begin
Space_Pos := i + 4 + WEdge;
Space_Old := i + 4;
Space_New := i + 4;
i := i + 4;
end
else Space_Pos := Space_New + WEdge + 1;
i := i + 3;
end;
end
else begin
if Footnote = false then begin
if Length( StrL ) > Space_Pos then begin
Delete( StrL, Space_Old, 1 );
Insert( #13#10, StrL, Space_Old );
end;
Space_Pos := Space_Old + WEdge + 1;
if (Space_New >= Space_Pos)
and (Length(StrL) > Space_Pos)
then begin
Delete( StrL, Space_New + 1, 1 );
Insert( #13#10, StrL, Space_New + 1 );
Space_Pos := Space_New + WEdge + 2;
i := i + 1;
end;
end
else begin
if Space_Old > 5 then begin
if Length( StrL ) > Space_Pos
then Insert( #13#10 + ' ', StrL, Space_Old );
if Break_L then begin
Space_Pos := i + 4 + WEdge;
Space_Old := i + 4;
Space_New := i + 4;
i := i + 4;
end
else begin
Space_Pos := Space_Old + WEdge + 1;
if Space_New >= Space_Pos then begin
Insert( #13#10 + ' ', StrL, Space_New + 5 );
Space_Pos := Space_New + WEdge + 6;
end;
end;
i := i + 3;
end
else begin
Insert( #13#10 + ' ', StrL, Space_New );
Space_Pos := Space_New + WEdge + 1;
i := i + 3;
end;
end;
end;
i := i + 1;
end;
end;
end; // while
result := TrimRight( StrL );
end; // function Rewrap_Str()
function doFootNoteNew(
var Message : TStringlist
) : Boolean; // is message ok?
var
i : Integer;
Posi : Integer;
Mult_Posi : Integer;
FoundLine : Integer;
FoundPosi : Integer;
OLength : Integer;
RFoundPosi : Integer;
Rest : String;
FN_Temp : String;
FN : String;
FNR : Integer;
Skip : Boolean;
Sig : Boolean;
txt2 : String;
txt3 : String;
Temp_Str : String;
Add_txt3 : Boolean;
FootnoteStr : String;
zw : Integer;
begin
result := false;
if ConstFootnoteHead then begin
if Length( ConstFootnoteHeadUnderline ) = 1 then begin
for i := 1 to Length( ConstFootnoteHeadTxt ) do begin
FootnoteStr := FootnoteStr + ConstFootnoteHeadUnderline;
end;
end
else FootnoteStr := '';
end
else FootnoteStr := '';
i := -1;
posi := -1;
foundposi := -1;
rest := '';
fn := '';
sig := false;
fnr := 0;
txt2 := '';
txt3 := '';
Mult_Posi := -1;
Add_Txt3 := false;
FN_Temp := '';
Temp_Str := '';
while (i <= message.count-1) and (sig = false) do begin
if Rest = '' then begin
i := i + 1;
// ignore quotes and empty lines
Skip := true;
while Skip and (i <= message.count - 1) do begin
Skip := false;
if Sig then begin
txt2 := txt2 + message.strings[i] + #13#10;
i := i + 1;
Skip := true;
end
else begin
if Length( message.strings[i] ) > 0 then begin
if Copy( message.strings[i], 1, 1 ) = '>' then begin
txt2 := txt2 + message.strings[i] + #13#10;
i := i + 1;
Skip := true;
end;
if Length( message.strings[i] ) > 2 then begin
if Copy( message.strings[i], 1, 3 ) = '-- ' then begin
if Length( FN ) > 0 then begin
WriteToLog('FN: >' + FN + '<', 7);
if ConstEmptyLineBeforeFootnote = true then begin
txt2 := txt2 + #13#10 + FN;
end
else begin
txt2 := txt2 + FN;
end;
end;
Sig := true;
Skip := true;
end;
end;
end
else begin
txt2 := txt2 + message.strings[i] + #13#10;
i := i + 1;
Skip := true;
end;
end;
end;
if i > message.count-1 then break; // fix added by MM (Oct. 30th, 2003)
Rest := message.strings[i];
OLength := Length(Rest);
end;
if not Sig then begin
if FoundPosi > 0 then begin
Posi := AnsiPos( ConstEndFootNote, Rest );
if Posi > 0 then begin
Mult_Posi := AnsiPos( ConstStartupFootnote, Rest );
if (i + 1) = message.count
then Temp_Str := ''
else Temp_Str := message.strings[i + 1];
if (AnsiPos(ConstRewrapToLine, Rest) > 0)
or (Temp_Str = '')
or (Temp_Str = '-- ')
then begin
Add_Txt3 := false;
if Mult_Posi = 0 then begin
if AnsiPos( ConstRewrapToLine, Rest ) > 0
then txt3 := txt3
+ Copy( Rest, posi+Length(ConstEndFootnote),
AnsiPos(ConstRewrapToLine, Rest)+1 )
else txt3 := txt3
+ Copy( Rest, posi+Length(ConstEndFootnote), MaxInt );
end;
end
else Add_Txt3 := true;
zw := posi + olength - Length( rest );
FN_Temp := '[' + IntToStr(FNR) + '] '
+ GetText( message, FoundLine, FoundPosi, i, zw );
FN_Temp := Rewrap_Str( FN_Temp, ConstReWrapEdge, true );
if (FN = '')
and (FN_Temp <> '')
and (ConstFootnoteHead = true)
then begin
if FootnoteStr <> ''
then FN := ConstFootnoteHeadTxt + #13#10 + FootnoteStr + #13#10
else FN := ConstFootnoteHeadTxt + #13#10;
if ConstEmptyLine = true then FN := FN + #13#10;
end;
FN := FN + FN_Temp + #13#10;
// FN := FN
// + '[' + IntToStr(FNR) + '] '
// + GetText(message, FoundLine, FoundPosi, i, zw) + #13#10;
Rest := Copy( Rest,posi+Length(ConstEndFootnote), MaxInt );
If Rest = '' then Rest := ' '; //08.10.2004 !!
FoundPosi := -1;
Mult_Posi := -1;
end
else begin
Rest:='';
end;
end
else begin
// WriteToLog('R: ' + Rest, 7);
// 1. char = #, ignore this, could be a control character
if Copy( Rest + ' ', 1, Length(ConstComments) ) <> ConstComments then begin
Posi := AnsiPos(ConstStartupFootnote, Rest);
if Posi > 0 then begin
// WriteToLog('FN: ' + IntToStr(Posi), 7);
RFoundPosi := Posi + Length( ConstStartupFootnote );
FoundPosi := RFoundPosi + OLength - Length( Rest );
FoundLine := i;
FNR := FNR + 1;
// txt2 := txt2 + Copy( Rest, 1, Posi - 1 ) + '[' + IntToStr(FNR) + ']';
txt3 := txt3 + Copy( Rest, 1, Posi - 1 ) + '[' + IntToStr(FNR) + ']';
Rest := Copy( Rest, RFoundPosi, MaxInt ); // 08.10.2004 Trim entfernt
end
else begin
if FoundPosi = -1 then begin
if Add_Txt3 then txt3 := txt3 + Rest + ' ';
if (i + 1) = message.count
then Temp_Str := ''
else Temp_Str := message.strings[i + 1];
if ( (AnsiPos(ConstRewrapToLine, Rest) > 0)
or (Temp_Str = '') or (Temp_Str = '-- '))
and (txt3 <> '')
then begin
Add_Txt3 := false;
txt3 := Rewrap_Str( txt3, ConstReWrapEdge, false );
txt2 := txt2 + txt3;
txt3 := '';
Rest := '';
end;
if Add_Txt3 = false then txt2 := txt2 + Rest + #13#10;
Rest := '';
end;
end;
end
else begin
txt2 := txt2 + Rest + #13#10;
Rest := '';
end;
end;
end;
end;
if txt3 = '' then begin
result := true;
if Sig = false then begin
if Length( FN ) > 0 then begin
message.text := txt2 + #13#10 + FN;
end;
end
else message.text := txt2;
end
else begin
message.text := message.text;
result := false;
MessageBox( 0, 'End-Tag ''' + ConstEndFootnote + ''' of footnote not found!',
'Abort sending!', MB_OK or MB_IconExclamation );
end;
end; // function doFootNoteNew()
//
// program BoxQuote - Date: 2004/11/05
//
function StringReplaceM(
S : String;
OldPattern : String;
NewPattern : String;
replaceall : Boolean;
ignorecase : Boolean
) : String;
var
SearchStr : String;
Patt : String;
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 StringReplaceM()
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 RepeatChar()
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; // function CountChars()
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 begin
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;
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; // procedure BoxQuote()
//
// Event OnBeforeSendingMessage
//
function OnBeforeSendingMessage(
var Message : TStringlist;
const Servername : String;
const IsEmail : Boolean
) : Boolean;
begin
result := doFootNoteNew( Message );
BoxQuote( Message );
if not IsEmail then begin
CLMain( Message );
end;
XPost_and_FUp2_Information( Message, IsEmail );
XNowPlaying_with_AMIP( Message );
ChangeAnyHeader( Message, IsEmail );
end;
begin
end.