ReadArticleInGoogleGroups
From 40tude Dialog Wiki
With this script you are able to load the article you are reading at the moment inside Dialog, from Google Groups. This little script was done by Reiner Wolff (spam@wolffsrudel.de).
Also, check out ReadArticleInGoogleGroups2, which uses the ShellExecute API function instead of PostKey.
Warnings
- Note that this script can not run from inside the scripting engine.
- Its possible that you sometimes get an error that Dialog is frozen. If you have hints how to fix this report it to spam@wolffsrudel.de.
- Please read the Postkey script warning page before trying out this script.
Program ReadArticleInGoogleGroups;
uses
Forms,
StdCtrls;
CONST
{Tag to detect a given Header}
MessageIDHeader = 'Message-ID: ';
DateHeader = 'Date: ';
FromHeader = 'From: ';
GMEM_DDESHARE = $2000;
GMEM_MOVEABLE = $2;
VAR
{dummy controls to paste and copy}
DummyForm : TForm;
DummyMemo : TMemo;
tmpForm : TForm;
tmpMemo : TMemo;
MessageID : string;
HeadersAreHidden : Boolean;
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 must be copyed in the clipboard}
BEGIN
OpenClipboard(0);
EmptyClipboard;
CloseClipboard;
END;
PROCEDURE GetMessageBody (VAR LocDummymemo : tmemo);
BEGIN
{Select the message body, select all text and copy it}
LocDummyMemo.Clear;
{As copy does nothing if the selection is empty, ClearClipboard avoid side effects
when a messagebody is empty}
ClearCLipboard;
ADo('ArticlePane');
ADo('SelectAll');
Ado('Copy');
LocDummyMemo.PasteFromClipboard;
END;
FUNCTION ExtractHeaderLine( HeaderTag : String;VAR LocDummymemo : tmemo): string;
VAR
index : integer;
BEGIN
Index := 0;
Result := '';
WHILE (Index < LocDummymemo.Lines.count-1) AND (Result = '') DO
{When headers are displayed, there is always an empty line after the last header,
so Index is always under LocDummymemo.Lines.count-1 for the last header}
BEGIN
{detect if a given header is present}
IF POS(HeaderTag,LocDummymemo.lines.Strings[index]) = 1 THEN
BEGIN
Result := LocDummymemo.lines.Strings[index]; {Get found info}
IF Result = HeaderTag THEN
{May be a word wrap problem, add following lines}
BEGIN
Index := index+1;
WHILE (Index < LocDummymemo.Lines.count-1)
AND (POS(': ',LocDummymemo.lines.Strings[index])=0) DO
BEGIN
Result := Result +LocDummymemo.lines.Strings[index+1];
index := index+1
END
END
END
ELSE
Index := Index+1;
END;
END;
FUNCTION GetHeaderInfo( HeaderTag : String;VAR LocDummymemo : tmemo): string;
BEGIN
{GetHeader line and delete header tag}
Result := ExtractHeaderLine( HeaderTag, LocDummymemo);
delete(Result, 1, length(HeaderTag));
END;
PROCEDURE BuildDummyContainers;
BEGIN
DummyMemo := tmemo.Create(DummyForm);
DummyMemo.Parent := DummyForm;
{have a large enought width to avoid wrap around lines}
{freeze if not called from the script window : versions prior to 2.0.6.0
for further version, remove the comment mark and delete the unecessary line}
// DummyMemo.Width := Application.Mainform.width;
DummyMemo.Width := 1000;
END;
FUNCTION AreHeadersHidden(var LocDummymemo : tmemo):boolean;
VAR
index : integer;
BEGIN
Result := true;
{IF less than or equal to 10 lines, headers are hidden}
IF LocDummyMemo.Lines.count > 10 THEN
{at least, there are lines to search if headers are displayed}
BEGIN
{a scan of all lines is done to see if an always existing header is diplayed}
index := 0;
WHILE (Index < LocDummyMemo.Lines.count -1) and result DO
{index is smaller than count-1 if header are displayed as there is always
a blank line after them}
BEGIN
index := index+1;
result := Pos('Newsgroups: ', LocDummyMemo.Lines.strings[index]) = 0
END;
END;
END;
FUNCTION GetMessageId(): string;
var
msgID : String;
begin
DummyForm := tform.Create(nil);
try
BuildDummyContainers;
GetMessageBody(DummyMemo);
HeadersAreHidden := AreHeadersHidden(DummyMemo);
{headers must be displayed to get messageID}
IF HeadersAreHidden THEN
ADo('ShowHeaders');
GetMessageBody(DummyMemo);
// writeln(DummyMemo.Text);
IF HeadersAreHidden THEN
Ado('ShowHeaders');
msgID := GetHeaderInfo(MessageIDHeader, Dummymemo);
{delete the < and > signs around message ID}
msgID := copy(msgID, 2, length(msgID)-2);
result := msgId;
ClearClipboard;
finally
Dummyform.free;
end;
end;
Begin
// write Message-Id from marked article
MessageID := GetMessageID();
writeln ('MsgID: ' + MessageId);
tmpForm := tForm.Create(nil);
tmpForm.Visible := False;
tmpMemo := tmemo.Create(tmpForm);
tmpMemo.Parent := tmpForm;
tmpMemo.Visible := False;
tmpMemo.Clear;
tmpMemo.Text := MessageID;
tmpMemo.SelectAll;
tmpMemo.CopyToClipboard;
// Alt-B, B, to get inside the google search-dialog
PostKey(66,false, true, false, false, false, false, false, false); //Alt-B
PostKey(66,false, false, false, false, false, false, false, false); //B
// 7x Tab-key to get inside the search MID-field
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(9, false, false, false, false, false, false, false, false); //Tab
// paste MID from clipboard
PostKey(86, false, false, true, false, false, false, false, false); //Ctrl+V
// click OK-Button
PostKey(9, false, false, false, false, false, false, false, false); //Tab
PostKey(13, false, false, false, false, false, false, false, false); //Enter
tmpForm.free;
End.
René Fischer