Wysyłanie maila bez wiedzy użytkownika

Komentarz chyba zbędny :) Po prostu chodzi o wysłanie maila i zabezpieczenie hasła do serwera, który posłużył nam do wysłania listu.

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

type
  TForm1 = class(TForm)
    IdSMTP1: TIdSMTP;
    IdMessage1: TIdMessage;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    FUNCTION OdSzyfruj(Tekst,Haslo:String):String;
  public
    { Public declarations }
  end;

 TWyslijMail = class(TThread)
   Private
     Status :BOOLEAN;
   Protected
   PROCEDURE Execute; override;
 end;

var
  Form1      :TForm1;
  WyslijMail :TWyslijMail;
implementation {$R *.dfm}

{Wątek wysyłający maila}
PROCEDURE TWyslijMail.Execute;
var
  x :Integer;
Begin
 FreeOnTerminate:= True;  //zakończ wątek po wykonaniu tej procedury
 x:= 0;
 with Form1 do
 begin
   //podanie parametrów do message...
   IdMessage1.From.Address:= '[email protected]'; //nadawca Twój mail
   IdMessage1.Recipients.EMailAddresses:= '[email protected]'; //odbiorca
   IdMessage1.From.name:= 'od Franka';  //imię nadawcy
   IdMessage1.Subject:= 'pozdrowionka'; //temat
   IdMessage1.Body.Append('to jest tekst maila'); //treść
   //parametry logowania na Twój serwer SMTP...
   IdSMTP1.Host:= 'poczta.o2.pl';
   IdSMTP1.Username:= 'nadawca';
   //do zaszyfrowania nazwy hasła np: "ufoludek" uzyto nazwy komponentu Form1
   IdSMTP1.Password:=  OdSzyfruj('?ź ťť','Form1');
   IdSMTP1.AuthenticationType:= atLogin; //włączona opcja uwierzytelniania
   //ŁĄCZENIE... (3 razy w razie wystąpienia błędu)
   REPEAT
     Inc(x);
     Try
       //połaczenie i wysłanie...
       label1.Caption:= 'łączenie...'; //tylko dla podglądu
       Application.ProcessMessages;
       IdSMTP1.Connect;
       label1.Caption:= 'wysyłanie...'; //tylko dla podglądu
       IdSMTP1.Send(IdMessage1);
       label1.Caption:= 'mail został wysłany'; //tylko dla podglądu
       Status:= True;
       {jeśli dasz finally to przy błedzie bedzie właściwa uwaga - ale skoro
       user ma niewiedzieć o wysyłce maila to musi być jak ponizej}
     except
       Status:= False;
       label1.Caption:= 'Błąd !'; //tylko dla podglądu
       if IdSMTP1.Connected then IdSMTP1.Disconnect;
     end;
   UNTIL (Status = True) or (x = 3);
   if IdSMTP1.Connected then IdSMTP1.Disconnect;
 End;
 {if status then  ... tu mozna dać wpis do rejestru ze został wysłany
 a przy następnym uruchomieniu programu pobierać ten wpis}
End;

{Odszyfrowuje zaszyfrowany tekst }
FUNCTION TForm1.OdSzyfruj(Tekst,Haslo:String):String;
var
 x,y      :Integer;
 lp,cyfra :Integer;
 a        :String;
Begin
 Haslo:= LowerCase(Haslo);                     //zamiana liter z dużych na małe
 for lp:=1 to Length(Haslo) do
 begin
   cyfra:= Ord(Haslo[lp])*lp;
   a:= a+IntToStr(cyfra);
 end;
 Haslo:= a;
 Result:= Tekst; //przypisuje do funkcji wartość zmiennej "Tekst"
 y:=0;           //zeruje licznik ilości znaków w haśle
 //wykonuje kolejno litera po literze...
 for x:=1 to Length(Tekst) do
 begin
   Inc(y);      //zwiększa licznik o kolejną literę hasła
   if y>Length(Haslo) then y:= 1;  //jeżeli licznik przekroczy długość hasła
   Result[x]:=Char( Ord(Tekst[x]) - Ord(Haslo[y]) - 255 );
 end;
End;

//============================================
procedure TForm1.FormCreate(Sender: TObject);
begin
 {tu można sprawdzić w rejestrze czy był wcześniej wysłany mail}
 WyslijMail:= TWyslijMail.Create(FALSE);
end;

END.




{TO UMIEŚCIĆ W INNYM PROGRAMIE I ZASZYFROWAĆ SOBIE HASŁO KTÓRENALEŻY WSTAWIĆ DO KODU PROGRAMU WYSYŁAJĄCEGO MAIL}

FUNCTION TForm1.Szyfruj(tekst,haslo:String):String;
var
x,y      :Integer;
lp,cyfra :Integer;
a        :String;
Begin
 haslo:= LowerCase(haslo);  //zamiana liter z dużych na małe
 for lp:= 1 to Length(haslo) do
 begin
   cyfra:= Ord(haslo[lp])*lp;
   a:= a+IntToStr(cyfra);
 end;
 haslo:= a;
 Result:= tekst;   //przypisuje do funkcji wartość zmiennej "tekst"
 y:=0;            //zeruje licznik ilości znaków w haśle
 //wykonuje kolejno litera po literze...
 for x:= 1 to Length(tekst) do
 begin
   Inc(y);        //zwiększa licznik o kolejną literę hasła
   if y>Length(haslo) then y:= 1; //jeżeli licznik przekroczy dlugość hasła
   Result[x]:=Char( Ord(tekst[x]) + Ord(haslo[y]) + 255 );
   //jeżeli wystąpi błąd kodowania to...
   if Result[x]= '' then
   begin
     ShowMessage('Użyto niedozwolonego znaku: '+ Char(Ord(haslo[y])) );
     Result:= tekst;
     Exit;
   end;
 end;
End; 

procedure TForm1.Button1Click(Sender: TObject);
var
 hasloSerwera , haslo :String;
begin
 hasloSerwera:= 'ufoludek';  //hasło na które logujesz się na pocztę
 haslo:= Form1.Name;        //do zahasłowania np. nazwa formy
 Edit1.Text:= Szyfruj(hasloSerwera,haslo);
end;