<dialog> 40Tude Dialog program OnBeforeSendingMessage; procedure RemoveHeaders.ds

[Rudolph Rhein]

Any updates to this RemoveHeaders.ds script you know of?
It removes inserted headers like AV headers for all groups.

program OnBeforeSendingMessage;
const
// ------------------------------------------------
// Configuration settings
// ------------------------------------------------
// Set the header(s) you want to remove here, e.g.,
// Remove_Headers = 'X-Scoring: ,X-Hamster-Info: ';
Remove_Headers = 'X-Antivirus:, X-Antivirus-Status: ';
// Remove header(s) from emails and/or postings
// Please set only to 'true' or 'false'
RemoveFromEmails = true;
RemoveFromNews = true;
// ------------------------------------------------
// -- End of configuration settings --------------- //
// -- No user maintainable parts below this line -- //
// ------------------------------------------------ //
procedure RemoveHeaders ( Message : TStringlist;
IsEmail : boolean
);
var i : integer;
k : integer;
s : string;
CommaPos : integer;
DelHeader : TStringlist;
RemoveH : String;
begin
RemoveH := Remove_Headers;
i := 0;
if ((IsEmail=true) and (RemoveFromEmails=true)) or
((IsEmail=false) and (RemoveFromNews=true)) then begin
If ( RemoveH <> '' ) then begin
try
DelHeader := TStringlist.Create;
if ansipos ( ',', RemoveH) = 0 then begin
DelHeader.Add ( LowerCase ( TrimLeft( RemoveH )));
end // if
else begin
CommaPos := 0;
for k := 1 to length ( RemoveH ) do begin
If RemoveH[k] = ',' then begin
DelHeader.Add ( LowerCase ( TrimLeft (copy ( RemoveH,
CommaPos + 1, k - ( CommaPos + 1 )))));
CommaPos := k;
end; // if
if k = length ( RemoveH ) then
DelHeader.Add ( LowerCase ( TrimLeft (copy ( RemoveH,
CommaPos + 1, k - CommaPos ))));
end; // for
end; // else
s:=Message.text;
while (Message.Strings[i]<>'') do begin
k := 0;
while k <= ( DelHeader.Count - 1 ) do begin
if pos( DelHeader[k], LowerCase ( Message.Strings[i] )) = 1
then begin
delete ( s, pos(DelHeader[k], LowerCase (s) ), length (
Message.Strings[i] ) + 2 );
i := i - 1;
k := DelHeader.Count - 1;
message.text := s;
end; // if
k := k + 1;
end; // while
i := i + 1;
end; //while
message.text:=s;
finally
DelHeader.Free;
end; // try - finally
end; // if
end; // if
end; // RemoveHeaders
function OnBeforeSendingMessage(var Message : TStringlist;
Servername : string;
IsEmail : boolean
):boolean;
begin
RemoveHeaders(Message,IsEmail);
result:=true;
end;
// ------------------------------------------------
begin
end.

[Rudolph Rhein]

Rudolph Rhein <Rudolp...@nospam.net> wrote:
40tude Dialog pascal-based delphi scripts are hard to find.
I just found this on pastebin after a long set of searches.

It seems to be an update to RemoveHeaders.ds with more flexibility.
It allows you to separate work and personal messages for example.

// 40tude Dialog AddRemoveHeaders.ds
// Highly configurable Delphi script to add or remove headers
// Based on http://dialog.datalist.org/scripts/RemoveHeaders.html
// Located at http://dialog.datalist.org/scripts/script_library.html
// This script will add & remove headers based on a decision tree.
// It will also check for mistakes between business & personal use.
// 1. Set the "ForNewsgroup" Boolean as desired (search for "ForNewsgroup :")
// Generic default is: true
// 2. Set the "ForEmail" Boolean as desired (search for "ForEmail :")
// Generic default is: false
// 3. Change identity(ies) as desired (search for "from,")
// Generic defaults are set to: id##
// A sample value is: Kilroy <kil...@example.com>
// 4. Change newsgroup(s) as desired (search for "newsgroup,")
// Generic defaults are set to: ng1, ng2, ng3, ng4, & ng5
// A sample value is: news.software.readers
// 5. Change server(s) as desired (search for "server,")
// Generic defaults are set to: server1, server2, server3, server4, server5
// A sample value is: aioe
// 6. Change header(s) to remove as desired (search for "Remove_Headers :")
// A sample value is: Remove_Headers := 'User-Agent: '
// 7. Change header(s) to add as desired (search for "Add_Headers :")
// 8. Modify the if-then-else program control as needed.
//
// If you don't set Remove_Header, then none will be removed.
// If you don't set Add_Header, then none will be added.
// For some headers you have to remove them first, then add them back.
// Dialog will error when sending if you add headers without (CR+LF) syntax!
// The original StrMatch fct is case sensitive & matches only the 1st item found!
// Instead, we define a StrContains fct to match multiple either/or newsgroups.
// CASE-SENSITIVITY:
// Headerfield names are case insensitive as per RFC 5322 & RFC 5234.
// MIME headerfields above the media types & transfer encodings are not
// case sensitive as per RFC 2045.
// In general, parameter names are case insensitive while the
// value of the parameter is case sensitive.
// The "charset" parameter defines an exception as per RFC 2046 so
// that the value of the charset parameter is case insensitive
// This means that both "US-ASCII" & "us-ascii" have the same meaning.
// The "charset" parameter is allowed to contain "quoted-string" values
// as per RFC 2045 where the value of a quoted string parameter does not
// include the quote delimiters.
// Therefore: charset="US-ASCII" is the same as charset=US-ASCII.
// Quote delimiters are used for values containing forbidden characters.

program OnBeforeSendingMessage;

(*
Format for Remove_Headers: {} = required, [] = optional
{HeaderName: }[,HeaderName: ][,HeaderName: ][...]
Examples:
- Single header: 'User-Agent: '
- Multiple headers: 'User-Agent: ,X-Face: '
*)

// The user is not expected to need to customize "RemoveHeaders()".
procedure RemoveHeaders(Message : TStringlist;
const Remove_Headers: String

);
var i : integer;
k : integer;
s : string;
CommaPos : integer;
DelHeader : TStringlist;
RemoveH : String;
begin
RemoveH := Remove_Headers;
i := 0;

If ( RemoveH <> '' ) then begin
try
DelHeader := TStringlist.Create;
if ansipos ( ',', RemoveH) = 0 then begin
DelHeader.Add ( LowerCase ( TrimLeft( RemoveH )));
end // if
else begin
CommaPos := 0;
for k := 1 to length ( RemoveH ) do begin
If RemoveH[k] = ',' then begin
DelHeader.Add ( LowerCase ( TrimLeft (copy ( RemoveH, CommaPos + 1, k - ( CommaPos + 1 )))));
CommaPos := k;
end; // if
if k = length ( RemoveH ) then
DelHeader.Add ( LowerCase ( TrimLeft (copy ( RemoveH, CommaPos + 1, k - CommaPos ))));
end; // for
end; // else
s:= Message.text;
while (Message.Strings[i]<>'') do begin
k := 0;
while k <= ( DelHeader.Count - 1 ) do begin
if pos( DelHeader[k], LowerCase ( Message.Strings[i] )) = 1 then
begin

delete ( s, pos(DelHeader[k], LowerCase (s) ), length (Message.Strings[i] ) + 2 );

i := i - 1;
k := DelHeader.Count - 1;
message.text := s;
end; // if
k := k + 1;
end; // while
i := i + 1;
end; //while
message.text:=s;
finally
DelHeader.Free;
end; // try - finally
end; // if

end; // RemoveHeaders

(*
Format for Add_Headers: {} = required, [] = optional
{HeaderName: HeaderValue{#13#10}}[HeaderName: HeaderValue{#13#10}][...]
Examples: (each header must end with CR+LF)
- Single header: 'User-Agent: '#13#10
- Multiple headers: 'User-Agent: MyNewsClient'#13#10'X-Comment: To be, or not to be'#13#10
*)

// The user is not expected to need to customize "AddHeaders()".
procedure AddHeaders(var Message : TStringlist;
const Add_Headers: String
);
var
SeparatorIndex: integer;
s: string;
begin
s:= Message.Text;
// writetolog('***before***'#13#10+s, 7);
SeparatorIndex:= pos(#13#10#13#10, s);
Insert(Add_Headers, s, SeparatorIndex+2);
Message.Text:= s;
// writetolog('***after***'#13#10+s, 7);
end;

// The user is not expected to need to customize "StrMatch()".
// WARNING: The StrMatch function can only check the first listed newsgroup!
// Define a StrContains function if you want to match either/or newsgroups!
// function StrContains(const Str: string; const Pattern: string): boolean;
// begin
// result:= pos(Pattern, Str) > 0;
// end;
// These will return `true`:
// StrMatch('abc', 'abc') //"abc" is at start of "abc"
// StrMatch('abc', 'ab') //"ab" is at start of "abc"
// StrMatch('abc', 'a') //"a" is at start of "abc"
// These will return `false`:
// StrMatch('abc', 'abcd') //"abcd" is not at start of "abc"
// StrMatch('abc', 'bc') //"bc" is not at start of "abc"
// StrMatch('abc', 'b') //"b" is not at start of "abc"
// StrMatch('abc', 'c') //"c" is not at start of "abc"
// EXAMPLE: This StrMatch will only match if either n.s.r or a.f.n is the *first* ng in the Newsgroups header:
// if (StrMatch (newsgroup, 'news.software.readers') or StrMatch(newsgroup, 'alt.free.newsservers')) then result := 'id01'
// If defined, this StrContains will match either newsgroup or both in the outgoing Newsgroup header:
// if StrContains(newsgroup, 'news.software.readers') or StrContains(newsgroup, 'alt.free.newssservers') then result := 'id01'
function StrMatch(str: String; pattern: String):Boolean;
var
patternSize : Integer;
subStr : String;
compareRes : Integer;
begin
patternSize := Length(pattern);
subStr := Copy(str, 1, patternSize);
compareRes := CompareStr(pattern, subStr);
if (compareRes = 0) then
result := true
else
result := false;
end;
////////////////////////////////////////////////////////////////////////////
// CAVEAT: You can't use % or ; in identity names.
// WARNING: With special characters (including a period) Dialog adds doublequotes automatically!
// For example, if your user name is John Doe, the search is for John Doe
// and if your user name is John A Doe, the search is for John A Doe
// But if you use a name of John A. Doe, the search is for "John A. Doe"
// WRONG: else if (StrMatch(from, 'John A. Doe <j...@is.invalid>')) then result := 'id01'
// RIGHT: else if (StrMatch(from, '"John A. Doe" <j...@is.invalid>')) then result := 'id01'
////////////////////////////////////////////////////////////////////////////
function From2Identity(from: String): String;
begin
if (StrMatch(from, '"John A. Doe" <j...@is.invalid>')) then result := 'id01'
else if (StrMatch(from, '"J.Doe" <j....@nospam.net>')) then result := 'id02'
else if (StrMatch(from, 'j doe <jd...@jdoe.com>')) then result := 'id03'
else
result := '';
end;

// The user is not expected to need to customize "StrContains()".
function StrContains(const Str: string; const Pattern: string): boolean;
begin
result:= pos(Pattern, Str) > 0;
end;

// The user is expected to modify to their own newsgroup(s) below.
function NewsGroup2Identity(newsgroup: String): String;
begin
if StrContains(newsgroup, 'news.software.readers') or StrContains(newsgroup, 'alt.free.newssservers') then
result := 'id01'
else if StrContains(newsgroup, 'alt.privacy') then
result := 'id02'
else if StrContains(newsgroup, 'alt.privacy.anon-server') then
result := 'id03'
else
result := '';
end;

// CUSTOMIZATION: servers server1, server2, etc.
// The user is expected to modify to their own server(s) below.
// The name of the server is what 40tude Dialog lists in the "Available Servers" GUI
function Server2Identity(server: String): String;
begin
if (CompareStr(server, 'aioe') = 0) then result := 'id01'
else if (CompareStr(server, 'mixmin') = 0) then result := 'id02'
else if (CompareStr(server, 'eternalsept') = 0) then result := 'id03'
else result := '';
end;

// The user is not expected to need to customize "GetIdentities()".
procedure GetIdentities(var message: TStringlist; servername: string;
isEmail: boolean; var FromIdentity: String; var NewsgroupIdentity: String;
var ServerIdentity: String);
var i : Integer;
begin
FromIdentity := '';
NewsgroupIdentity := '';
ServerIdentity := '';
if (not IsEmail) then
begin
for i := 0 to Message.Count - 1 do
begin
if (strMatch(Message[i], 'From:')) then
fromIdentity := Copy(Message[i], 7, Length(Message[i]) - 6);
if (strMatch(Message[i], 'Newsgroups:')) then
newsgroupIdentity := Copy(Message[i], 13, Length(Message[i]) - 12);
end;
fromIdentity := From2Identity(fromIdentity);
newsgroupIdentity := NewsGroup2Identity(newsgroupIdentity);
serverIdentity := Server2Identity(servername);
// The default log file is C:/Program Files/40tude/logs/YYYYMMDD.log
WriteToLog(' fromIdentity = ' + fromIdentity, 7);
// fromIdentity = id02
WriteToLog(' newsgroupIdentity = ' + newsgroupIdentity, 7);
// newsgroupIdentity =
WriteToLog(' serverIdentity = ' + serverIdentity, 7);
// serverIdentity = id07
end;
end;

// The user is not expected to need to customize "LogHeaders()".
procedure LogHeaders(var Message: TStringlist);
var
i: integer;
s: string;
begin
s:= '';
for i:= 0 to message.count-1 do
begin
if message[i] <> '' then s:= s+message[i]+#13#10
else break;
end;
writetolog(s, 7);
end;

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

var
ForEmail: boolean;
ForNewsgroup : boolean;
FromIdentity: String;
NewsgroupIdentity: String;
ServerIdentity: String;
Remove_Headers: String;
Add_Headers: String;
begin

// CUSTOMIZATION: main decision tree
// The user may wish to customize this main decision tree.
// Four program decisions to be made if you wish to change the program defaults:
// 1. This Boolean sets whether email headers are modified:
// ForEmail := false; //false means don't do email message by default
// ForEmail := true; //true means do email headers
// 2. This Boolean sets whether newsgroup headers are modified:
// ForNewsgroup := false; //false means don't do newsgroup message by default
// ForNewsgroup := true; //true means do newsgroup messages
// 3. This string syntax sets the default headers to remove (if not redefined):
// Remove_Headers := ''; //null means don't remove any header by default
// Remove_Headers := 'User-Agent: ,Message-ID: '; //string means remove these headers
// 4. This string syntax sets the default headers to add (if not redefined):
// Add_Headers := ''; //null means don't add any header by default
// Add_Headers := 'X-Comment: John Doe was here'; //string means add these header strings
// NOTE: By default, 40Tude-Dialog generates a dialog-specific message id.
// You can turn off this message-id autogeneration in the Dialog GUI.
// Or you can remove that message-id after the fact in this script.
// NOTE: By default, 40Tude-Dialog sends the system date to the news server.
// The news server will use that system date in the Date: header.
// The news server will generate a GMT date if there is no Date: header.

GetIdentities(message, servername, isEmail, FromIdentity, NewsgroupIdentity, ServerIdentity);
ForEmail := false; //false means don't do email message by default
ForNewsgroup := true; //true means do newsgroup messages
// Remove_Headers := ''; //null means don't remove any header by default
Remove_Headers := 'User-Agent: ,Message-ID: ,Date: ,Mime-Version: ,Content-Type: ,Content-Transfer-Encoding: ';
//Remove_Headers := 'Organization: ,User-Agent: ,Message-ID: ,Mime-Version: ,Content-Type: ,Content-Transfer-Encoding: ';
Add_Headers := ''; //null means don't add any header by default
// If nothing below matches, the defaults above are used for the headers.
{The main decision.
// Add_Headers := 'User-Agent: tin'#13#10 + 'X-Abuse-and-DMCA-Info: Please be sure to forward a copy of ALL headers'#13#10;

For FromIdentity, comparison must match against string returned by From2Identity() function.
Same applies to NewsgroupIdentity and ServerIdentity.
Identities may be an empty string.

Set Remove_Header to remove header(s).
Set Add_Header to add header(s).
Set ForEmail and/or ForNewsgroup to `true` to add/remove header for email/newsgroup messages.
}

////////////////////////////////////////////////////////////////////////////////
if (ServerIdentity = 'id01') then
begin
ForNewsgroup := true;
Remove_Headers := 'User-Agent: ';
Add_Headers := 'User-Agent: Foobar'#13#10;
end // id01

else

if (FromIdentity = 'id02') and (NewsgroupIdentity = 'id02') then
begin
ForNewsgroup := true;
Remove_Headers := 'User-Agent: ,Message-ID: ,Date: ';
Add_Headers := 'User-Agent: Foobar'#13#10 + 'Situation: Snafu'#13#10;
end // id02

else

if (ServerIdentity = 'id01') and (NewsgroupIdentity = 'id02') and (FromIdentity = 'id03') then
begin
ForEmail := false;
ForNewsgroup := true;
Remove_Headers := 'User-Agent: ,Message-ID: ,Date: ,Mime-Version: ,Content-Type: ,Content-Transfer-Encoding: ';
Add_Headers := 'User-Agent: Foobar'#13#10 + 'Situation: Snafu'#13#10 + 'Organization: None'#13#10;
end; // id03
// That last "end" above must conclude with a semicolon!

if (IsEmail and ForEmail) or ((not IsEmail) and ForNewsgroup) then
begin
if Remove_Headers <> '' then RemoveHeaders(Message, Remove_Headers);
if Add_Headers <> '' then AddHeaders(Message, Add_Headers);
end;

result := true;
// result := false; //uncomment this line for testing purposes (doesn't send the message)
// At the moment, if nothing matches, the defaults apply (which is set to remove all and add none).
end;
// ----------------------------------------------------------------------
begin
end.

[Bernd Rose]

On Sat, 20th Nov 2021 22:10:19 +0200, Rudolph Rhein wrote:

> 40tude Dialog pascal-based delphi scripts are hard to find.

Depends on your search method. With starting point of the "Links" page
of the German FAQ for 40tude Dialog:

https://www.barghahn-online.de/4td_faq/links.php

you get direct access to the latest archived version of the former
central Dialog script website from datalist.org. This is usually the
best starting point of a search for a script and the source of the
first script you posted. Skimming through these scripts should also
give you a good idea for good search terms on general search engines.

The FAQ also links to two still active websites of script authors.
Please note, that some of these newer scripts don't work standalone,
but require include files with general functions. So, be sure to
carefully read all instructions.

If you use general search engines, use the Dialog-internal function
names appropriate to your search, like "OnBeforeSendingMessage" and
accompany them with general terms like "remove" to narrow the search
down. A list of all Dialog-internal functions provides the first
script linked from the "Skripte" page of the German Dialog FAQ:

https://www.barghahn-online.de/4td_faq/scripts/AlleBefehle.ds

You also can search Usenet archives. For Narkive you use a general
search engine with a term like:

OnBeforeSendingMessage remove site:narkive.com

Google Groups can still be searched in a group-specific way. Because
there are only 3 newsgroups likely to get you relevant hits (okay,
I omit some international groups, esp. from Poland and Italy, which
have been very active), the necessary searches can be narrowed down:

https://groups.google.com/g/news.software.readers/search?q=OnBeforeSendingMessage%20remove
https://groups.google.com/g/de.comm.software.40tude-dialog/search?q=OnBeforeSendingMessage%20remove
https://groups.google.com/g/de.comm.software.newsreader/search?q=OnBeforeSendingMessage%20remove

All of the above are likely to bring up only few hits, which moreover
will intersect each other a great deal.

---------

To answer your original question:

> Any updates to this RemoveHeaders.ds script you know of?

"Updates" is the wrong term. There are several (few) approaches, which
learned from each other and emphasize different aspects. If you are
not satisfied with one of them, try to combine or extend them. And if
you need help, ask here or in dcs4-d.

Bernd