FileSubject

From 40tude Dialog Wiki

v0.3 - 27 June 2005 - MLC

Update

Changes in v0.3:

Now the forbidden characters in the filename are replaced with a "_", so the user can see that something was replaced.

I've added the functions to clear the clipboard, so if another program (for example a clipboard utility, I use ClipX) is blocking it, Dialog warns that it can't access the clipboard.
I've found though that a download manager like Free Download Manager, when it's set to clipboard monitoring, interferes badly with the script without warnings. In this case it's enough to check off the option for clipboard monitoring, there is no need to close the download manager.

Use

You can use this custom script to quick save a message in a text file whose filename is the Subject of the message.

Since the characters ':', '/', '\', '*', '|', '<', '>', '?', '"' are forbidden in a filename, if present in the Subject they are replaced with a _; therefore a message with a Subject like "What do <you> think?" will get the filename "What do _you_ think_.txt".
As you can see, you must have a Windows OS that can handle filenames with spaces inside.

If you save other messages with the same Subject (that is the follow-ups), depending on your initial choice in the Settings you can have two kinds of backups:

• if fileUnique = 1 every Subject will have a unique file and every follow-up will be added in this same file.

• if fileUnique = 0 every message will be saved in a different file: if the first is "This is funny.txt", the following files will be "This is funny[01].txt", "This is funny[02].txt",... (the leading Re: or R: are removed).

If your choice is fileUnique = 1, in the file there will be a line of asterisks at the end of every message, in order to distinguish them better.

It's also possible to choose to save all the headers or only the headers From, Subject, Newsgroups, Date and Message-ID.

In the Settings section you have also to write a valid path where the files will be saved.

Compiled and tested successfully on Dialog 2.0.15.1 (Beta 38)

Script

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

 //---------------------------- Settings ---------------------------------//  
  const
   
    path = 'F:\Programmi\40tude Dialog\Archivio\';
    // write the path of the folder where you want the file to be created
    // notice that the last character must be a back slash \
    
    fileUnique = 1; // possible values: 1 or 0
    // If fileUnique = 1 every Subject will have a unique file
    // and every follow-up will be added in this same file.
    // if fileUnique = 0 every message will be saved in a different file
    // (Subject.txt, Subject[01].txt, Subject[02].txt,...). 
    
    allHeaders = false; // all headers saved? true/false.
    // If false the saved headers are only From, Subject, Newsgroups, Date, Message-ID.
  
 //------------------------ End of Settings -----------------------------// 
 //(you don't need to change anything else in this script)
     
  type
   TNoChars=set of Char;
   
  var
    FileHandle: Integer;
    fileName, temp: string;
    areHid: boolean;
    myForm: TForm;
    myMemo: TMemo;

   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;
    
  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
   i:=0;
   result:='';
   while i < myMemo.Lines.count-1 do
   begin    
    if pos(field, myMemo.Lines[i])>0 then break;
    i:=i+1;
   end; //while
   result:=myMemo.Lines[i];
  end;
 
  function GetMsgSubject: string;
  var
    i: integer;
  begin
    i:=0;
    result:='';
    while i < myMemo.Lines.count-1 do
    begin    
     if pos('Subject:', myMemo.Lines[i])>0 then break;
     i:=i+1;
    end; //while
    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 Adjust(s: string): string;
  var 
   i: integer;
   noChars: TNoChars;
  begin
   if copy(s,1,3)='Re:' then 
    s:=copy(s, 5, length(s)-1)
   else if (copy(s,1,2)='R:') then 
    s:=copy(s, 4, length(s)-1);
   noChars:=[':', '/', '\', '*', '|', '<', '>', '?', '"'];
   i:=1;
   while (i<=length(s)) do
   begin
    if s[i] in noChars then
    begin
     s:=DelSign(s[i], s);
     continue;
    end;
    i:=i+1;
   end;
   result:=s;
  end;
   
  function ChangeName(var file: string): string;
  var
    len, digits: integer;
    fn, base, digitsStr: string;
  begin
    fn:=ExtractFileName(file);
    len:=length(fn);
    base:=copy(fn, 1, len-7);
    digitsStr:='';
    digitsStr:=copy(fn, len-6, 2);
    digits:=StrToInt(digitsStr);  
    digits:=digits+1;
    if length(IntToStr(digits))=1 then digitsStr:='0'+IntToStr(digits)
     else digitsStr:=IntToStr(digits);
    file:=path+base+digitsStr+'].txt';
    if FileExists(file) then result:=ChangeName(file)
     else result:=file;
  end;
  
  function AreHeadHid: boolean;
  var i: integer;
  begin
   result := true;
   if myMemo.Lines.count > 10 then
   begin
    i:=0;
    while (i < myMemo.Lines.count-1) and result do
    begin
      i:= i+1;
      result := pos('Newsgroups: ', myMemo.Lines.strings[i])=0;
    end; //while
   end; //if
  end;
  
  procedure BuildMyMemo;
  begin
   myMemo:=tMemo.Create(myForm);
   myMemo.parent:=myForm;
   myMemo.width := Application.Mainform.width;
  end;
  
  procedure WriteF;
  var
   ps: string;
   f: TextFile;
  begin
   temp:=Adjust(GetMsgSubject);
   ps:=path;
   if (ps[length(ps)]<>'\') then
   begin
    writeln(ps[length(ps)-1]);
    Application.MessageBox('your path doesn''t end with \  ', 'Error !', 1);
    exit;
   end;
   if DirectoryExists(path) then
    fileName:=path+temp+'.txt'
   else
   begin
    Application.MessageBox('your path doesn''t exist!', 'Error !', 1);
    exit;
   end;
   case fileUnique of
    1:
    begin
     myMemo.Lines.Add(#13+#10+StringOfChar('*', 75)+#13+#10+#13+#10);
     AssignFile(f, fileName);
     if fileexists(filename) then append(f)
      else rewrite(f);  
     TextWrite(f, myMemo.text); 
     CloseFile(f);
    end;
    0:
    begin   
      if (FileExists(fileName)) then
      begin
       fileName:=path+temp+'[00].txt';
       fileName:=ChangeName(fileName);
      end;
       FileHandle := FileCreate(fileName); 
       FileWrite(FileHandle, myMemo.text, length(myMemo.text));
       FileClose(FileHandle);
    end;
    else
     Application.MessageBox('fileUnique must be 0 or 1', 'Error !', 1);
   end;
  end;
  
  Begin 
    myForm:=TForm.Create(nil);
    temp:='';
    lockdisplay;
    try
     BuildMyMemo;
     GetMsgBody;
     areHid:=AreHeadHid;
     if areHid then ADo('ShowHeaders');
     GetMsgBody;
     if not allHeaders then
     begin
      temp:=GetMsgInfo('From:')+#13#10+GetMsgInfo('Subject:')+#13#10+GetMsgInfo('Newsgroups:');
      temp:=temp+#13#10+GetMsgInfo('Date:')+#13#10+GetMsgInfo('Message-ID:')+#13#10+#13#10;
      ADo('ShowHeaders');
      temp:=temp+GetMsgBody;
      myMemo.Text:=temp;
      ADo('ShowHeaders');
     end;
     WriteF;
     if areHid then Ado('ShowHeaders');
    finally
     unlockdisplay;
     myForm.free;
    end;
  End.
  

---

MariaLuisa C