//********************************************************************* //* PostShowList 2020-06-04 * //* >> OnBeforeSavingMessage << * //* * //* Dieses Script ruft die von "PostShow_OBSaving" erstellte Datei * //* auf und zeigt die gespeicherten Daten in einem Fenster an. * //* * //* Funktionalitaet: [x] neutral * //* [ ] nur Basis_Modul * //* [ ] nur Pathfinder * //* * //* Datum : unbekannt; ueberarbeitet am: 04.06.2020 * //* Autoren : unbekannt * //* * //* DateiName : PostShowList.ds * //* Einbindung: nicht erforderlich * //* Aufruf : ueber die Scriptverwaltung von Dialog *oder* ueber * //* ein sebstdefiniertes Icon * //********************************************************************* Program PostShowList; uses TextFile, Forms, StdCtrls; {$I Dialog_Functions.ds} const //{-------------------------------------------------------------------} //{ Anwenderspezifische Einstellungen } //{-------------------------------------------------------------------} filePost = 'Post.txt'; // write your path, the same you wrote in OnBeforeSavingMessage. withSound1 = false; // a sound opening the memo? true / false. withSound0 = false; // a sound when the memo is empty? true / false. withMemo = true; // otherwise the empty memo? true / false. // (to get it, withSound0 must be false) soundFile1 = 'C:\windows\media\chimes.wav'; // write your path, and your favorite sound. soundFile0 = 'no.wav'; // write your path, and your favorite sound to notify you that the memo is empty. fColor = clBlack; // font color; other possibilities are: // clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clLime, clLtGray, // clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow. wBGcolor = clWhite; // background color; look at the previous color names. wWidth = 850; // window width (pixels). wHeight = 650; // window height (pixels). fName = 'DejaVu Sans Mono Unifont'; // font name; you can change it with another on your box: // look at "Settings - General Settings - View" for a list of your fonts. fSize = 12; // font size. fItalic = false; // italic text? true / false fBold = true; // bold text? true / false //{-------------------------------------------------------------------} //{ WEITERE INFORMATIONEN } //{-------------------------------------------------------------------} {Create a button in the toolbar and/or a hotkey to call the PostShow script. When the memo is displayed you have the following choices: * to delete all the list (with the "Reset" button); * to delete one note (double-clicking on its number or dragging the mouse over it, and eventually pressing the "Del Note" button); * to go to the message (double-clicking on its Message-ID and pressing Ctrl+V and Enter in the following window); * to keep the list (with the "Continue" button, or "Enter", or "Esc"). Be careful to not delete the notes while you're downloading the message bodies: you could delete the new notes that the script is writing.} //{-------------------------------------------------------------------} //{ WEITERE INFORMATIONEN } //{-------------------------------------------------------------------} //{-------------------------------------------------------------------} //{ Ende der Einstellungen } //{-------------------------------------------------------------------} //{===================================================================} //{ !!! Ab hier bitte nichts mehr ändern !!! } //{===================================================================} var list: TStringList; num: integer; PostForm : TForm; PostMemo : TMemo; PostBtContinue : TButton; PostBtReset: TButton; PostBtDelNote: TButton; 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 := 'There are no replies.'; // PostForm.Caption := 'Es sind keine Antworten vorhanden.'; PostMemo.Lines.SaveToFile(filePost); BtPostContinueClick(Sender); end; procedure CaptionForm; begin case num of 0: begin PostForm.Caption := 'There are no replies.'; // PostForm.Caption := 'Es sind keine Antworten vorhanden.'; PostBtReset.enabled:=false; PostBtDelNote.enabled:=false; end; 1: PostForm.Caption := 'There is one reply:'; // PostForm.Caption := 'Es ist eine Antwort vorhanden:'; else PostForm.Caption := 'There are ' + IntToStr(num) + ' replies:'; // PostForm.Caption := 'Es sind ' + IntToStr(num) + ' Antworten vorhanden:'; end; // of case 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('D=', 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; // if CaptionForm; PostMemo.Lines.Assign(list); DeleteFile(filePost); list.SaveToFile(filePost); finally list.Free; end; // try - finally end else begin // note:='To delete a note, first double click on its number, please,'+#13+#10+#13+#10; // note:=note+'or drag your mouse to select at least half of its first row.'; note:='To delete a note, first double click on its number, please,'+#13+#10+#13+#10; note:=note+'or drag your mouse to select at least half of its first row.'; Application.MessageBox(note, 'Info', 1); end; // if end; // of procedure 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; // if end; // of procedure 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 All'; // PostBtReset.Caption := '&Alle loeschen'; PostBtReset.OnClick := @BtPostResetClick; PostBtContinue := TButton.Create(PostForm); PostBtContinue.Parent := PostForm; PostBtContinue.Caption := '&Continue'; // PostBtContinue.Caption := '&Weiter'; 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 := '&Delete Note'; // PostBtDelNote.Caption := '&Eintrag loeschen'; 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; //try - finally end; // of procedure 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; // try - finally end. // of program