Netdigest
From 40tude Dialog Wiki
Contents |
Netdigest
Send a posting to netdigest with a few clicks.
Installation
Copy the script below and paste it as 'Custom Script'. Save and compile the script. I recommend to assign a shortcut to the script, so you can send a posting to netdigest with 2 keystrokes.
Configuration
If you want to use the script with a not german netdigest, then you have to change the email-address to which the posting have to be sent. You find a constant called Netdigest in line 29 of the script. Please change this to the required value.
Using the script
If you have assigned a shortcut, select the message you want to send to netdiges, press your shortcut and send the new message.
Hints & Warnings
- It is strongly recommended (probably even vitally important) that you have read and understood the PostKey() script warning page before trying out this script.
- Und weil's so wichtig ist, nochmal auf Deutsch: Es wird dringend empfohlen (bzw. als unerlässlich angesehen), dass Ihr die PostKey()-Script Hinweisseite gelesen und verstanden habt, bevor Ihr das Script ausprobiert.
- If the script fails (for example no To addresses appear), you may have released the shortcut-key too late. Just cancel the message editor window and try again.
The Script
// ---------------------------------------------------------------- //
// --- Netdigest (email) © by Kai Juerges ----------------------- //
// ---------------------------------------------------------------- //
// --- Based on Reply2All © by Kai Juerges ---------------------- //
// --- Slightly[tm] amended by Dirk Straka ;©) ------------------ //
// ---------------------------------------------------------------- //
// --- Any bugs, questions, hints? Please come to either ------- //
// --- de.comm.software.40tude-dialog or send me an email. ------ //
// --- kai@juerges.de ------------------------------------------- //
// ---------------------------------------------------------------- //
// --- This script is beta! Use on your own risk. -------------- //
// --- Please check the mail before sending! -------------------- //
// ---------------------------------------------------------------- //
Program Netdigest;
//
// declare needed Windows-internals
//
uses
Forms,
StdCtrls;
//
// set E-Mail for Netdigest here
//
const
Netdigest = 'de-alt-netdigest@moderators.dana.de';
// ---------------------------------------------------------------- //
// Subroutines for header retrieval
//
// Copy message body to dummyMemo
//
procedure GetMsgBody(
var dummyMemo : TMemo
);
begin
lockdisplay;
try
dummyMemo.Clear;
ADo( 'ArticlePane' );
ADo( 'SelectAll' );
ADo( 'Copy' );
dummyMemo.PasteFromClipboard;
finally
unlockdisplay;
end; // try
end; // procedure GetMsgBody()
//
// Get specified header field (e. g. 'From', 'To' or 'Cc') from message
//
function GetHeader(
const FieldName : String;
const dummyMemo : TMemo;
const HeaderLineCnt : Integer
): string;
var
i, j, k : Integer;
colonpos : Integer; // pos of colon, to determine header name length
found_next_header : Boolean;
begin
result := '';
found_next_header := false;
FieldName := Uppercase( FieldName ); // header field names are NOT case sensitive :o(
for i:=0 to HeaderLineCnt do begin
if (Pos(FieldName+': ', Uppercase(dummyMemo.Lines[i])) = 1) then begin
colonpos := Pos( ':', dummyMemo.Lines[i] );
result := Copy( dummyMemo.Lines[i], colonpos+2, Length(dummyMemo.Lines[i]) );
//
// Got first line of given header type - now check if next line is continuation
// or next header. If it's the next header field, there will be a colon terminated
// keyword. Following RFC 822 field names must be composed of printable ASCII
// characters (i. e., characters that have values between 33. and 126., decimal,
// except colon).
//
for j:=i+1 to HeaderLineCnt do begin
for k:=1 to Length(dummyMemo.Lines[j]) do begin
if (dummyMemo.Lines[j][k] = ':') and (k > 1) then begin
found_next_header := true;
break;
end; // if
if (Ord(dummyMemo.Lines[j][k]) < 33)
or (Ord(dummyMemo.Lines[j][k]) > 126)
then begin
break;
end; // if
end; // for
if found_next_header then break;
result := result + dummyMemo.Lines[j];
end; // for
end; // if ": "
end; // for
end; // function GetHeader()
//
// Check if headers are visible in message pane.
// If so, set HeaderLineCnt, otherwise return false.
//
function CountHeaderLines(
const dummyMemo : TMemo;
out cnt : Integer
): boolean;
var
i : Integer;
found_From : Boolean;
found_To : Boolean;
found_Date : Boolean;
begin
cnt := 0;
result := false; // Default: No headers visible
found_From := false; // No From header seen so far
found_To := false; // No Newsgroups header seen so far
found_Date := false; // No Date header seen so far
// Minimum header lines
// 1. From 2. Newsgroups 3. Date
// Attention: Header field names are NOT case sensitive! :o(
if dummyMemo.Lines.count > 2 then begin
for i:=0 to dummyMemo.Lines.count do begin
if (Pos('FROM: ', Uppercase(dummyMemo.Lines.strings[i])) = 1)
then found_From := true;
if (Pos('NEWSGROUPS: ', Uppercase(dummyMemo.Lines.strings[i])) = 1)
then found_To := true;
if (Pos('DATE: ', Uppercase(dummyMemo.Lines.strings[i])) = 1)
then found_Date := true;
if (dummyMemo.Lines.strings[i] = '') // end of header section
or (found_From and found_To and found_Date) // no need to search longer
then begin
break;
end;
end; // for
result := (found_From and found_To and found_Date);
end; //if
if result then begin
for i:=1 to dummyMemo.Lines.count do begin
if dummyMemo.Lines.strings[i] = '' then begin
cnt := i;
break;
end; // if
end; // for
end // if
end; // function CountHeaderLines()
// Subroutines for header retrieval finished
// ---------------------------------------------------------------- //
//
// Just a more convenient interface for PostKey()
//
procedure PKeySAC(
const key : Integer;
const shift : Boolean;
const alt : Boolean;
const ctrl : Boolean
);
begin
PostKey(key, shift, alt, ctrl, false, false, false, false, false);
end;
procedure SetClipbrd(
const dummyMemo : TMemo;
const text : String
);
begin
dummyMemo.Clear;
dummyMemo.Text := text;
dummyMemo.SelectAll;
dummyMemo.CopyToClipboard
end;
//
// Paste Header in Message
//
procedure InsertHeader(
const dummyMemo : TMemo;
const text : String
);
begin
SetClipbrd (dummyMemo, text);
PKeySAC(86, false,false, true); // <Ctrl>V =~ Paste
PKeySAC(13, false,false, false); // Enter
end;
// ---------------------------------------------------------------- //
// ------------------------ Main ------------------------------ //
// ---------------------------------------------------------------- //
//
// declare needed vars
//
var
dummyForm : TForm;
dummyMemo : TMemo;
dummyMemo2 : TMemo;
HeaderLineCnt : Integer;
hdrNewsgroups : String;
hdrDate : String;
hdrSubject : String;
hdrMessageId : String;
hdrFrom : String;
begin
//
// initialization
//
HeaderLineCnt := 0;
//
// initialize dummyMemo (buffer for MSG headers)
//
dummyForm := tForm.Create( nil );
dummyForm.Visible := false;
dummyMemo := tmemo.Create( dummyForm );
dummyMemo.Parent := dummyForm;
dummyMemo.Visible := false;
dummyMemo.Width := 2048; // chars per line
dummyMemo2 := tmemo.Create( dummyForm );
dummyMemo2.Parent := dummyForm;
dummyMemo2.Visible := false;
dummyMemo2.Width := 2048; // chars per line
//
// Now, let's do it! ;o)
// We'll fetch the header lines ...
//
GetMsgBody( dummyMemo );
GetMsgBody( dummyMemo2 );
if not CountHeaderLines( dummyMemo, HeaderLineCnt ) then begin
ADo( 'ShowHeaders' );
GetMsgBody( dummyMemo );
Ado( 'ShowHeaders' );
CountHeaderLines( dummyMemo, HeaderLineCnt );
end // if
else begin
ADo( 'ShowHeaders' );
GetMsgBody( dummyMemo2 );
Ado( 'ShowHeaders' );
end;
hdrFrom := GetHeader('From', dummyMemo, HeaderLineCnt );
hdrDate := GetHeader('Date', dummyMemo, HeaderLineCnt);
hdrSubject := GetHeader('Subject', dummyMemo, HeaderLineCnt);
hdrMessageId := GetHeader('Message-Id', dummyMemo, HeaderLineCnt);
hdrNewsgroups := GetHeader('Newsgroups', dummyMemo, HeaderLineCnt);
ADo('NewEmailMessage');
application.processmessages;
lockdisplay;
application.processmessages;
try
//
// paste the Subject
//
SetClipbrd (dummyMemo, '[' + hdrNewsgroups + '] ' + hdrSubject);
application.processmessages;
PKeySAC(86, false,false, true); // <Ctrl>V =~ Paste
application.processmessages;
//
// paste the To-Field
//
PKeySAC( 9, false, false, false); // <Tab>
PKeySAC( 9, false, false, false); // <Tab>
application.processmessages;
SetClipbrd (dummyMemo, Netdigest);
application.processmessages;
PKeySAC(86, false,false, true); // <Ctrl>V =~ Paste
application.processmessages;
//
// Go to editor-window
//
PKeySAC( 9, false, false, false); // <Tab>
PKeySAC( 9, false, false, false); // <Tab>
PKeySAC(36, false, false, false); // No Sig
PKeySAC( 9, false, false, false); // <Tab>
PKeySAC( 9, false, false, false); // <Tab>
PKeySAC( 9, false, false, false); // <Tab>
PKeySAC( 9, false, false, false); // <Tab>
//
// paste the Headers
//
application.processmessages;
InsertHeader(dummyMemo, 'From: ' + hdrFrom);
application.processmessages;
InsertHeader(dummyMemo, 'Subject: ' + hdrSubject);
application.processmessages;
InsertHeader(dummyMemo, 'Newsgroups: ' + hdrNewsgroups);
application.processmessages;
InsertHeader(dummyMemo, 'Date: ' + hdrDate);
application.processmessages;
InsertHeader(dummyMemo, 'Message-Id: ' + hdrMessageId);
application.processmessages;
//
// paste the Message itself
//
PKeySAC(13, false,false, false); // Enter
dummyMemo2.SelectAll;
dummyMemo2.CopyToClipboard
application.processmessages;
PKeySAC(86, false,false, true); // <Ctrl>V =~ Paste
finally
unlockdisplay;
end; // try
end. // bye baby!
Begin
End.
Greets, Kai