unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Eingabe,
  IdSMTP, IdMessage, IdSMTPBase, IdComponent, IdSSL, IdSSLOpenSSL;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Edit1: TEdit;
    IdMessage1: TIdMessage;
    IdSMTP1: TIdSMTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    Label1: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: char);
    procedure Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure IdSMTP1Connected(Sender: TObject);
    procedure IdSMTP1Disconnected(Sender: TObject);
    procedure IdSMTP1FailedRecipient(Sender: TObject; const AAddress, ACode,
      AText: String; var VContinue: Boolean);
    procedure IdSMTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure IdSMTP1TLSNotAvailable(Asender: TObject; var VContinue: Boolean);
  private
  public
    procedure Blankwegh;
    procedure Blankwegv;
    procedure EinAus;
    procedure EinAn;
    procedure Bloe;
  end;

var
  Form1: TForm1;
  var JaNein: word;
  var Closestat: integer;
  var abbruch: Boolean;
  var mtasts: integer;
  var mlauf: integer;
  var mver: integer;
  var mart: integer;
  var Tag: integer;
  var Monat: integer;
  var Jahr: integer;
  var BUser: string;
  var anzrec: Integer;
  var sdate1: Char;
  var sdate2: String;
  var vwaehrs: string;
  var vtaus: Char;
  var vdezim: Char;
  var vwaehrz: Byte;
  var FSatz: string;
  var sta: integer;

implementation

uses IdEMailAddress, IdSSLOpenSSLHeaders, IdAttachmentFile;

{$R *.lfm}

{ TForm1 }

procedure TForm1.Blankwegh;
  var laenge: integer;
  var stelle: integer;
  var vari12: integer;
  var zeichen: string;
begin
  laenge:=Length(ialpha);
  vari12:=0;
  if laenge > 0 then
  begin
    for stelle:=laenge downto 1 do
    begin
      zeichen:=Copy(ialpha,stelle,1);
      if (vari12 = 0) then
      begin
        if (zeichen <> ' ') then
        begin
          vari12:=stelle;
        end;
      end;
    end;
  end;
  if (vari12 > 0) then
  begin
    zeichen:=ialpha;
    ialpha:=Copy(zeichen,1,vari12);
  end else begin
    ialpha:='';
  end;
end;

procedure TForm1.Blankwegv;
  var laenge: integer;
  var stelle: integer;
  var vari12: integer;
  var zeichen: string;
begin
  laenge:=Length(ialpha);
  vari12:=0;
  if laenge > 0 then
  begin
    for stelle:=1 to laenge do
    begin
      zeichen:=Copy(ialpha,stelle,1);
      if (vari12 = 0) then
      begin
        if (zeichen <> ' ') then
        begin
          vari12:=stelle;
        end;
      end;
    end;
  end;
  if (vari12 > 0) then
  begin
    zeichen:=ialpha;
    ialpha:=Copy(zeichen,vari12,laenge-vari12+1);
  end else begin
    ialpha:='';
  end;
end;

procedure TForm1.EinAus;
begin
  Edit1.ReadOnly:=True;
  Memo1.ReadOnly:=True;
  Memo2.ReadOnly:=True;
  Edit1.Color:=clSilver;
  Memo1.Color:=clSilver;
  Memo2.Color:=clSilver;
end;

procedure TForm1.EinAn;
begin
  Edit1.ReadOnly:=False;
  Memo1.ReadOnly:=False;
  Memo2.ReadOnly:=False;
  Edit1.Color:=clWhite;
  Memo1.Color:=clWhite;
  Memo2.Color:=clWhite;
end;

procedure TForm1.Bloe;
begin
  Edit1.Text:='';
  Memo1.Lines.Clear;
  Memo2.Lines.Clear;
  Label9.Caption:='';
  Label10.Caption:='';
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  Label1.Caption:='©LINSOFT               M A I L                 Datum: '+FormatDateTime('DD.MM.YYYY',now);
  Label2.Caption:='';
  if sta = 1 then
  begin
    Form1.Caption:='                   Mail                            <'+BUser+'>';
    Closestat:=0;
    mtasts:=1;
    ialpha:='';
    inummer:=0;
    inumkom:=0;
    ikomma:=0;
    iart:=1;
    izeich:=3;
    istell:=0;
    mlauf:=0;
    mver:=0;
    sta:=2;
    IdSMTP1.Disconnect();
    EinAus;
    Bloe;
  end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);
begin
  if mlauf = 1 then
  begin
    itaste:=Key;
    FeldEingabe(Form1.Edit1);
    Key:=itaste;
  end;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  Label1.Caption:='©LINSOFT               M A I L                 Datum: '+FormatDateTime('DD.MM.YYYY',now);
  if (mtasts = 1) then
  begin
    Label2.Caption:='';
    Bloe;
    EinAn;
    mlauf:=1;
    mtasts:=0;
    mart:=1;
    Edit1.Text:='';
    ialpha:='';
    inummer:=0;
    iart:=2;
    inumkom:=0;
    ikomma:=0;
    izeich:=3;
    istell:=0;
    ifunc:=5;
    ilanmax:=50;
    ilanmin:=1;
    iautocr:=1;
    Form1.ActiveControl:=Edit1;
    Edit1.AutoSelect:=True;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var i: integer;
begin
  Label2.Caption:='';
  i:=Length(Edit1.Text);
  if i > 5 then
  begin
    IdSMTP1.Disconnect();
    IdSMTP1.Connect;
  end else begin
    Label2.Caption:='erst An EMailadresse eingeben';
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  IdSMTP1.Disconnect();
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
  Application.ProcessMessages;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Memo2.Lines.Clear;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if OpenDialog1.Execute() then
  begin
    TIdAttachmentFile.Create(IdMessage1.MessageParts, OpenDialog1.FileName);
    Label9.Caption:=OpenDialog1.FileName;
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  Label9.Caption:='';
end;

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if mlauf = 1 then
  begin
    if ((istell = ilanmax) and (ord(itaste) > 0) and (iautocr = 1)) then
    begin
      Key:=ord(chr(13));
    end;
    if ord(Key) = 13 then
    begin
      istell:=0;
      Label2.Caption:='';
      if ialpha <> '' then
      begin
        mlauf:=0;
        Blankwegh;
        Blankwegv;
        Edit1.Text:=ialpha;
        Edit1.ReadOnly:=True;
        Edit1.Color:=clSilver;
        Edit1.AutoSelect:=False;
      end else begin
        Label2.Caption:='EMailadresse An muß eingegeben werden';
        Edit1.ReadOnly:=False;
        Edit1.Color:=clWhite;
        Edit1.Text:='';
        ialpha:='';
        inummer:=0;
        iart:=2;
        inumkom:=0;
        ikomma:=0;
        izeich:=3;
        istell:=0;
        ifunc:=5;
        ilanmax:=50;
        ilanmin:=1;
        iautocr:=1;
        Form1.ActiveControl:=Edit1;
        Edit1.AutoSelect:=True;
      end;
    end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Label1.Caption:='©LINSOFT               M A I L                 Datum: '+FormatDateTime('DD.MM.YYYY',now);
  IdSMTP1.Disconnect();
  Form1.Cursor:=crDefault;
  Form1.Refresh;
  CloseAction:=caFree;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Label1.Caption:='©LINSOFT               M A I L                 Datum: '+FormatDateTime('DD.MM.YYYY',now);
  if (abbruch) then
  begin
    CanClose:=true;
  end else begin
    Form1.Cursor:=crDefault;
    Form1.Refresh;
    CanClose:=false;
    if (Closestat = 0) then
    begin
      Closestat:=1;
      JaNein:=messagedlg('Programm-Ende ?', mtConfirmation, [mbYes, mbNo], 0);
      Closestat:=0;
      if (JaNein = mrYes) then
      begin
        CanClose:=true;
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
  var heute: string;
  var h1: integer;
  var h3: string;
begin
  Label1.Caption:='©LINSOFT               M A I L                 Datum: '+FormatDateTime('DD.MM.YYYY',now);
  Label2.Caption:='';
  Closestat:=0;
  mtasts:=1;
  ialpha:='';
  inummer:=0;
  inumkom:=0;
  ikomma:=0;
  iart:=1;
  izeich:=3;
  istell:=0;
  mlauf:=0;
  BUser:='';
  try
    BUser:=GetEnvironmentVariable('USERNAME');
  except
    BUser:='unknown';
  end;
  heute:=FormatDateTime('DD.MM.YYYY',now);
  h1:=StrLen(PChar(heute));
  if (h1 = 10) then
  begin
    h3:=Copy(heute, 1, 2);
    Tag:=StrToInt(h3);
    h3:=Copy(heute, 4, 2);
    Monat:=StrToInt(h3);
    h3:=Copy(heute, 7, 4);
    Jahr:=StrToInt(h3);
  end;
  abbruch:=false;
  sta:=1;
  Form1.Caption:='                   Mail                            <'+BUser+'>';
  Label1.Caption:='©LINSOFT               M A I L                 Datum: '+FormatDateTime('DD.MM.YYYY',now);
end;

procedure TForm1.IdSMTP1Connected(Sender: TObject);
  var i: integer;
  var ii: TIdEMailAddressItem;
begin
  Label10.Caption:='SMTP verbunden';
  Label10.Refresh;
  if IdSMTP1.Connected() then
  begin
    IdMessage1.From.Address:='juergen.linder@gmx.de';
    if IdMessage1.Recipients.Count > 0 then
    begin
      IdMessage1.Recipients.Clear;
    end;
    IdMessage1.Recipients.Add();
    IdMessage1.Recipients.Items[0].Address:=Edit1.Text;
    IdMessage1.ReceiptRecipient.Address:='dg5uap@darc.de';
    IdMessage1.Body:=Memo2.Lines;
    ii:=TIdEMailAddressItem.Create();
    if IdMessage1.CCList.Count > 0 then
    begin
      IdMessage1.CCList.Clear;
    end;
    for i:=0 to Memo1.Lines.Count-1 do
    begin
      ii.Address:=Memo1.Lines.Strings[i];
      IdMessage1.CCList.Add();
      IdMessage1.CCList.Items[i].Address:=ii.Address;
    end;
    ii.Free;
    IdSMTP1.Send(IdMessage1);
    IdSMTP1.Disconnect();
  end;
  Application.ProcessMessages;
end;

procedure TForm1.IdSMTP1Disconnected(Sender: TObject);
begin
  Label10.Caption:='SMTP getrennt';
  Label10.Refresh;
  Application.ProcessMessages;
end;

procedure TForm1.IdSMTP1FailedRecipient(Sender: TObject; const AAddress, ACode,
  AText: String; var VContinue: Boolean);
begin
  Label10.Caption:=AAddress+'    '+ACode+'    '+AText;
  Label10.Refresh;
  VContinue:=True;
  JaNein:=messagedlg('Fehler siehe Zustand', mtConfirmation, [mbOk], 0);
  Application.ProcessMessages;

end;

procedure TForm1.IdSMTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  Label10.Caption:=AStatusText;
  Label10.Refresh;
  sleep(2000);
  Application.ProcessMessages;
end;

procedure TForm1.IdSMTP1TLSNotAvailable(Asender: TObject; var VContinue: Boolean
  );
begin
  Label10.Caption:='TSL-Verschlüsselung nicht verfügbar';
  Label10.Refresh;
  VContinue:=True;
  JaNein:=messagedlg('Fehler siehe Zustand', mtConfirmation, [mbOk], 0);
  Application.ProcessMessages;
end;

end.