• 40Tude Dialog program OnBeforeSendingMessage; procedure Remove

    From Rudolph Rhein@21:1/5 to All on Sat Nov 20 05:55:58 2021
    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.

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From Rudolph Rhein@21:1/5 to All on Sat Nov 20 22:10:19 2021
    Rudolph Rhein <RudolphRhein@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 <kilroy@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 <jad@is.invalid>')) then result := 'id01'
    // RIGHT: else if (StrMatch(from, '"John A. Doe" <jad@is.invalid>')) then result := 'id01'
    ////////////////////////////////////////////////////////////////////////////
    function From2Identity(from: String): String;
    begin
    if (StrMatch(from, '"John A. Doe" <jad@is.invalid>')) then result := 'id01'
    else if (StrMatch(from, '"J.Doe" <j.doe@nospam.net>')) then result := 'id02'
    else if (StrMatch(from, 'j doe <jdoe@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.

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From Bernd Rose@21:1/5 to Rudolph Rhein on Sun Nov 21 08:33:42 2021
    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

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)