frxexportmail.pas

这个是功能强大的报表软件

            ini.WriteString(Section, 'Signature', SignatureM.Lines.Text);
            ini.WriteString(Section, 'SmtpHost', HostE.Text);
            ini.WriteString(Section, 'SmtpPort', PortE.Text);
            ini.WriteString(Section, 'Login', String(Base64Encode(AnsiString(LoginE.Text))));
            ini.WriteString(Section, 'Password', String(Base64Encode(AnsiString(PasswordE.Text))));
          end;
          if FUseIniFile then
          begin
            ini.WriteInteger(Section, 'LastUsedExport', ExportsCombo.ItemIndex);
            ini.WriteString(EMAIL_EXPORT_SECTION + '.RecentAddresses' , AddressE.Text, '');
            ini.WriteString(EMAIL_EXPORT_SECTION + '.RecentSubjects' , SubjectE.Text, '');
          end;
          ShowExportDialog := SettingCB.Checked;
          FExportFilter := TfrxCustomExportFilter(ExportsCombo.Items.Objects[ExportsCombo.ItemIndex]);
        end;
      finally
        ini.Free;
      end;
    finally
      Free;
    end;
  end;
end;

function TfrxMailExport.Start: Boolean;
var
  s, f: String;
  i: Integer;
  fname, Oldfname: String;
  OldShowProgress, OldShowDialog: Boolean;
  Files: TStringList;
begin
  s := '';
  if Assigned(FExportFilter) and (FExportFilter.FileName <> '') then
    f := ExtractFileName(frxUnixPath2WinPath(FExportFilter.FileName))
  else if Report.ReportOptions.Name = '' then
    f := StringReplace(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), ExtractFileExt(frxUnixPath2WinPath(Report.FileName)), '', [])
  else
    f := Report.ReportOptions.Name;
  if Assigned(FExportFilter) and (FExportFilter.FileName = '') then
    f := f + FExportFilter.DefaultExt;
  if Assigned(FExportFilter) then
  begin
    Oldfname := FExportFilter.FileName;
    FOldSlaveStatus := FExportFilter.SlaveExport;
    FExportFilter.SlaveExport := True;
    OldShowDialog := FExportFilter.ShowDialog;
    OldShowProgress := FExportFilter.ShowProgress;
    try
      FExportFilter.ShowDialog := ShowDialog and ShowExportDialog;
      FExportFilter.ShowProgress := ShowProgress;
      if Report.Export(FExportFilter) then
      begin
        Files := TStringList.Create;
        try
          if FExportFilter.Files <> nil then
            Files.Assign(FExportFilter.Files)
          else
            Files.Add(FExportFilter.FileName + '=' + f);
          s := Mail(FSmtpHost, FSmtpPort, FLogin, FPassword, FFromMail, FAddress,
            FSubject, FFromCompany, FMessage.Text + FSignature.Text, Files);
        finally
          for i := 0 to Files.Count - 1 do
            DeleteFile(Files.Names[i]);
          Files.Free;
        end;
      end;
    finally
      FExportFilter.SlaveExport := FOldSlaveStatus;
      FExportFilter.ShowDialog := OldShowDialog;
      FExportFilter.ShowProgress := OldShowProgress;
      FExportFilter.FileName := Oldfname;
    end;
  end
  else begin
    f := f + '.fp3';
    fname := GetTempFile;
    Report.PreviewPages.SaveToFile(fname);
    Files := TStringList.Create;
    try
      Files.Add(fname + '=' + f);
      s := Mail(FSmtpHost, FSmtpPort, FLogin, FPassword, FFromMail, FAddress,
         FSubject, FFromCompany, FMessage.Text + FSignature.Text, Files);
    finally
      for i := 0 to Files.Count - 1 do
        DeleteFile(Files.Names[i]);
      Files.Free;
    end;
  end;
  if s <> '' then
    case Report.EngineOptions.NewSilentMode of
      simSilent:        Report.Errors.Add(s);
      simMessageBoxes:  frxErrorMsg(s);
      simReThrow:       Exception.Create(s);
    end;
  Result := False;
end;

procedure TfrxMailExport.ExportObject(Obj: TfrxComponent);
begin
  // Fake
end;

function TfrxMailExport.Mail(const Server: String; const Port: Integer;const
  UserField, PasswordField: String; FromField, ToField, SubjectField, CompanyField,
  TextField: WideString; FileNames: TStringList): String;
var
  frxMail: TfrxSMTPClient;
begin
  frxMail := TfrxSMTPClient.Create(nil);
  try
    frxMail.Host := Server;
    frxMail.Port := Port;
    frxMail.User := UserField;
    frxMail.Password := PasswordField;
    frxMail.MailFrom := FromField;
    frxMail.MailTo := ToField;
    frxMail.MailSubject := SubjectField;
    frxMail.Organization := CompanyField;
    frxMail.MailText := StringReplace(TextField, '\n', #13#10, [rfReplaceAll]);
    frxMail.MailFiles.Assign(FileNames);
    frxMail.ShowProgress := ShowProgress;
{$IFDEF FR_DEBUG}
    frxMail.LogFile := GetCurrentDir + '\fr_mail.log';
{$ELSE}
    frxMail.LogFile := LogFile;
{$ENDIF}
    frxMail.Open;
  finally
    Result := frxMail.Errors.Text;
    frxMail.Free;
  end;
end;

procedure TfrxMailExport.SetMessage(const Value: TStrings);
begin
  FMessage.Assign(Value);
end;

procedure TfrxMailExport.SetSignature(const Value: TStrings);
begin
  FSignature.Assign(Value);
end;

{ TfrxMailExportDialog }

procedure TfrxMailExportDialog.FormCreate(Sender: TObject);
begin
  Caption := frxGet(8900);
  OkB.Caption := frxGet(1);
  CancelB.Caption := frxGet(2);
  ExportSheet.Caption := frxGet(8901);
  AccountSheet.Caption := frxGet(8902);
  AccountGroup.Caption := frxGet(8903);
  AddressLB.Caption := frxGet(8904);
  AttachGroup.Caption := frxGet(8905);
  FormatLB.Caption := frxGet(8906);
  FromAddrLB.Caption := frxGet(8907);
  FromNameLB.Caption := frxGet(8908);
  HostLB.Caption := frxGet(8909);
  LoginLB.Caption := frxGet(8910);
  MailGroup.Caption := frxGet(8911);
  MessageGroup.Caption := frxGet(8912);
  MessageLB.Caption := frxGet(8913);
  OrgLB.Caption := frxGet(8914);
  PasswordLB.Caption := frxGet(8915);
  PortLB.Caption := frxGet(8916);
  RememberCB.Caption := frxGet(8917);
  ReqLB.Caption := frxGet(8918);
  SettingCB.Caption := frxGet(8919);
  SignatureLB.Caption := frxGet(8920);
  SignBuildBtn.Caption := frxGet(8921);
  SubjectLB.Caption := frxGet(8922);

  if UseRightToLeftAlignment then
    FlipChildren(True);
end;


procedure TfrxMailExportDialog.SignBuildBtnClick(Sender: TObject);
begin
  SignatureM.Clear;
  SignatureM.Lines.Add('--');
  SignatureM.Lines.Add(frxGet(8923) + ',');
  if Length(FromNameE.Text) > 0 then
    SignatureM.Lines.Add('  ' + FromNameE.Text);
  if Length(FromAddrE.Text) > 0 then
    SignatureM.Lines.Add('  mailto: ' + FromAddrE.Text);
  if Length(OrgE.Text) > 0 then
    SignatureM.Lines.Add('  ' + OrgE.Text);
end;

procedure TfrxMailExportDialog.OkBClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TLabel then
      (Components[i] as TLabel).Font.Style := [];
  if AddressE.Text = '' then
  begin
    ExportSheet.Show;
    AddressLB.Font.Style := [fsBold];
    ModalResult := mrNone;
  end;
  if SubjectE.Text = '' then
  begin
    ExportSheet.Show;
    SubjectLB.Font.Style := [fsBold];
    ModalResult := mrNone;
  end;
  if FromAddrE.Text = '' then
  begin
    AccountSheet.Show;
    FromAddrLB.Font.Style := [fsBold];
    ModalResult := mrNone;
  end;
  if HostE.Text = '' then
  begin
    AccountSheet.Show;
    HostLB.Font.Style := [fsBold];
    ModalResult := mrNone;
  end;
  if PortE.Text = '' then
  begin
    AccountSheet.Show;
    PortLB.Font.Style := [fsBold];
    ModalResult := mrNone;
  end;
  ReqLB.Visible := ModalResult = mrNone
end;

procedure TfrxMailExportDialog.PortEKeyPress(Sender: TObject;
  var Key: Char);
begin
  case key of
    '0'..'9':;
    #8:;
  else
    key := #0;
  end;
end;

procedure TfrxMailExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_F1 then
    frxResources.Help(Self);
end;

end.