Bertel Lund Hansens hjemmeside

Custom script utilities

Plonk with name and mail address
Plonk relative with name and mail address
Ignore a whole thread
Unignore, mark unread
Next unread message
Prev in history
Next in history
Compact, no backup
Copy
Insert
Save one message as textfile
Produce the Ado function list

Copyright?

I have relied heavily on others' work from the Dialog Wiki while making these scripts. It is therefore understood that others can use them as they see fit - without violating any rights that the programmers of the originals have of course. The basic functionality of the large scripts was not programmed by me.

Plonk with name and mail address

I also use a script so I can plonk with both name and address. If you use it, be aware that keyboard shortcuts with Ctrl or Alt disturbs the function. Choose a simple key.

The original is by MariaLuisa C, but it is no longer available.
Here is my simplified version (shorter, but works the same way):

Program PlonkWithAddress; // Original v0.4 24/Gennaio/2005, by MLC
// Simplified by Bertel Lund Hansen feb 2006.
uses Forms, StdCtrls;

const
 plonkAction = 'AddPlonkFilter';
 // If you want to plonk the subject, use:
 // action = 'AddSubjectPlonkFilter';
// ---------------- End of settings ----------------
var
 myForm: TForm;
 myMemo: TMemo;
 mail: string;
 leaveHeaders: 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;
begin
 OpenClipboard(0);
 EmptyClipboard;
 CloseClipboard;
end;

Function headersAreShown: boolean;
begin
  result:=pos('Path: ', myMemo.Lines.strings[0])<>0;
end;

Procedure GetMsgBody;
begin
 ADo('ShowHeaders');
 ClearClipboard;
 myMemo.Clear;
 ADo('ArticlePane');
 ADo('SelectAll');
 Ado('Copy');
 myMemo.PasteFromClipboard;
 if headersAreShown then begin
  ADo('ShowHeaders');
  if leaveHeaders then ADo('ShowHeaders');
  Exit;
 end;
 leaveHeaders:=true;
 GetMsgBody;
end;

Function GetAddress: string;
var
 i: integer;
 addr: string;
begin
 addr:='';
 for i:=0 to myMemo.Lines.count-2 do
  if Pos('From:', myMemo.lines.Strings[i])=1 then begin
   addr:=myMemo.lines.Strings[i];
   break;
  end
 i:=Pos('<',addr);
 if (i>0) then result:=copy(addr,i,length(addr))
 else result:='';
end;

Procedure BuildContainers;
begin
 myForm:=tForm.Create(nil);
 myMemo:=tMemo.Create(myForm);
 myMemo.Parent:=myForm;
 myMemo.Width:=Application.Mainform.width;
end;


Begin
 lockdisplay;
 try
  BuildContainers;
  leaveHeaders:=false;
  GetMsgBody;
  mail:=GetAddress;
  if (mail='') then myMemo.text:=' '
  else myMemo.text:=' +"'+mail+'"';
  myMemo.SelectAll;
  myMemo.CopyToClipboard;
  ADoLater(plonkAction);
  PostKey(35, false, false, false, false, false, false, false, false); //end
  PostKey(86, false, false, true, false, false, false, false, false); //Ctrl+V
  finally
  unlockdisplay;
  myForm.free;
 end;
End.

Plonk relative with name and mail address

I do not use this script, but I made it on request. It is a combination of two scripts, both made by MariaLuisa C (MLC). If you use it, be aware that keyboard shortcuts with Ctrl or Alt disturbs the function. Choose a simple key.

The originals are no longer available.

Program PlonkRelWithAddr;
// Program PlonkRelativeWithAddress;
//
// PlonkWithAddress: Original v0.4 24/Gennaio/2005, by MLC
// ExpireRelative  : Original by MariaLuisa C (MLC)
// Combined and simplified by Bertel Lund Hansen feb 2006.
(*
Compile only with Ctrl-F9!
and choose only simple keys for shortcuts -
no Ctrl or Alt.
*)

uses Forms, StdCtrls;

// -------- Adjust settings from here: --------
const
 plonkAction = 'AddPlonkFilter';
 // If you want to plonk the subject, use:
 // action = 'AddSubjectPlonkFilter';
 purgeClose = false;
 // true: Purge and close score window automatically.
 // false: Leave score window open and keep cursor on the new line.
 //        You have to purge the scorefile manually once in a while.
 numMonths = 1; // number of months you want the plonk lives (from the current day)
 // National setting:
 language = 'English';
(*
 language = 'French';
 language = 'German';
 language = 'Italian';
*)

// -------- End of adjustments --------
var
 myForm: TForm;
 myMemo: TMemo;
 mail: string;
 purge, okay: Integer;
 leaveHeaders: 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;
begin
 OpenClipboard(0);
 EmptyClipboard;
 CloseClipboard;
end;

Function headersAreShown: boolean;
begin
  result:=pos('Path: ', myMemo.Lines.strings[0])<>0;
end;

Procedure GetMsgBody;
begin
 ADo('ShowHeaders');
 ClearClipboard;
 myMemo.Clear;
 ADo('ArticlePane');
 ADo('SelectAll');
 Ado('Copy');
 myMemo.PasteFromClipboard;
 if headersAreShown then begin
  ADo('ShowHeaders');
  if leaveHeaders then ADo('ShowHeaders');
  Exit;
 end;
 leaveHeaders:=true;
 GetMsgBody;
end;

Function GetAddress: string;
var
 i: integer;
 addr: string;
begin
 addr:='';
 for i:=0 to myMemo.Lines.count-2 do
  if Pos('From:', myMemo.lines.Strings[i])=1 then begin
   addr:=myMemo.lines.Strings[i];
   break;
  end
 i:=Pos('<',addr);
 if (i>0) then result:=copy(addr,i,length(addr))
 else result:='';
end;

function ExpireAfter: string;
var today, after: TDateTime;
begin
 today:=Now;
 after:=IncMonth(today, numMonths);
 result:=' Expire:'+(FormatDateTime('yyyymmdd', after));
end;

Procedure BuildContainers;
begin
 myForm:=TForm.Create(nil);
 myMemo:=tMemo.Create(myForm);
 myMemo.Parent:=myForm;
 myMemo.Width:=Application.Mainform.width;
end;


Begin
 case (language) of
  'English': begin purge:=80; okay:=79; end;
  'French' : begin purge:=80; okay:=79; end;
  'German' : begin purge:=76; okay:=79; end;
  'Italian': begin purge:=67; okay:=75; end;
 end;
 lockdisplay;
 try
  BuildContainers;
  leaveHeaders:=false;
  GetMsgBody;
  mail:=GetAddress;
  if (mail='') then myMemo.text:=' '+ExpireAfter
  else myMemo.text:='+"'+mail+'" '+ExpireAfter;
  myMemo.SelectAll;
  myMemo.CopyToClipboard;
  ADoLater(plonkAction);
  PostKey(35, false, false, false, false, false, false, false, false); // end
  PostKey(86, false, false, true, false, false, false, false, false); // Ctrl+V
  if (purgeClose) then begin
   PostKey(purge, false, true, false, false, false, false, false, false);
   PostKey(okay, false, true, false, false, false, false, false, false);
  end;
 finally
  unlockdisplay;
  myForm.free;
 end;
End.

Eight small utilities

Here are eight small utilities that I use. They do not require much in the line of programming skills, but they are nice to have:

1. Ignore a whole thread

With a shortcut to this program I can ignore a whole thread. This is useful if one has set up ignore to work on subthreads. My shortcut is Ctrl-I.

Program FullIgnore;

Begin
  ADo('CollapseThread');
  ADo('Ignore');
End.

2. Unignore, mark unread

One may wish to unignore a thread and have all messages marked unread (Yes, actually one might!)

Program UnIgnore;

Begin
  ADo('CollapseThread');
  ADo('Ignore');
  ADo('MarkUnread');
End.

3. Next unread message, focus on article pane

I want N to take me to next unread message and set focus on the article pane. Therefore I have this script that takes over the shortcut N:

Program NextUnreadMessage;
Begin
  ADo('SkipToNextUnreadMessage');
  ADo('ArticlePane');
End.

4. Previous message in history, view all

The built-in navigation through history does not find ignored messages if the view excludes them. Therefore I have duplicated the functions, but made sure that all messages are displayed first.

Program PrevMsgInHistory;
Begin
  ADo('View1');
  ADo('PrevMessageInHistory');
End.

5. Next message in history, view all

Program NextMsgInHistory;
Begin
  ADo('View1');
  ADo('NextMessageInHistory');
End.

6. Compact, no backup

I have my own backup routines. Therefore it only annoys me that the compact routine every time asks if I want a backup. This script compacts without asking, but still requires an okay afterwards.

Program CompactNoBackup;
Begin
  ADoLater('CompactDatabase');
  PostKey(75, true, true, false, false, false, false, false, true); //Alt-K
  PostKey(78, true, true, false, false, false, false, false, true); //Alt-N
  ADoLater('NewgroupPane');
End.

Fix some keyboard shortcuts

These next two scripts allows you to bind Ctrl-Insert and Shift-Insert to Copy and Insert. I use those a lot in Windows programs, and Dialog has not implemented them.

7. Copy

Program EditCopy;
Begin
  ADo('Copy');
End.

8. Insert

Program EditInsert;
Begin
  ADo('Insert');
End.

Save one message as textfile eventually appending it to an existing file

I revised a script by MLC that can save a message to a file the name of which is copied from the subject. I wanted to be able to choose any set of headers and to choose to have everything below the signature delimiter excluded.

Unfortunately it can only save one message at the time. If you have a problem with that, I have a C-program that can 'shave' the output of Dialogs own save procedure.

The original is by MariaLuisa C, but it is no longer available.

Program SaveMessage;
// FileSubject v0.3 by MLC
// Revision by BLH
  uses Forms, StdCtrls, Textfile;

// ---------------- Settings ----------------
const
  savePath = 'F:/_Inbound/';
  // write the path of the folder where you want the file to be created
  // notice that the last character must be a slash /
  singleFile = 1; // possible values: 0 or 1.
  // If singleFile=1 every Subject will have a single file
  // and every follow-up will be added to it.
  // if singleFile=0 every message will be saved in a different file
  // (Subject.txt, Subject[001].txt, Subject[002].txt,...).
  allHeaders = false; // all headers saved? true/false.
  // If false the saved headers are only picked from chosenHeaders.
  chosenHeaders = 'From: Subject: Date: Message-ID:';

  stripSig = true; // true/false.
  // If true signature is stripped from the messages.
// ---------------- End of settings ----------------
// You don't need to change anything else in this script.
  newLine = #13#10;

type
  TNoChars = set of Char;

var
  FileHandle, ps: integer;
  fileName, temp, headers, head: string;
  areHid: boolean;
  myForm: TForm;
  myMemo: TMemo;

// ---------------- Utilities ----------------
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;
begin
  // to avoid side effects: if an empty selection must be copyed in the clipboard
  OpenClipboard(0);
  EmptyClipboard;
  CloseClipboard;
end;

Function GetMsgBody: string;
begin
  lockdisplay;
  try
    myMemo.Clear;
    ClearClipboard;
    ADo('ArticlePane');
    ADo('SelectAll');
    Ado('Copy');
    myMemo.PasteFromClipboard;
  finally
    unlockdisplay;
  end;
  result:=myMemo.Text;
end;

Function GetMsgInfo (field: string): string;
var
  i: integer;
begin
  for i:=0 to myMemo.Lines.count-1 do
    if pos(field, myMemo.Lines[i])=1 then break;
  if i=myMemo.Lines.count then result:=''
  else result:=myMemo.Lines[i]+newLine;
end;

Function GetMsgSubject: string;
var
  i: integer;
begin
  for i:=0 to myMemo.Lines.count-1 do
    if pos('Subject: ', myMemo.Lines[i])=1 then break;
  result:=copy(myMemo.Lines[i],10,length(myMemo.Lines[i]));
end;

Function DelSign(sSign:string; sString:string): string;
begin
  result:=StringReplace(sString, sSign, '_', [rfReplaceAll]);
end;

Function removeUnwanted (s:string): string;
var
  i: integer;
  unwanted: TNoChars;
begin
  unwanted:=[':', '/', '\', '*', '|', '<', '>', '?', '"'];
  if copy(s,1,4)='Re: ' then s:=copy(s, 5, length(s)-1);
  i:=1;
  while (i<=length(s)) do begin
    if s[i] in unwanted then s:=DelSign(s[i], s)
    else i:=i+1;
  end;
  result:=s;
end;

Function uniqueFileName (var filename:string): string;
var
  digits, ciffers: integer;
  digitsStr, fil: string;
begin
  // Format: [000].txt;
  // length('000')=3;
  ciffers:=3;
  for digits:=0 to 999 do begin
    digitsStr:=IntToStr(digits);
    while length(digitsStr)<ciffers do digitsStr:='0'+digitsStr;
    fil:=filename+'['+digitsStr+'].txt';
    if not FileExists(fil) then break;
  end;
  result:=fil;
end;

Function headersAreHidden: boolean;
var i: integer;
begin
  for i:=0 to myMemo.Lines.count-1 do begin
    if pos('Newsgroups: ', myMemo.Lines.strings[i])=0 then begin
       result:=true;
       exit;
    end;
  end;
  result:=false;
end;

Procedure BuildMyMemo;
begin
  myMemo:=tMemo.Create(myForm);
  myMemo.parent:=myForm;
  myMemo.width:=Application.Mainform.width;
end;

// ---------------- Write the file ----------------
Procedure writeFile;
var
  sapa: string;
  f: TextFile;
begin
  sapa:=savePath;
  if (sapa[length(sapa)]<>'/') then begin
    writeln(sapa[length(sapa)-1]);
    Application.MessageBox('Your savePath doesn''t end with /  ', 'Error !', 1);
    exit;
  end;
  if not DirectoryExists(savePath) then begin
    Application.MessageBox('Your savePath doesn''t exist!', 'Error !', 1);
    exit;
  end;
  fileName:=savePath+removeUnwanted(GetMsgSubject);// +'.txt'
  case singleFile of
    1: begin
         myMemo.Lines.Add(StringOfChar('*', 75)+newLine);
         fileName:=fileName+'.txt'
         AssignFile(f, fileName);
         if fileexists(filename) then append(f)
         else rewrite(f);
         TextWrite(f, myMemo.text);
         CloseFile(f);
       end;
    0: begin
         fileName:=uniqueFileName(fileName);
         FileHandle:=FileCreate(fileName);
         FileWrite(FileHandle, myMemo.text, length(myMemo.text));
         FileClose(FileHandle);
       end;
    else
      Application.MessageBox('singleFile must be 0 or 1', 'Error !', 1);
  end;
end;

// ---------------- Main ----------------
Begin
  myForm:=TForm.Create(nil);
  lockdisplay;
  try
    BuildMyMemo;
    GetMsgBody;
    areHid:=headersAreHidden;
    if areHid then ADo('ShowHeaders');
    if stripSig then ADo('SupressSignature');
    GetMsgBody;
    if not allHeaders then begin
      headers:=trim(chosenHeaders);
      temp:='';
      // Read chosen headers one at a time:
      while headers>'' do begin
        ps:=pos(':',headers);
        head:=trim(copy(headers,1,ps));
        delete(headers,1,ps);
        temp:=temp+GetMsgInfo(head+' ');
      end;
      ADo('ShowHeaders');
      myMemo.Text:=temp+newLine+GetMsgBody;
      ADo('ShowHeaders');
    end;
    writeFile;
    if areHid then Ado('ShowHeaders');
    if stripSig then ADo('SupressSignature');
  finally
    unlockdisplay;
    myForm.free;
  end;
End.

Produce the Ado function list

This is the script that produces a list of the user functions for Ado, but the output is not very well formatted.

Program ListADoCommands;

// A text file with all the actions and your existing scripts
const
  filename = 'D:\Dialog\RawListOfCommands.txt';
  //write your path and a filename of your choice
var
  myString: string;
  list: TStringList;

Begin
  list := TStringList.Create();
  myString:=GetActionList;

try
  list.add(myString);
  list.SaveToFile(filename);
finally
  list.free;
end;

End.