Newsgroup: it.comp.software.newsreader
Titolo: [Dialog] Script di MLC OBSav_for_PostShow

    Mi dà un errore di "Unexpected end of file" nell'ultima riga,
anche se funziona. Questo è il testo:
*-----------------------------------------------------------*
// include file for the OnBeforeSavingMessage event, to prepare what
the PostShow script needs.
// (v1.6) 28 Aprile 2005 by MLC
 
//---------------------------- Settings
---------------------------------//
const
   filePost = 'C:\Programmi\40tude Dialog\Post.txt';
     // write your path for the file that will be created by this
script
 
   myFQDN = '
ID-xxxxxx.user.uni-berlin.de
';
   // write your FQDN.
 
   depth = 2;
   // set your preferred depth (greater than 0).
 
   ExcludeNG = '';
   // enter (comma separated) the newsgroups names for which you
don't
   // the replies to be registered by the script; for example:
   // 'alt.discussions.aboutall, it.litigi.senzafine, free.it.chat';
   // commas are essential, spaces around commas aren't regarded.
 
   withFrom = true; // author recorded? true / false
 
   withNG = true; // newsgroup recorded? true / false
 
   withSubj = true; // subject recorded? true / false
 
   withDate = true; // date and time recorded? true / false
 
   withMsgID = true; // Message-ID recorded? true / false
 
//-------------------------- End  Settings
-------------------------------// 
//(you don't need to change anything else in this script)
 
function GetReferences(Message: TStringList): string;
var
   i: integer; 
   tempStr:String;
begin
  i:=0;
  result:='';
  while (i < Message.count-1) do
  begin    
   if pos('References: ', Message.Strings[i])>0 then
   begin  
tempStr:=copy(Message.Strings[i],pos('<',Message.Strings[i]),Length(Message.Strings[i])-1);
    i := i+1;
    while (i < Message.count-1) and (pos(': ',Message.Strings[i])=0)
do
    begin
     tempStr:=tempStr+Message.Strings[i];
     i := i+1;
    end; //while
    break;
   end; //if
   i:=i+1;
  end; //while
  result:=tempStr;
end; 
 
function isFollowingMine(Message: TStringList): boolean;
var
  s: string;  
begin
  s:=GetReferences(Message);
  if pos(myFQDN, s)>0 then result:=true
  else result:=false;
end;
 
function WhichDepth(Message: TStringList): integer;
var
   i,c,p,thisDepth: integer;
   s,t: string;
   listFQDN: TStringList;  
begin
  thisDepth:=0;
  s:=GetReferences(Message);
  listFQDN:=TStringList.Create();
  try
   while length(s) > 0 do 
   begin
    p:=pos ('>', s);
    t:=copy(s,1,p);
    listFQDN.Add(t);
    s:=copy(s,p+2,length(s)-p-1);
   end; //while
   c:=listFQDN.Count;
   i:=c-1;
   while i >= 0 do
   begin
    if pos(myFQDN, listFQDN.Strings[i])>0 then
    begin
     thisDepth:=c-i;
     break;
    end; //if
    i:=i-1;
   end; //while
  finally
   listFQDN.free;
  end; //try
  result:=thisDepth;
end;
function GetMsgID(Message: TStringList): string;
var
   i: integer;
begin
  i:=0;
  result:='';
  while i < Message.count-1 do
  begin    
   if pos('Message-ID:', Message.strings[i])>0 then break;
   i:=i+1;
  end; //while 
  result:=Message.strings[i];
end; 
 
function isMine(Message: TStringList): boolean;
var
   mid: string;   
begin
  mid:=GetMsgID(Message);
  if pos(myFQDN, mid)>0 then result:=true
  else result:=false;
end;
function GetMessageFrom(Message: TStringList): string;
var
   i: integer;
begin
  i:=0;
  result:='';
  while i < Message.count-1 do
  begin    
   if pos('From:', Message.strings[i])>0 then break;
   i:=i+1;
  end; //while
  result:=Message.strings[i];
end;
function GetMessageNG(Message: TStringList): string;
var
   i, p: integer; 
   tempStr:String;
begin
  i:=0;
  p:=0;
  result:='';
  while i < Message.count-1 do
  begin 
   p:=pos('Newsgroups: ', Message.Strings[i]); 
   if p>0 then
   begin  
tempStr:=copy(Message.Strings[i],p+12,Length(Message.Strings[i])-11);
    i := i+1;
    while (i < Message.count-1) and (pos(': ',Message.Strings[i])=0)
do
    begin
     tempStr:=tempStr+Message.Strings[i];
     i := i+1;
    end; //while
    break;
   end; //if
   i:=i+1;
  end; //while
  result:=tempStr;
end; 
function isExcludedNG(s: string): boolean;
var
  i, j, c1, c2, p: integer;
  temp, t: string;
  found: boolean;
  listNG, listExcNG: TStringList;
begin
  listNG:=TStringList.Create();
  listExcNG:=TStringList.Create();
  temp:='';
  t:='';
  found:=false;
  try
   temp:=s;
   while pos(',', temp)>0 do 
   begin
    p:=pos(',', temp);
    t:=copy(temp,1,p-1);
    listNG.Add(t);
    temp:=copy(temp,p+1,length(temp)-p);
   end; //while
   listNG.Add(temp);
   temp:=trim(ExcludeNG);
   while pos (',', temp)>0 do 
   begin
    p:=pos (',', temp);
    t:=copy(temp,1,p-1);
    listExcNG.Add(t);
    temp:=trim(copy(temp,p+1,length(temp)-p));
   end; //while
   listExcNG.Add(temp);
   c1:=listNG.Count;
   c2:=listExcNG.Count;
   i:=0
   while (i < c1) and (not found) do
   begin
    for j:=0 to c2-1 do
    begin
     if listNG.Strings[i]=listExcNG.Strings[j] then
     begin
      found:=true;
      break;
     end; //if
    end; //for j
    i:=i+1;
   end; //while
  finally
   listNG.free;
   listExcNG.free;
  end; //try
  result:=found;
end;
function GetMessageSubject(Message: TStringList): string;
var
   i: integer;
begin
  i:=0;
  result:='';
  while i < Message.count-1 do
  begin    
   if pos('Subject:', Message.strings[i])>0 then break;
   i:=i+1;
  end; //while
  result:=Message.strings[i]; 
end;
function GetMessageDate(Message: TStringList): string;
var
   i: integer;
begin
  i:=0;
  result:='';
  while i < Message.count-1 do
  begin    
   if pos('Date:', Message.strings[i])>0 then break;
   i:=i+1;
  end; //while
  result:=Message.strings[i]; 
end;
 
procedure BuildPostText(Message: TStringList; IsEmail: boolean);
var
  inf, ns, cod, sep1, sep2, indent, ng: string;
  list: TStringList;
  num,d,i: integer;
begin
  ng:=GetMessageNG(Message);
  if not(isMine(Message) or IsEmail or isExcludedNG(ng)) then 
  //is a post not sent by me in a not excluded NG
  begin
   num:=0;
   list := TStringList.Create();
   try
    d:=WhichDepth(Message);
    if (isFollowingMine(Message) and (d<=depth) and (d>0)) then
    begin
     sep2:=StringOfChar('-', 50);
     if fileexists(filePost) then
     begin
      list.LoadFromFile(filePost);       
      for i:=0 to list.Count-3 do       
       if pos(sep2, list.strings[i])<>0 then num:=num+1;
     end;  //found num of existing notes
     ns:=IntToStr(num+1);
     if Length(ns)=1 then cod:='[0'+ns+']' else cod:='['+ns+']';
     indent:=StringOfChar(' ', 3*(d-1));
     sep1:=StringOfChar('-',
3*(d-1))+'P='+IntToStr(d)+StringOfChar('-', 50-3*d);
     inf:=sep1+cod+sep2+#13+#10+indent;
     if withFrom then
inf:=inf+GetMessageFrom(Message)+#13+#10+indent;
     if withNG then inf:=inf+'NG:
'+GetMessageNG(Message)+#13+#10+indent;
     if withSubj then
inf:=inf+GetMessageSubject(Message)+#13+#10+indent;
     if withDate then
inf:=inf+GetMessageDate(Message)+#13+#10+indent;
     if withDate then inf:=inf+GetMsgID(Message)+#13+#10;
     list.Add(inf);
     list.SaveToFile(filePost); 
    end; //if
   finally
    list.Free;
   end; //try
  end; //if
end;
*-------------------------------------------*
    Questo è OnBeforeSavingMessage:
*-----------------------------------*
program OnBeforeSavingMessage;
{$I _OBSav_forPostShow_include}
procedure OnBeforeSavingMessage(var Message: TStringlist;
Servername: string; IsEmail: boolean);
begin
  BuildPostText(Message, IsEmail);
// other calls to other scripts
end;
begin;
end.
*--------------------------*
Infine questo è PostShow:
*-------------------------------*
Program PostShow; //(v1.4) 9 Aprile 2004
uses Forms, StdCtrls;
//---------------------------- Impostazioni
---------------------------------//
const
  filePost = 'C:\Programmi\40tude Dialog\Post.txt';
  // mettere il proprio percorso, lo stesso che compare in
OnBeforeSavingMessage.
 
  withSound1 = true;
  // un suono quando si apre il memo? true / false.
 
  withSound0 = false;
  // un suono quando il memo è vuoto? true / false.
 
  withMemo = true;
  // altrimenti il memo vuoto? true / false.
  // (per ottenerlo withSound0 deve essere false)
  soundFile1 = 'C:\windows\media\chimes.wav';
  // mettere il proprio percorso e il suono preferito.
 
  soundFile0 = 'C:\windows\media\no.wav';
  // mettere il proprio percorso e il suono preferito per quando il
memo è vuoto.
  fColor = clYellow;
  // colore del font; altre possibilità sono: 
  // clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clLime,
clLtGray,
  // clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal,
clWhite, clYellow. 
 
  wBGcolor = clBlack;
  // colore dello sfondo; fare riferimento ai colori precedenti.
 
  wWidth = 600;
  // larghezza della finestra, in pixel.
 
  wHeight = 800;
  // altezza della finestra, in pixel.
 
  fName = 'Verdana';
  // nome del font; si può cambiare con un altro presente nel
sistema:
  // fare riferimento a "Impostazioni generali-Vista" per l'elenco
dei font disponibili.
 
  fSize = 9;
  // grandezza del font.
 
  fItalic = false;
   // testo in corsivo?  true / false
 
  fBold = false;
   // testo in grassetto?  true / false
 
//-------------------------- Fine Impostazioni
-------------------------------// 
//(non c'è bisogno di cambiare nient'altro nello script)
//----------------------------- Info
---------------------------------//
 {Quando il memo è visualizzato si possono fare le seguenti cose:
 * cancellare tutta la lista (col pulsante "Reset");
 
 * cancellare una nota (selezionandola con un doppio clic sul suo
numero o 
   trascinando il mouse, e premendo poi il pulsante "Canc Nota");
 
 * andare al messaggio (facendo doppio clic sul suo Message-ID e 
   premendo Ctrl+V e Invio nella finestra seguente);
 
 * tenere la lista (col pulsante "Continua", o i tasti Invio o Esc).
 Attenzione a non cancellare le note mentre si stanno scaricando i
corpi dei messaggi:
 si potrebbero cancellare le nuove note che lo script sta
scrivendo.}
//-------------------------- Fine delle Info
-------------------------------// 
 
var
  list: TStringList;
  num: integer;
  PostForm : TForm;
  PostMemo : TMemo;
  PostBtContinue : TButton;
  PostBtReset: TButton;
  PostBtDelNote: TButton;
 
function PlaySound(Filename: PChar; Options: LongWord): Boolean;
         external 'sndPla...@winmm.dll stdcall';
 
 
function isMIDselected(m: string): boolean;
var i: integer;
begin
 for i:=1 to PostMemo.Lines.Count-1 do
 begin
  if (pos('Message-ID:',PostMemo.Lines[i])>0) and
(pos(m,PostMemo.Lines[i])>0) 
   and (pos('<',m)>0) then
  begin
   result:=true;
   break;   
  end
  else result:=false;
 end;//for
end;
 
procedure BtPostContinueClick(Sender: TObject);
begin
  PostForm.Close;
end;
procedure BtPostResetClick(Sender: TObject);
begin
  PostMemo.Text:='';
  PostForm.Caption := 'Non ci sono più risposte.';
  PostMemo.Lines.SaveToFile(filePost);
  BtPostContinueClick(Sender);
end;
procedure CaptionForm;
begin
 case num of
  0:
  begin
   PostForm.Caption := 'Non ci sono risposte.';
   PostBtReset.enabled:=false;
   PostBtDelNote.enabled:=false;
  end;
  1: 
  PostForm.Caption := 'C''è una risposta:';
  else
  PostForm.Caption := 'Ci sono ' + IntToStr(num) + ' risposte:';
 end;
end;
function isValid(var s: string): boolean;
var p: integer;
begin
 p:=Pos(#13+#10, s);
 if p>5 then s:=copy(s,1,p-1);
 if Pos(StringOfChar('-', 40), s)>0 then result:=true
 else result:=false;
end;
procedure BtPostDelNoteClick(Sender: TObject);
var
 note, ns, cod, sep1, sep2, ds: string;
 list: TStringList;
 i, j, d, n: integer;
begin
 sep2:=StringOfChar('-', 50);
 note:='';
 note:=PostMemo.SelText;
 if (note<>'') and isValid(note) then
 begin
  list := TStringList.Create();
  try
   list.LoadFromFile(filePost);
   for i:=0 to (list.Count-1) do
   begin
    if pos(note, list.Strings[i])<>0 then break;
   end;
   list.Delete(i);
   j:=i;
   n:=0;
   while (j < list.Count-1) and (pos('---[', list.Strings[j])=0) do
   begin
    n:=n+1;
    j:=j+1;
   end;
   for j:=i+n-1 downto i do
     list.Delete(j);
   if j=list.Count-2 then list.Delete(j+1);
   PostMemo.Lines.Assign(list);
   n:=list.Count-1;
   num:=0;
   for i:=0 to n do
    if (pos('---[', list.Strings[i])>0) then 
    begin
     num:=num+1;
     ns:=IntToStr(num);
     if Length(ns)=1 then cod:='[0'+ns+']'
      else cod:='['+ns+']';
     d:=pos('P=', list.Strings[i]);
     ds:=copy(list.Strings[i],d,3);
     sep1:=StringOfChar('-', d-1)+ds+StringOfChar('-', 48-d);
     list.Strings[i]:=sep1+cod+sep2; 
    end;           
   CaptionForm;             
   PostMemo.Lines.Assign(list);
   DeleteFile(filePost);
   list.SaveToFile(filePost);  
  finally
   list.Free;
  end;
 end
 else
  begin
   note:='per cancellare una nota fai prima doppio clic sul suo
numero'+#13+#10+#13+#10;
   note:=note+' oppure trascina il mouse per selezionarne una
parte'+#13+#10;
   note:=note+'  che comprenda almeno metà della sua prima riga';
   Application.MessageBox(note, 'Info', 1);
  end;
end;
procedure MemoDblClick(Sender: TObject);
var
 msg: string;
begin
  msg:='';
  msg:=PostMemo.SelText;
  if (msg<>'') and (isMIDselected(msg)) then
  begin
   PostMemo.CopyToClipboard;
   Ado('FindMessageID');
   PostForm.Close;
  end;
end;
Procedure BuildForm;
begin
 PostForm := TForm.Create(nil);
 PostForm.Height := wHeight;
 PostForm.Width := wWidth;
 PostForm.position := poScreenCenter;
 PostForm.BorderStyle := bsSingle;
 PostMemo := TMemo.Create(PostForm);
 PostMemo.Parent := PostForm;
 PostMemo.Top := 10;
 PostMemo.Left := 10;
 PostMemo.Height := PostForm.ClientHeight-60;
 PostMemo.Width := PostForm.ClientWidth-20;
 PostMemo.ScrollBars := ssBoth;
 PostMemo.Color := wBGcolor;
 PostMemo.Font.Size := fSize;
 
PostMemo.Font.Name
 := fName;
 PostMemo.Font.Color := fColor;
 PostMemo.Font.Style := [];
 if fItalic then PostMemo.Font.Style := PostMemo.Font.Style +
[fsItalic];
 if fBold then PostMemo.Font.Style := PostMemo.Font.Style +
[fsBold];
 PostMemo.TabStop := false;
 PostMemo.ReadOnly := true;
 PostBtReset := TButton.Create(PostForm);
 PostBtReset.Parent := PostForm;
 PostBtReset.Top :=
PostMemo.Top+PostMemo.Height+PostBtReset.height/2;
 PostBtReset.Left := PostForm.Width DIV 2 - PostBtReset.Width-50;
 PostBtReset.Caption := '&Reset';
 PostBtReset.OnClick := @BtPostResetClick; 
 PostBtContinue := TButton.Create(PostForm);
 PostBtContinue.Parent := PostForm;
 PostBtContinue.Caption := '&Continua';
 PostBtContinue.TabOrder := 0;
 PostBtContinue.Cancel := true;
 PostBtContinue.OnClick := @BtPostContinueClick;
 PostBtContinue.Top := PostBtReset.Top;
 PostBtContinue.Left := PostBtReset.Left+80;
 PostBtDelNote := TButton.Create(PostForm);
 PostBtDelNote.Parent := PostForm;
 PostBtDelNote.Caption := '&Canc Nota';
 PostBtDelNote.OnClick := @BtPostDelNoteClick;
 PostBtDelNote.Top := PostBtReset.Top;
 PostBtDelNote.Left := PostBtContinue.Left+80;
 PostMemo.OnDblClick := @MemoDblClick;
 end;
 
procedure FillMemo;
var
 sep: string;
 i: integer;
begin
 list := TStringList.Create();
 try
  if fileexists(filePost) then
  begin
   num := 0;
   sep:=StringOfChar('-', 50);
   list.LoadFromFile(filePost);
   PostMemo.Lines.Assign(list);
   for i:=0 to list.Count-1 do      
    if Pos(sep, list.strings[i])<>0 then num:=num+1;
  end
  else
  begin
   PostMemo.Text:='';
   PostMemo.Lines.SaveToFile(filePost);
  end;
 finally
 list.free;
 end;
end;
Begin 
 try
  BuildForm;
  FillMemo;
  if num>0 then
  begin                
    if withSound1 then PlaySound(soundFile1, 1);
    CaptionForm;
    PostForm.ShowModal;
  end
  else
  begin
    if withSound0 then PlaySound(soundFile0, 1)
    else if withMemo then
    begin
     CaptionForm;
     PostForm.ShowModal;
    end;
  end;
 finally
  PostForm.free;
 end;
End.
*-----------------------------------*
-- 
Ryoma
ICQ#41121680
Il 12 e il 13 giugno si vota, non dimenticarlo

 anche se funziona. Questo è il testo:
Gli include files non vanno compilati, solo salvati! :-)
-- 
Maria Luisa C - 11/05/2005 22.53.49
Il 12 e 13 giugno lascia stare il mare: vota e fai votare!

 Gli include files non vanno compilati, solo salvati! :-)
    Hai ragione, scusa, quando l'ho installato l'avevo solo salvato,
poi per fare le prove me ne sono dimenticato e non ho riletto bene
le tue note.


 le tue note.
Non hai idea di quante volte me ne dimentico anch'io...
-- 
Maria Luisa C - 12/05/2005 14.22.03


 Non hai idea di quante volte me ne dimentico anch'io...
    Io mi sono dimenticato per fare le prove con le wildcard ".\"
anziché i path "C:\...". Volevo mettere il punto praticamente sempre
ma non mi funziona. Con calma riproverň.


 ma non mi funziona. Con calma riproverň.
Ho provato anch'io, e su XP non va, continua a metterlo in
C:\Documents and Settings\User
Hai anche tu XP? Sembra che a Cataldo con Win 98 funzioni.
-- 
Maria Luisa C - 12/05/2005 21.41.26


 Hai anche tu XP?
    Sì. Ho provato nello script "PostShow" ad usare il punto ma non
mi legge il file Post.txt pur esistendo e non essendo vuoto. Appena
rimetto il path intero funziona.
    Avrei voluto farlo per ogni script. Ora provo con "ColorFace",
visto che ho cercato di mettere tutto nella cartella di Dialog, per
futura portabilità.
