CheckingIdentity

From 40tude Dialog Wiki

This OnbeforeSending-Script is checking the identity (From) before posting\mailing in specified newsgroup(s). So you are sure you can't post\email with a "wrong" identity.

Setup the script:
Modify the 'name <email>' 'ng' and 'id' as you wish.
Possible improvement: Show a dialog box in badIdentity.

Tested successfully on 2.0.14.1

program OnBeforeSendingMessage;

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;

function From2Identity(from: String): String;
begin
  if (StrMatch(from, 'Name1 <email1>')) then
    result := 'id1'
  else if (StrMatch(from, 'Name2 <email2>')) then
    result := 'id2'
  else
    result := 'unknow';
end;

function NewsGroup2Identity(newsgroup: String): String;
begin
  if (StrMatch(newsgroup, 'ng1') or
      StrMatch(newsgroup, 'ng2')) then
    result := 'id1'
  else
    result := 'id2';
end;

function Server2Identity(server: String): String;
begin
  if (CompareStr(server, 'server1') = 0) then
    result := 'id1'
  else
    result := 'id2';
end;

function BadIdentity(): boolean;
begin
  result := false;
end;

function CheckIdentity(var message: TStringlist; servername: string; isEmail: boolean):boolean;
var
  fromIdentity : String;
  newsgroupIdentity : String;
  serverIdentity : String;
  i : Integer;
begin
  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);

    //WriteToLog('  fromIdentity = ' + fromIdentity, 7);
    //WriteToLog('  newsgroupIdentity = ' + newsgroupIdentity, 7);
    //WriteToLog('  serverIdentity = ' + serverIdentity, 7);

    if ((CompareStr(fromIdentity, newsgroupIdentity) = 0) and
      (CompareStr(newsgroupIdentity, serverIdentity) = 0)) then
      result := true
    else
      result := BadIdentity();
  end
  else
    result := true;
end;

function OnBeforeSendingMessage(var message: TStringlist; servername: string; IsEmail: boolean):boolean;
begin
//Your code goes here
//Return false to prevent sending the passed message
  result := CheckIdentity(message, servername, isEmail);
end;

begin
end.