【列表9.5】FileMail的程序代碼。
unit FileMailMain;
interface
uses
   SysUtils, Types, Classes, Variants, QGraphics, QControls, QForms, QDialogs,
   QStdCtrls, Libc, QExtCtrls, QComCtrls;
type
   TFileMailMainForm = class(TForm)
      MsgMemo: TMemo;
      Label1: TLabel;
      Label2: TLabel;
      SendBtn: TButton;
      ExitBtn: TButton;
      Label3: TLabel;
      SubjectEdit: TEdit;
      RecipientsEdit: TEdit;
      StatusBar: TStatusBar;
      procedure SendMail;
      procedure RefreshDisplay;
      procedure ExitBtnClick(Sender: TObject);
      procedure MsgMemoChange(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure SendBtnClick(Sender: TObject);
      procedure SubjectEditChange(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure RecipientsEditChange(Sender: TObject
   private
      { Private declarations }
   public
      { Public declarations }
   end;

const
  LF = #10; { ASCII linefeed/newline }
 SMNumPaths = 3;
 SMSearchPaths : array[1..SMNumPaths] of string
   = ('/usr/lib/sendmail',
        '/usr/sbin/sendmail',
        '/usr/libexec/sendmail');

var
   FileMailMainForm: TFileMailMainForm;
   SMPath : String;
   MailFileName : array[0..128] of Char;
   Recipients : String;
   Subject : String;

implementation
{$R *.xfm}
procedure TFileMailMainForm. SendMail;
var
   i : Integer;
  MailFile : PIOFile;
  Cmd : array[0..512] of Char;
begin
 MailFile := fopen(MailFileName, 'w');
 if not Assigned(MailFile)
  then begin
           ShowMessage('Cannot open temporary mail file!');
           Exit;
          end;

 { write out the header information }
 fprintf(Mai!File, 'To: %s', Recipients);
 fputc(ord(LF), MailFile);
 fprintf(MailFile, 'Subject: %s', Subject);
 fputc(ord(LF), MailFile);
 { write out the end of header }
 fputc(ord(LF), MailFile);
 { write out the message }
 for i := 0 to MsgMemo. Lines.Count -1 do
   begin
    if Length(MsgMemo. Lines[i]) > 0
      then fprintf(MailFile, '%s', MsgMemo. Lines[i]);
    fputc(ord(LF), MailFile);
   end; { for }

 fclose(MailFile);

 { Hand the file to sendmail }
 sprintf(Cmd, '%s -oi -t < %s', SMPath, Mai lFileName);
 if Libc.system(Cmd) <> 0
   then ShowMessage('Error occurred while sending mail!')
   else ShowMessage('Message sent to recipient(s).');

end;

procedure TFileMailMainForm. RefreshDisplay;
begin
 SendBtn. Enabled := (MsgMemo. Lines.Count > 0)
   and (Length(SubjectEdit.Text) > 0)
   and (Length(RecipientsEdit.Text) > 0);
end;

procedure TFileMailMainForm. ExitBtnClick(Sender: TObject);
begin
 Close;
end;
  procedure TFileMailMainForm. MsgMemoChange(Sender: TObject);
  begin
   RefreshDisplay;
  end;

  procedure TFileMailMainForm. FormCreate(Sender: TObject);
  var
   i : Integer;
   SMFound : Boolean;
  begin
   { Find the sendmail application }
   for i := 1 to SMNumPaths do
    begin
      SMFound := FileExists(SMSearchPaths[i]);
      if SMFound then Break;
    end; { for }

   if SMFound
    then begin                                                     
             SMPath := SMSearchPaths[i];
             StatusBar. SimpleText := 'Sendmail located at ' + SMPath;
            end
    else begin                                                      
             RecipientsEdit. Enabled := False;
             SubjectEdit. Enabled := False;
             MsgMemo. Enabled := False;
             StatusBar. SimpleText := 'Sendmail program not located!';
             ShowMessage('Sendmail program not located!');
           end;
  { Get a unique file name }
  tmpnam(MailFileName);

end;

procedure TFileMailMainForm. SendBtnClick(Sender: TObject);
begin
  SendMail;
end;

procedure TFileMailMainForm. SubjectEditChange(Sender: TObject);
begin
 Subject := SubjectEdit.Text;
 RefreshDisplay;
end;

procedure TFileMailMainForm. FormDestroy(Sender: TObject);
begin
 if FileExists(MailFileName) then unlink(MailFileName);
end;

procedure TFileMailMainForm. RecipientsEditChange(Sender: TObject);
begin
 Recipients := RecipientsEdit.Text;
 RefreshDisplay;
end;
end.