NewPost

From 40tude Dialog Wiki

As many people filter posts on a tag, if it is hand added, forgiven it, is always possible.

This script adds it every time it is necessary.

It can be adapted to add different Tags for different goups.

In this version, it adds a [Dialog] tag in newsgroup managment newsgroups and an empty tag in others.

With the "settings for active script", you can link the newpost icon and the newpost shortcut (usually P) to this script so it can replace the standard command.

Program NewPost;

  {Beta version 1.1.2 - 2003/10/01 10:55
  Bug correction in newgroup name extraction
  Empty tag for non Newsreader goups
  Beta version 1.0.1 - 2003/08/15 10:50
  compile and run with Dialog version 2.0.5.1
  Check the source code or save your data before use.}

  { As many people filter posts on a tag, if it is hand added,
    forgiven it, is always possible. This script do it every time it is necessary.
    With the "settings for active script", link the newpost icon and the newpost shortcut
    (usually P) to this script so it can replace the standard command}

{
 Previously done in the OnBeforeSendingMessage script, the tag addition in the subject has
 been move into a custom script as the coding of the controlkey for posts sent by
 somebody who donated is fooled by the modification of subject header in OnBeforeSendingMessage
 and the star is not displayed. It is perfect for discreet people, but disturbing for the others
 who see the star from time to time only :-)
}

uses
   Forms,
   StdCtrls;

CONST
   {Tag to be added in the subject}
   TAG = '[[Dialog]] ';
   VK_LEFT = $25; {virtual key code for postkey}
   {a file where the name of all newsgroups where the tag has to be added}
   NewsReaderFileName = 'C:\Mes documents\Short Newsreader.txt';
{    the format follows the sample here after:
news.software.readers
fr.usenet.logiciels
    }
   FUNCTION EmptyClipboard:boolean; external 'EmptyClipboard@user32.dll stdcall';
   FUNCTION OpenClipboard(hWndNewOwner: INTEGER):boolean; external 'OpenClipboard@user32.dll stdcall';
   FUNCTION CloseClipboard:boolean; external 'CloseClipboard@user32.dll stdcall';
   PROCEDURE ClearCLipboard;
   {to avoid side effects: if an empty selection is copyed in the clipboard}
   BEGIN
      OpenClipboard(Application.Handle);
      EmptyClipboard;
      CloseClipboard;
   END;

   {++ thanks to Juergen Haible for his help and advises on VKKeyScan and PostKey ++}

   FUNCTION VkKeyScan( ch: Char ): SmallInt;
            external 'VkKeyScanA@user32.dll stdcall';

   PROCEDURE PutLine(ALine : String);

   VAR
      Letter : Byte;
      KeyCode : Word;
      VKINFO : SmallInt;
      VKState : SmallInt;

   BEGIN
      FOR Letter := 1 TO Length(Aline) DO
      IF ((ALine[[Letter]] >= 'A') AND (ALine[Letter] <= 'Z')) THEN
      PostKey( Ord(ALine[[Letter]]), true, false,false, false,false,false,false,false)
         ELSE  IF (ALine[[Letter]] >= 'a') AND (ALine[Letter] <= 'z') THEN
           PostKey( Ord(ALine[[Letter]])-(Ord('a')-ord('A')), false, false,false, false,false,false,false,false)
         ELSE
         BEGIN
           VKInfo := VkKeyScan(ALine[[Letter]]);
           IF VKInfo <> -1 THEN
           BEGIN
            KeyCode := VKInfo AND $FF;
            vkState := ( VKInfo AND $FF00 ) SHR 8; // shift state
        {   PostKey( key: Word; Shift, Alt, Ctrl, Left, Right, Middle, Double,specialkey: Boolean); }
            PostKey(KeyCode, VKState AND $01 = $01, VKState AND $04 = $04,VKState AND $02 = $02,
                                false,false,false,false,false)
         END
      END;
      {here, we don't need a CR as the subject has to be completed}
   //   PostKey( 13, true, false,false,false,false,false,false,false);
   END;


   FUNCTION IsNewsGroupToTag(GroupName :string) : boolean;

   {extract groupname from a clipboard copy of the current newsgroup panel line}

   VAR
      list: TStringList;
      index : integer;
      NotOpenBracket : boolean;

   BEGIN
      IF GroupName > '' THEN
      BEGIN
         {must be adapted to the layout if it is not the default one}
         IF POS(Chr(9), GroupName) = 1 THEN
         {delete tab}
            Delete(GroupName, 1, 1);
         IF (length(GroupName) > 0) THEN
            IF (GroupName[[1]] >= '0') AND (GroupName[1] <= '9') THEN
         {delete number of new message, if present}
               Delete(GroupName,1, pos(chr(9),GroupName));
         index := length(GroupName);
         NotOpenBracket := true;
         WHILE (index > 0) AND NotOpenBracket DO
         {delete the newssever name, if present}
         BEGIN
            NotOpenBracket := GroupName[[index]]<> '(';
            IF NotOpenBracket THEN
               index := index-1
         END;
         delete(GroupName,index, length(GroupName)-index+1);
         GroupName := trim(GroupName);
         {check if the groupname is one of the file saved groupnames}
         List := TStringList.Create();
         try
         List.LoadFromFile(NewsReaderFileName);
         Result := List.Indexof(GroupName) > -1;
         finally
         List.free
         end;
      END
      ELSE
         Result := false;
   END;

   PROCEDURE OpenNewPost;

   VAR
      DummyForm : TForm;
      DummyMemo : TMemo;
      Buffer : string;
   BEGIN
      { If many lines are selected, if only one is analysed,
       there could be discrepency beetwen the TAG and the groupname
       and I found no way to avoid it. As multiselection of groups in
       grouppane has no valuable rational, don't do a multiselection
       or the program will reject you !}
      ADo('NewgroupPane');
      {read all the pane, if called from another pane}
      Ado('Copy');
      {Read selected info into clipboard}
      Ado('Copy');
      Dummyform := TForm.Create(Nil);
      try
      DummyMemo := TMemo.Create(Dummyform);
      DummyMemo.Parent := Dummyform;
      DummyMemo.Width := 1000; {to avoid word wrap side effects}
      DummyMemo.PasteFromClipBoard;
      IF DummyMemo.Lines.count > 1 THEN
      BEGIN
         beep;
         exit;
      END;
      Buffer := DummyMemo.Text;
      {open the writing window}
      ADo('NewPostToNewsgroup');
      {If groupname OK, add the tag}
      IF IsNewsGroupToTag(Buffer) THEN
         Putline(Tag)
      ELSE
      BEGIN
         PutLine('[[]]');
         postkey(VK_Left,false,false,false,false,false,false,false,true);
      END;
      finally
      DummyForm.free;
      end;
   END;


Begin
   OpenNewPost
End.