www.pudn.com > EmailServer.zip > AddEditMailList.pas
unit AddEditMailList;
(******************************************************************************)
(* *)
(* Hermes Add / Edit Mail List Dialog Box *)
(* Part of Hermes SMTP/POP3 Server. *)
(* Copyright(C) 2000 by Alexander J. Fanti, All Rights Reserver Worldwide. *)
(* *)
(* Created January 11, 2000 by Alexander J. Fanti. See License.txt *)
(* *)
(* Used by: ManageMailLists *)
(* Uses: DataU1 *)
(* ChooseUser *)
(* UtilU1 *)
(* *)
(* Description: This Modal dialog window pulls double duty, allowing both *)
(* adding and editing of mailing lists *)
(* Adding: Let user specify List Name and all other list data *)
(* Editing: Let user re-specify list data, but not change Name *)
(* *)
(* Revisions: 1/21/2000 AJF Commented and re-wrote OK button procedure to *)
(* clarify behavior *)
(* *)
(******************************************************************************)
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Menus, ComCtrls, ExtCtrls, Spin,
DataU1;
type
TfrmAddEditMailList = class(TForm)
btnOK: TBitBtn;
txtListName: TEdit;
Label1: TLabel;
btnCancel: TBitBtn;
PageControl1: TPageControl;
tsGeneral: TTabSheet;
tsWelcome: TTabSheet;
tsSignature: TTabSheet;
tsFarewell: TTabSheet;
tsMembers: TTabSheet;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
lvMembers: TListView;
popupMembers: TPopupMenu;
cbxLB_AllowPublicSubscription: TCheckBox;
cbxLB_ForceRepliesToList: TCheckBox;
cbxLB_DoNotReportListMembers_SMTP: TCheckBox;
cbxLB_DoNotReportListMembers: TCheckBox;
cbxLB_MemberSubmissionOnly: TCheckBox;
Label8: TLabel;
txtArchiveFile: TEdit;
btnSelectArchiveFile: TButton;
memoSL_Welcome: TMemo;
memoSL_Signature: TMemo;
memoSL_Farewell: TMemo;
puMbr_Add: TMenuItem;
puMbr_Delete: TMenuItem;
N1: TMenuItem;
puMbr_Active: TMenuItem;
puMbr_Inactive: TMenuItem;
puMbr_Edit: TMenuItem;
SaveDialog1: TSaveDialog;
puMbr_AddLocal: TMenuItem;
OpenDialogText: TOpenDialog;
SaveDialogText: TSaveDialog;
popupMessage: TPopupMenu;
puMsg_LoadfromFile: TMenuItem;
puMsg_SavetoFile: TMenuItem;
puMsg_Clear: TMenuItem;
puMsg_Copy: TMenuItem;
puMsg_Paste: TMenuItem;
N2: TMenuItem;
puMsg_Cut: TMenuItem;
N3: TMenuItem;
puMbr_Manager: TMenuItem;
puMbr_NoManager: TMenuItem;
Label5: TLabel;
txtErrorsMailedTo: TEdit;
Label6: TLabel;
btnViewArchive: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnSelectArchiveFileClick(Sender: TObject);
procedure puMsg_LoadfromFileClick(Sender: TObject);
procedure puMsg_SavetoFileClick(Sender: TObject);
procedure puMsg_ClearClick(Sender: TObject);
procedure puMsg_CutClick(Sender: TObject);
procedure puMsg_CopyClick(Sender: TObject);
procedure puMsg_PasteClick(Sender: TObject);
procedure puMbr_AddClick(Sender: TObject);
procedure puMbr_AddLocalClick(Sender: TObject);
procedure puMbr_EditClick(Sender: TObject);
procedure puMbr_DeleteClick(Sender: TObject);
procedure puMbr_ActiveClick(Sender: TObject);
procedure puMbr_InactiveClick(Sender: TObject);
procedure popupMembersPopup(Sender: TObject);
procedure lvMembersDblClick(Sender: TObject);
procedure puMbr_ManagerClick(Sender: TObject);
procedure puMbr_NoManagerClick(Sender: TObject);
procedure btnViewArchiveClick(Sender: TObject);
private
{ Private declarations }
ListInfo : TMailListInformation; // The mail list information we're
// adding or editing
procedure DisplayInfo; // Display the user information in the dialog
public
{ Public declarations }
function Add : Boolean; // Add a new list
function Edit(ListName : String) : Boolean; // Edit an existing list
// Both functions return true if successful, false if not (cancelled)
end;
var
frmAddEditMailList: TfrmAddEditMailList;
implementation
uses UtilU1, {for email address validity check}
ChooseUser, ViewMailListArchive; {For choosing local users as list members}
{$R *.DFM}
procedure TfrmAddEditMailList.FormCreate(Sender: TObject);
begin
// Create the Mail List Information object that will hold mail list
// information and provide functions such as loading and saving mail
// list data to the disk.
ListInfo := TMailListInformation.Create;
end;
procedure TfrmAddEditMailList.FormShow(Sender: TObject);
begin
// If we can, set focus on the List Name edit box, unless it's disabled
// (edit mode) in which case, we focus on the Page Control.
if txtListName.Enabled then txtListName.SetFocus
else PageControl1.SetFocus;
PageControl1.ActivePage := tsGeneral; // start on general info page
end;
procedure TfrmAddEditMailList.FormDestroy(Sender: TObject);
begin
// Free the User Information object...
ListInfo.Free;
end;
procedure TfrmAddEditMailList.DisplayInfo;
var
x : Longint;
ListMember : PMailListMemberInfoRec; // pointer to List Member data structure
ListItem : TListItem;
begin
// Display the Mail User Information (from the MailListInformation object)
// in the dialog
// Display list members
lvMembers.Items.Clear;
for x := 0 to ListInfo.MemberCount -1 do begin
ListMember := ListInfo.Members[x];
ListItem := lvMembers.Items.Add;
ListItem.Caption := IntToStr(x);
if ListMember.Active then ListItem.SubItems.Add('Yes')
else ListItem.SubItems.Add('No');
if ListMember.Manager then ListItem.SubItems.Add('Yes')
else ListItem.SubItems.Add('No');
ListItem.SubItems.Add(ListMember.EMail);
end;
// Messages automatically sent by list server
memoSL_Welcome.Clear;
for x := 0 to ListInfo.SL_Welcome.Count -1 do
memoSL_Welcome.Lines.Add(ListInfo.SL_Welcome[x]);
memoSL_Signature.Clear;
for x := 0 to ListInfo.SL_Signature.Count -1 do
memoSL_Signature.Lines.Add(ListInfo.SL_Signature[x]);
memoSL_Farewell.Clear;
for x := 0 to ListInfo.SL_Farewell.Count -1 do
memoSL_Farewell.Lines.Add(ListInfo.SL_Farewell[x]);
// List Behaviors
cbxLB_AllowPublicSubscription.Checked
:= ListInfo.LB_AllowPublicSubscription;
cbxLB_ForceRepliesToList.Checked
:= ListInfo.LB_ForceRepliesToList;
cbxLB_DoNotReportListMembers_SMTP.Checked
:= ListInfo.LB_DoNotReportListMembers_SMTP;
cbxLB_DoNotReportListMembers.Checked
:= ListInfo.LB_DoNotReportListMembers;
cbxLB_MemberSubmissionOnly.Checked
:= ListInfo.LB_MemberSubmissionOnly;
// list Archive settings
txtArchiveFile.Text := ListInfo.ArchiveFile;
txtErrorsMailedTo.Text := ListInfo.ErrorsMailedTo;
end;
function TfrmAddEditMailList.Add : Boolean;
begin
// We want to use the dialog as an "Add" dialog...
Caption := 'Add Mailing List'; // Set the dialog caption to reflect usage
txtListName.Enabled := True; // enable the List Name edit box so the
// user can specify a List Name
txtListName.Text := ''; // clear the List Name we're editing
ListInfo.Initialize; // Initialize the Mail List information
// (clean the slate)
DisplayInfo; // Display the user information (default user)
Result := ShowModal = mrOK; // let the user do their thing
end;
function TfrmAddEditMailList.Edit(ListName : String) : Boolean;
begin
// We want to use the dialog as an "Edit" dialog...
Caption := 'Edit Mailing List'; // Set the dialog caption to reflect usage
txtListName.Enabled := False; // disable the List Name edit box so the
// user can't change the List Name
txtListName.Text := ListName; // Display the Name of the List we'll edit
ListInfo.LoadFromFile(ListName); // read the mail list information from disk
DisplayInfo; // Display the user information (default user)
Result := ShowModal = mrOK; // let the user do their thing
end;
procedure TfrmAddEditMailList.btnOKClick(Sender: TObject);
var
ListID : String; // This is the List Name we're adding or editing...
Editing : Boolean; // We'll set this to true to know we're editing...
// it just makes it that much more readable...
// These are used for retrieving data from the dialog...
x : Longint;
Active, Manager : Boolean;
EMail : String;
ListItem : TListItem;
begin
// First, we need to "read" the mail list data from the dialog.
// We'll clear the Mail List Information object first, then get
// all the dialog data
ListInfo.Initialize;
// Read member data...
for x := 0 to lvMembers.Items.Count -1 do begin
ListItem := lvMembers.Items[x];
Active := not (ListItem.SubItems[0] = 'No');
Manager := not (ListItem.SubItems[1] = 'No');
EMail := ListItem.SubItems[2];
if EMail <> '' then ListInfo.MemberAdd(Active, Manager, EMail);
end;
// Read List Server Messages
ListInfo.SetSL_Welcome(memoSL_Welcome.Lines);
ListInfo.SetSL_Signature(memoSL_Signature.Lines);
ListInfo.SetSL_Farewell(memoSL_Farewell.Lines);
// Read List Behaviors
ListInfo.LB_AllowPublicSubscription
:= cbxLB_AllowPublicSubscription.Checked;
ListInfo.LB_ForceRepliesToList
:= cbxLB_ForceRepliesToList.Checked;
ListInfo.LB_DoNotReportListMembers_SMTP
:= cbxLB_DoNotReportListMembers_SMTP.Checked;
ListInfo.LB_DoNotReportListMembers
:= cbxLB_DoNotReportListMembers.Checked;
ListInfo.LB_MemberSubmissionOnly
:= cbxLB_MemberSubmissionOnly.Checked;
// Archive
ListInfo.ArchiveFile := txtArchiveFile.Text;
// Is this address valid?
if (Trim(txtErrorsMailedTo.Text) <> '') and
not IsAddressValid(Trim(txtErrorsMailedTo.Text)) then begin
ShowMessage(EMail + ' is not a valid address.');
ModalResult := mrNone; Exit;
end;
ListInfo.ErrorsMailedTo := Trim(txtErrorsMailedTo.Text);
// Now we're finished reading the list information...
ListID := Trim(txtListName.Text);
Editing := not txtListName.Enabled; // we know we're editing by the condition
// of the UserID Edit Box (Enabled <> Edit)
// Here, we can make the checks we'll have to do whether we're adding or
// editing a mailing list
// Like being specified at all...
if ListID = '' then begin
ShowMessage('The Mail List requires a Name (ID)');
ModalResult := mrNone; Exit;
end;
// We behave differently based on editing or adding...
// but either way, we prepare to write a list to disk...
if Editing then begin
// We're editing a list, it should already exist...
if not INI.List_Exists(ListID) then begin
// This should never happen, but if it does...
ShowMessage('The Mail List ID must exist to be edited.');
ModalResult := mrCancel; Exit;
end;
// Now we can fall through and save the list at the bottom of the procedure
end else begin
// We're creating a new Mail List...
// First we need to be certain the ListID doesn't contain any
// invalid characters
if not IsNameValid(ListID) then begin
ShowMessage('The Mail List Name (ID) cannot contain ' +
INVALIDNAMECHARACTERS);
ModalResult := mrNone; Exit;
end;
// Then we check to be sure the name's available (it hasn't been used
// already for an Alias ID or User Name)
if INI.Alias_Exists(ListID) then begin
ShowMessage('The List Name (ID) is already taken by an Alias.');
ModalResult := mrNone; Exit;
end;
if INI.User_Exists(ListID) then begin
ShowMessage('The List Name (ID) is already taken by a User.');
ModalResult := mrNone; Exit;
end;
// Finally, we verify the ListID does not exist, and we create it.
if INI.List_Exists(ListID) then begin
ShowMessage('The List Name (ID) already exists, ' +
'please specify a different ID.');
ModalResult := mrNone; Exit;
end;
// if we've gotten this far, we can safely create the List.
// at each check along the way, we would have been thrown out of this
// procedure by the "ModalResult := mrNone; Exit;" line which
// would have left the user looking at the dialog again.
if not INI.List_Create(ListID) then begin
ShowMessage('Unable to create Mail List File.');
ModalResult := mrNone; Exit;
end;
// Now we can fall through and save the list at the bottom of the procedure
end;
// if we've gotten this far, we can safely save the List.
// at each check along the way, we would have been thrown out of this
// procedure by the "ModalResult := mrNone; Exit;" line which
// would have left the user looking at the dialog again.
// Save the Mail List Information to disk, replacing the current data
if not ListInfo.SaveToFile(ListID, False) then begin
x := MessageDlg('These settings may have been changed by ' +
'another process.' + #13 + #10 + 'Do you ' +
'want to FORCE the save (possibly erasing ' +
'some settings)?', mtWarning, [mbYes, mbNo], 0);
if x = mrYes then begin
if not ListInfo.SaveToFile(ListID, True) then begin
ShowMessage('Settings still could not be saved');
ModalResult := mrNone;
end;
end else begin
ListInfo.LoadFromFile(ListID);
DisplayInfo;
ModalResult := mrNone;
end;
end;
end;
procedure TfrmAddEditMailList.btnSelectArchiveFileClick(Sender: TObject);
begin
// User wants to select a file to save list messages to...
if SaveDialog1.Execute then txtArchiveFile.Text := SaveDialog1.Filename;
end;
procedure TfrmAddEditMailList.btnViewArchiveClick(Sender: TObject);
begin
frmViewMailListArchive.View(txtListName.Text, txtArchiveFile.Text);
end;
(**************************)
(** List Server Messages **)
(**************************)
procedure TfrmAddEditMailList.puMsg_ClearClick(Sender: TObject);
begin
// Clear message
if PageControl1.ActivePage = tsWelcome then memoSL_Welcome.Clear;
if PageControl1.ActivePage = tsSignature then memoSL_Signature.Clear;
if PageControl1.ActivePage = tsFarewell then memoSL_Farewell.Clear;
end;
procedure TfrmAddEditMailList.puMsg_CutClick(Sender: TObject);
begin
// Cut Message
if PageControl1.ActivePage = tsWelcome then memoSL_Welcome.CutToClipboard;
if PageControl1.ActivePage = tsSignature then memoSL_Signature.CutToClipboard;
if PageControl1.ActivePage = tsFarewell then memoSL_Farewell.CutToClipboard;
end;
procedure TfrmAddEditMailList.puMsg_CopyClick(Sender: TObject);
begin
// Copy Message
if PageControl1.ActivePage = tsWelcome then
memoSL_Welcome.CopyToClipboard;
if PageControl1.ActivePage = tsSignature then
memoSL_Signature.CopyToClipboard;
if PageControl1.ActivePage = tsFarewell then
memoSL_Farewell.CopyToClipboard;
end;
procedure TfrmAddEditMailList.puMsg_PasteClick(Sender: TObject);
begin
// Paste Message
if PageControl1.ActivePage = tsWelcome then
memoSL_Welcome.PasteFromClipboard;
if PageControl1.ActivePage = tsSignature then
memoSL_Signature.PasteFromClipboard;
if PageControl1.ActivePage = tsFarewell then
memoSL_Farewell.PasteFromClipboard;
end;
procedure TfrmAddEditMailList.puMsg_LoadfromFileClick(Sender: TObject);
begin
// Load message from file
if OpenDialogText.Execute then begin
if PageControl1.ActivePage = tsWelcome then
memoSL_Welcome.Lines.LoadFromFile(OpenDialogText.Filename);
if PageControl1.ActivePage = tsSignature then
memoSL_Signature.Lines.LoadFromFile(OpenDialogText.Filename);
if PageControl1.ActivePage = tsFarewell then
memoSL_Farewell.Lines.LoadFromFile(OpenDialogText.Filename);
end;
end;
procedure TfrmAddEditMailList.puMsg_SavetoFileClick(Sender: TObject);
begin
// Save message to file
if SaveDialogText.Execute then begin
if PageControl1.ActivePage = tsWelcome then
memoSL_Welcome.Lines.SaveToFile(SaveDialogText.Filename);
if PageControl1.ActivePage = tsSignature then
memoSL_Signature.Lines.SaveToFile(SaveDialogText.Filename);
if PageControl1.ActivePage = tsFarewell then
memoSL_Farewell.Lines.SaveToFile(SaveDialogText.Filename);
end;
end;
(******************)
(** List Members **)
(******************)
procedure TfrmAddEditMailList.popupMembersPopup(Sender: TObject);
begin
// Enable Members Popup menu items
puMbr_Edit.Enabled := lvMembers.SelCount = 1;
puMbr_Delete.Enabled := lvMembers.SelCount > 0;
puMbr_Active.Enabled := lvMembers.SelCount > 0;
puMbr_InActive.Enabled := lvMembers.SelCount > 0;
puMbr_Manager.Enabled := lvMembers.SelCount > 0;
puMbr_NoManager.Enabled := lvMembers.SelCount > 0;
end;
procedure TfrmAddEditMailList.puMbr_AddClick(Sender: TObject);
var
EMail : String;
x : Longint;
Found : Boolean;
ListItem : TListItem;
begin
// Add a member to the list...
// All member data it storred in the TListView.
EMail := InputBox('Add Member', 'Please enter a complete email address.', '');
if EMail <> '' then begin
if IsAddressValid(EMail) then begin
Found := False;
for x := 0 to lvMembers.Items.Count -1 do begin
ListItem := lvMembers.Items[x];
if LowerCase(ListItem.SubItems[2]) = LowerCase(EMail) then Found := True;
end;
if not Found then begin
ListItem := lvMembers.Items.Add;
ListItem.Caption := IntToStr(lvMembers.Items.Count -1);
ListItem.SubItems.Add('Yes');
ListItem.SubItems.Add('No');
ListItem.SubItems.Add(EMail);
end;
end else begin
ShowMessage(EMail + ' is not a valid address.');
end;
end;
end;
procedure TfrmAddEditMailList.puMbr_AddLocalClick(Sender: TObject);
var
Name : String;
x, y : Longint;
Found : Boolean;
ListItem : TListItem;
begin
// Add a local user to the list...
// All member data it storred in the TListView.
if frmChooseUser.SelectAddresses then begin
for y := 0 to frmChooseUser.lstUsers.Items.Count -1 do begin
if frmChooseUser.lstUsers.Selected[y] then
Name := frmChooseUser.lstUsers.Items[y] +
'@' + frmChooseUser.lstDomain.Text
else Name := '';
if Name <> '' then begin
Found := False;
for x := 0 to lvMembers.Items.Count -1 do begin
ListItem := lvMembers.Items[x];
if LowerCase(ListItem.SubItems[2]) = LowerCase(Name) then Found := True;
end;
if not Found then begin
ListItem := lvMembers.Items.Add;
ListItem.Caption := IntToStr(lvMembers.Items.Count -1);
ListItem.SubItems.Add('Yes');
ListItem.SubItems.Add('No');
ListItem.SubItems.Add(Name);
end;
end;
end;
end;
(*
// Add a local user to the list...
// All member data it storred in the TListView.
Name := frmChooseUser.SelectAddress;
if Name <> '' then begin
Found := False;
for x := 0 to lvMembers.Items.Count -1 do begin
ListItem := lvMembers.Items[x];
if LowerCase(ListItem.SubItems[2]) = LowerCase(Name) then Found := True;
end;
if not Found then begin
ListItem := lvMembers.Items.Add;
ListItem.Caption := IntToStr(lvMembers.Items.Count -1);
ListItem.SubItems.Add('Yes');
ListItem.SubItems.Add('No');
ListItem.SubItems.Add(Name);
end;
end;
*)
end;
procedure TfrmAddEditMailList.lvMembersDblClick(Sender: TObject);
begin
puMbr_Edit.Click;
end;
procedure TfrmAddEditMailList.puMbr_EditClick(Sender: TObject);
var
EMail : String;
x : Longint;
Found : Boolean;
ListItem : TListItem;
begin
// Edit a member of the list...
// All member data it storred in the TListView.
ListItem := lvMembers.Selected;
if ListItem <> nil then begin
EMail := Trim(InputBox('Edit Member',
'Please enter a complete email address.',
ListItem.SubItems[2]));
if (EMail <> '') and (EMail <> ListItem.SubItems[2]) then begin
Found := False;
for x := 0 to lvMembers.Items.Count -1 do begin
ListItem := lvMembers.Items[x];
if LowerCase(ListItem.SubItems[2]) = LowerCase(EMail) then
Found := True;
end;
if not Found then ListItem.SubItems[2] := EMail;
end;
end;
end;
procedure TfrmAddEditMailList.puMbr_DeleteClick(Sender: TObject);
var
x : Longint;
begin
// Delete a member of the list...
// All member data it storred in the TListView.
x := MessageDlg('Delete ' + IntToStr(lvMembers.SelCount) +
' Member?', mtConfirmation, [mbYes, mbNo], 0);
if x = mrYes then
for x := lvMembers.Items.Count -1 downto 0 do
if lvMembers.Items[x].Selected then lvMembers.Items.Delete(x);
end;
procedure TfrmAddEditMailList.puMbr_ActiveClick(Sender: TObject);
var
ListItem : TListItem;
x : Longint;
begin
// Activate a member of the list...
// All member data it storred in the TListView.
for x := 0 to lvMembers.Items.Count -1 do
if lvMembers.Items[x].Selected then begin
ListItem := lvMembers.Items[x];
if ListItem <> nil then ListItem.SubItems[0] := 'Yes';
end;
end;
procedure TfrmAddEditMailList.puMbr_InactiveClick(Sender: TObject);
var
ListItem : TListItem;
x : Longint;
begin
// De-Activate a member of the list...
// All member data it storred in the TListView.
for x := 0 to lvMembers.Items.Count -1 do
if lvMembers.Items[x].Selected then begin
ListItem := lvMembers.Items[x];
if ListItem <> nil then ListItem.SubItems[0] := 'No';
end;
end;
procedure TfrmAddEditMailList.puMbr_ManagerClick(Sender: TObject);
var
ListItem : TListItem;
x : Longint;
begin
// Make a member of the list a manager...
// All member data it storred in the TListView.
for x := 0 to lvMembers.Items.Count -1 do
if lvMembers.Items[x].Selected then begin
ListItem := lvMembers.Items[x];
if ListItem <> nil then ListItem.SubItems[1] := 'Yes';
end;
end;
procedure TfrmAddEditMailList.puMbr_NoManagerClick(Sender: TObject);
var
ListItem : TListItem;
x : Longint;
begin
// Demote a manager to an ordinary member of the list...
// All member data it storred in the TListView.
for x := 0 to lvMembers.Items.Count -1 do
if lvMembers.Items[x].Selected then begin
ListItem := lvMembers.Items[x];
if ListItem <> nil then ListItem.SubItems[1] := 'No';
end;
end;
end.