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.