Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- // JJAddAndRemoveHeadersWhileDoubleCheckingIdentityNgAndServers
- // Goal: Keep personal and business mail or news conditions separate
- // <http://pastebin.com/2tMYRKM4>
- // Additional comments & examples: http://pastebin.com/LvPvMCPN
- // From: JJ <jj4public@vfemail.net>
- // Newsgroups: news.software.readers,alt.windows7.general
- // Subject: Re: Request help with 40tude dialog program syntax
- // Date: Thu, 5 Jan 2017 23:06:19 +0700
- // Message-ID: <7vpx5y09pu98.1sukl5d600sda$.dlg@40tude.net>
- // Original code for checking identity:
- // http://dialog.datalist.org/scripts/CheckingIdentity.html
- // Original code for modifying headers:
- // http://dialog.datalist.org/scripts/RemoveHeaders.html
- // CUSTOMIZATION:
- // 1. Set the "ForEmail" Boolean as desired (search for "ForEmail :")
- // 2. Set the "ForNewsgroup" Boolean as desired (search for "ForNewsgroup :")
- // 3. Change identity as desired (search for "from,")
- // 4. If ForNewsgroup is true, change newsgroup as desired (search for "newsgroup,")
- // 5. Change server as desired (search for "server,")
- // 6. Change remove header as desired (search for "Remove_Headers :")
- // 7. Change add header as desired (search for "Add_Headers :")
- program OnBeforeSendingMessage;
- (*
- Format for Remove_Headers: {} = required, [] = optional
- {HeaderName: }[,HeaderName: ][,HeaderName: ][...]
- Examples:
- - Single header: 'User-Agent: '
- - Multiple headers: 'User-Agent: ,X-Face: '
- *)
- 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
- WARNING: For the Add_Header, you MUST add the pound13-Pound10 as shown in the examples!
- If you forget to add the #13#10, then Dialog will error when you send news saying something like:
- Posting article failed: 437 Space before colon in "On Fri, 6 Jan 2017" header;
- *)
- 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;
- 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;
- //the xxx2Identity() functions must return an empty string if specified string is not identified
- function From2Identity(from: String): String;
- begin
- if (StrMatch(from, 'First1 Last1 <email1@example.com>')) then
- result := 'id1'
- else if (StrMatch(from, 'First2 Last2 <email2@example.com>')) then
- result := 'id2'
- else if (StrMatch(from, 'First3 Last3 <email3@example.com>')) then
- result := 'id3'
- else
- result := '';
- end;
- function NewsGroup2Identity(newsgroup: String): String;
- // news.software.readers,alt.windows7.general
- //SYNTAX: if (StrMatch(newsgroup, 'ng1') or StrMatch(newsgroup, 'ng2')) then
- begin
- if (StrMatch (newsgroup, 'news.software.readers') or StrMatch(newsgroup, 'alt.free.newssservers')) then
- result := 'id1'
- else if StrMatch(newsgroup, 'alt.free.newsservers') then
- result := 'id2'
- else if StrMatch(newsgroup, 'alt.test') then
- result := 'id3'
- else
- result := '';
- end;
- function Server2Identity(server: String): String;
- begin
- if (CompareStr(server, 'aioe_119') = 0) then
- result := 'id1'
- else if (CompareStr(server, 'mixmin_563') = 0) then
- result := 'id2'
- else
- result := '';
- end;
- 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 lines below write to the log file of the format ./40tude/logs/20161231.log
- WriteToLog(' fromIdentity = ' + fromIdentity, 7);
- WriteToLog(' newsgroupIdentity = ' + newsgroupIdentity, 7);
- WriteToLog(' serverIdentity = ' + serverIdentity, 7);
- end;
- end;
- 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
- //get the identities of the message
- GetIdentities(message, servername, isEmail, FromIdentity, NewsgroupIdentity, ServerIdentity);
- // 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
- 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
- Add_Headers := ''; //null means don't add any header by default
- {The main decision.
- For FromIdentity, comparison must match against string returned by From2Identity() function.
- Same applies to NewsgroupIdentity and ServerIdentity.
- Note that 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.
- }
- // Remove_Headers := 'User-Agent: ,Message-ID: ,Date: ,Mime-Version: ,Content-Type: ,Content-Transfer-Encoding: ';
- if FromIdentity = 'id1' then
- begin
- ForNewsgroup := true;
- Remove_Headers := 'User-Agent: ,Message-ID: ';
- Remove_Headers := 'User-Agent: ,Message-ID: ,Date: ,Mime-Version: ,Content-Type: ,Content-Transfer-Encoding: ';
- Add_Headers := 'X-Comment: JJ is a veritable genius!'#13#10;
- end
- else if (FromIdentity = 'id2') and (NewsgroupIdentity = 'id1') then
- begin
- ForNewsgroup := true;
- Remove_Headers := 'User-Agent: ,Content-Transfer-Encoding: '
- Add_Headers := 'X-Comment: John Doe was here'#13#10;
- end
- else if (FromIdentity = 'id3') and (ServerIdentity = 'id2') then
- begin
- ForEmail := true;
- ForNewsgroup := true;
- Remove_Headers := 'User-Agent: ,Mime-Version: ';
- Add_Headers := 'X-Comment: Jane Doe was here'#13#10 +
- 'X-Greeting: Hello there!'#13#10;
- end;
- 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)
- end;
- // ----------------------------------------------------------------------
- begin
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement