unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, ShellApi, Vcl.StdCtrls,imapsend, ssl_openssl, synachar, smtpsend, mimemess, mimepart,
  Vcl.OleCtrls, SHDocVw, ActiveX, ComCtrls;

procedure CollectEmailData;
procedure IMAPConnection;
function CheckIMAPConnect:boolean;
procedure GetMessageList;
procedure GetParts(const part: TMimepart);
function EncryptStringList(this:TStringList):TStringList;
function DencryptStringList(this:TStringList):TStringList;
procedure GetCryptoMessageList;
function GetPartsModify(const part: TMimepart):TStringList;

type
  TMaForm = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    WebBrowser1: TWebBrowser;
    Label5: TLabel;
    Label6: TLabel;
    Button2: TButton;
    Label7: TLabel;
    edKey: TEdit;
    Button3: TButton;
    Button4: TButton;
    procedure N4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MaForm: TMaForm;
  MainEmailLogin, MainEmailPassword, MainMasterPassword, MainSMTPServer, MainIMAPServer: ansistring;
  IMAP : TImapsend;
  messagelist, CopyMessage : TStringList;
  IdMes:TMimeMess;
  CountOfMessage : longint;
  ResultStringList : TStringList;
  kekas : tstringlist;

implementation

{$R *.dfm}

uses EmailLogAuth, Entrance, AllSetting, RequestsToSetting, AES_2, AES_1, SendMail, OpenMail;

procedure CollectEmailData;
begin
  MainEmailLogin:=EMailLogAuth.ELogAuth.ELogin.Text;
  MainEmailPassword:=EMailLogAuth.ELogAuth.EPassword.Text;
  MainMasterPassword:=Entrance.Enter.EMasterPassword.Text;
  MainSMTPServer:=EMailLogAuth.ELogAuth.eSMTP.Text;
  MainIMAPServer:=EMailLogAuth.ELogAuth.eIMAP.Text;
end;

function EncryptStringList(this:TStringList):TStringList;
  var buffer:TStringList;
      I : longint;
begin
  buffer:=TStringList.Create;
  buffer.Clear;
  for I:=0 to this.Count - 1 do
   buffer.Add(EncryptString(this[i], MainMasterPassword));
  EncryptStringList:=buffer;
end;

function DencryptStringList(this:TStringList):TStringList;
  var I, CountOfZero, J : longint;
begin
  for I := 0 to this.Count - 1 do
    begin
      CountOfZero:=0;
      for  J := 1 to length(this[i]) do
        if (this[I][J] = '0') then inc(CountOfZero);
      if (CountOfZero = length(this[i])) then this[i] := '' else
      this[i] := DecryptString(this[i], MainMasterPassword);
    end;
  DencryptStringList:=this;
end;





function CheckIMAPConnect:boolean;
begin
  if (EmailLogAuth.LocalConnect) then
    begin
      IMAP.TargetPort := '143';
      IMAP.UserName := MainEmailLogin;
      IMAP.Password := MainEmailPassword;
      IMAP.FullSSL := false;
    end else
    begin
      IMAP.TargetHost := MainIMAPServer;
      IMAP.TargetPort := '993';
      IMAP.UserName := MainEmailLogin;
      IMAP.Password := MainEmailPassword;
      IMAP.FullSSL := true;
    end;


  if (IMAP.Login) then
    begin
      CheckIMAPConnect:=TRUE;
      IMAP.LogOut;
    end else
    begin
      CheckIMAPConnect:=FALSE;
    end;
end;



procedure IMAPConnection;
begin
  if (EmailLogAuth.LocalConnect) then
    begin
      IMAP.TargetPort := '143';
      IMAP.UserName := MainEmailLogin;
      IMAP.Password := MainEmailPassword;
      IMAP.FullSSL := false;
    end else
    begin
      IMAP.TargetHost := MainIMAPServer;
      IMAP.TargetPort := '993';
      IMAP.UserName := MainEmailLogin;
      IMAP.Password := MainEmailPassword;
      IMAP.FullSSL := true;
    end;

  if (IMAP.Login) then
    begin
      MaForm.Label2.Caption:=MainEmailLogin;
      MaForm.Label4.Caption:='Connected';
      MaForm.Label4.Font.Color:=clgreen;
      IMAP.NoOp;
    end else
    begin
      MaForm.Label4.Caption:='ERORR';
      MaForm.Label4.Font.Color:=clred;
    end;
end;

procedure GetMessageList;
  var
     I : longint;
     c : longint;
     CountBuffer : TStringList;
begin
  IMAP.SelectFolder('INBOX');
  CountBuffer:=TSTringList.Create;
  CountofMessage:=0;
  I:=1;
  while (true) do
    begin
      CountBuffer.Clear;
      IMAP.FetchMess(i, CountBuffer);
      if (CountBuffer.Count <> 0) then inc(CountofMessage) else break;
      inc(I);
    end;
  IdMes:=TMimeMess.Create;
  c := 0;
  for I := CountOfMessage downto 1 do
    begin
      inc(c);
      messagelist.Clear;
      IMAP.FetchMess(I, messagelist);
      IdMes.Clear;
      IdMes.Lines.AddStrings(messagelist);
      //FetchOfMessage[c - 1] := messagelist;
      IdMes.DecodeMessage;
      //showmessage(DateToStr(IdMes.Header.Date));
      MaForm.ListBox1.Items.Add(inttostr(c) + ' ' + IdMes.Header.From + ' ' + IdMes.Header.Subject);
    end;

  {IMAP.FetchMess(1530, messagelist);
  IdMes.Lines.AddStrings(messagelist);
  IdMes.DecodeMessage;
  showmessage(IdMes.Header.From + ' ' + IdMes.Header.Subject);}
end;

function GetPartsModify(const part: TMimepart):TStringList;
var
  s: string;
  i: integer;
begin
  if (LowerCase(part.Primary)='text') and (LowerCase(part.FileName)='')  then
  begin
    part.DecodePart;
    ResultStringList.LoadFromStream(part.DecodedLines);
   end;
 { if LowerCase(part.FileName)<>'' then begin
     part.DecodePart;
     part.DecodedLines.SaveToFile('С:\'+part.FileName) ;
     Memo3.Lines.Add('Cохранено в '+'c:\'+part.FileName)
    end;  }
  for i := 0 to part.GetSubPartCount - 1 do
    GetPartsModify( part.getsubpart(i));
  GetPartsModify := ResultStringList;
end;


procedure GetCryptoMessageList;
  var
     I : longint;
     c : longint;
     CountBuffer : TStringList;
     BodyOfMess : TStringList;
     Mes, MesCopy : TMimeMess;
begin
  IMAP.SelectFolder('CryptoMail');
  CountBuffer:=TSTringList.Create;
  ResultStringList:=TStringList.Create;
  BodyOfMess:=TStringList.Create;
  CountofMessage:=0;
  I:=1;
  while (true) do
    begin
      CountBuffer.Clear;
      IMAP.FetchMess(i, CountBuffer);
      if (CountBuffer.Count <> 0) then inc(CountofMessage) else break;
      inc(I);
    end;
  Mes:=TMimeMess.Create;
  MesCopy:=TMimeMess.Create;
  c := 0;
  for I := CountOfMessage downto 1 do     // CountOfMessage
    begin
      inc(c);
      messagelist.Clear;
      BodyOfMess.Clear;
      IMAP.FetchMess(I, messagelist);
      Mes.Clear;
      Mes.Lines.AddStrings(messagelist);
      Mes.DecodeMessage;
      ResultStringList.Clear;
      GetPartsModify(Mes.MessagePart);
      ResultStringList:=DencryptStringList(ResultStringList);
      //showmessage(ResultStringList.Text);
      MesCopy.Clear;
      MesCopy.Lines.AddStrings(ResultStringList);
      MesCopy.DecodeMessage;
      //showmessage(datetostr(MesCopy.Header.Date));
      MaForm.ListBox1.Items.Add(inttostr(c) + ' ' + MesCopy.Header.From + ' ' + MesCopy.Header.Subject);
    end;

end;





procedure TMaForm.Button1Click(Sender: TObject);
begin
  MaForm.ListBox1.clear;
  GetCryptoMessageList;
  //GetMessageList;
  //openm.Show;
end;

procedure TMaForm.Button2Click(Sender: TObject);
  var I, CountOfMess : longint;
      buffer : TStringList;
      Current : TDateTime;
      theme : string;
      Messages:array of TStringList;
      folder_list : TStringList;
      need_create_folder : boolean;
begin
  folder_list := TStringList.Create;
  need_create_folder := TRUE;
  IMAP.List('', folder_list);
  //showmessage(folder_list.Text);
  for i := 0 to folder_list.count - 1 do
    begin
      if (folder_list[i] = 'CryptoMail') then need_create_folder := FALSE;
    end;

  if (need_create_folder = TRUE) then
    begin
      IMAP.CreateFolder('CryptoMail');
    end;

  IMAP.SelectFolder('INBOX');
  buffer:=TStringList.Create;
  I := 0;
  CountOfMess := 0;
  while (true) do
    begin
      Inc(I);
      Buffer.Clear;
      IMAP.FetchMess(I, Buffer);
      if (Buffer.Count <> 0) then Inc(CountOfMess) else break;

    end;
  showmessage(inttostr(countofmess));
  for I := 1 to CountOfMess do
    begin
      Buffer.Clear;
      IMAP.FetchMess(I, Buffer);
      SendTechMail(EncryptStringList(buffer), 'CryptoMail');
    end;
  for I := 1 to CountOfMess do
    begin
      IMAP.DeleteMess(1);
      IMAP.ExpungeFolder;
      sleep(500);
    end;
  for I := 1 to CountOfMess do
    IMAP.CopyMess(I, 'CryptoMail');
  for I := 1 to CountOfMess do
    begin
      IMAP.DeleteMess(1);
      IMAP.ExpungeFolder;
      sleep(500);
    end;


  {while (true) do
    begin
      Inc(I);
      Buffer.Clear;
      IMAP.FetchMess(I, Buffer);
      Messages[I] := Buffer;
      if (Buffer.Count <> 0) then Inc(CountOfMess) else break;
      showmessage(inttostr(i));
      showmessage(Messages[I - 1].Text);
    end;
  for I := 1 to CountOfMess do
    begin
    IMAP.DeleteMess(1);
    IMAP.ExpungeFolder;
    end;
  showmessage(inttostr(countofmess));
  for I := 1 to CountOfMess do
    begin
    showmessage(messages[i].Text);
    Messages[i] := EncryptStringList(Messages[i]);
    showmessage(messages[i].Text);
    end;
  for I := 1 to CountofMess do
    begin
    theme:='';
    theme:=DateToStr(time) + DateTostr(now);
    showmessage(Messages[i].text);
    SendTechMail(Messages[i], theme);
    end;
  for I := 1 to CountOfMess do
    begin
    IMAP.CopyMess(1, 'CryptoMail');
    IMAP.DeleteMess(1);
    end;
         }

end;

procedure TMaForm.Button3Click(Sender: TObject);
  var buf:TStringList;
      I : longint;
begin
  //showmessage(inttostr(length(copymessage[0])));
  buf := TStringList.Create;
  for i := 0 to kekas.Count - 1 do
      begin
        buf.Add(DecryptString(kekas[i], MaForm.edKey.Text));
      end;

  MaForm.Memo1.Clear;
  MaForm.Memo1.Lines.AddStrings(buf);
      {
  for I := 0 to MaForm.Memo1.lines.Count - 1 do
    MaForm.Memo1.Lines[i] := DecryptString(MaForm.Memo1.Lines[i], MaForm.edKey.Text);
   }
end;

procedure TMaForm.Button4Click(Sender: TObject);
begin
  MaForm.Memo1.Clear;
  Maform.Memo1.Lines.AddStrings(CopyMessage);
end;

procedure TMaForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  application.Terminate;
end;



procedure TMaForm.FormCreate(Sender: TObject);
  var I : longint;
begin
  IMAP := TImapsend.Create;
  messagelist := Tstringlist.Create;
  kekas := TStringList.Create;
end;

procedure TMaForm.FormShow(Sender: TObject);
begin
  IMAPConnection;
end;

procedure GetParts(const part: TMimepart);
var
  s: string;
  i: integer;
  buffer : TMemoryStream;
begin
  if (LowerCase(part.Primary)='text') and (LowerCase(part.FileName)='')  then
  begin
  part.DecodePart;
    if LowerCase(part.Secondary)='plain'   then
         begin


         kekas := TStringList.Create;
         kekas.LoadFromStream(part.DecodedLines);

         Maform.Memo1.Lines.AddStrings(kekas);


         end
    else
        begin
        MaForm.WebBrowser1.Navigate('html.htm');
        while MaForm.WebBrowser1.ReadyState < READYSTATE_INTERACTIVE do
          Application.ProcessMessages;
          (MaForm.WebBrowser1.Document as
          IPersistStreamInit).Load(TStreamAdapter.Create(part.DecodedLines));
    end;
    end;
 { if LowerCase(part.FileName)<>'' then begin
     part.DecodePart;
     part.DecodedLines.SaveToFile('С:\'+part.FileName) ;
     Memo3.Lines.Add('Cохранено в '+'c:\'+part.FileName)
    end;  }
  for i := 0 to part.GetSubPartCount - 1 do
    GetParts( part.getsubpart(i));
end;

procedure TMaForm.ListBox1Click(Sender: TObject);
  var buffer:TStringList;
      index:longint;
      Mes, MesCopy : TMimeMess;
      BodyOfMess : TStringList;
      I, CountOfmessage : longint;
      buf:TStringList;

begin
  IMAP.SelectFolder('CryptoMail');
  i:=0;
  countofmessage:=0;
  buf:=TStringList.Create;
  while (true) do
    begin
      inc(i);
      IMAP.FetchMess(i, buf);
      if (buf.Count <> 0) then inc(countofmessage) else break;
    end;
  buffer:=TStringList.Create;
  BodyOfMess:=TStringList.Create;
  Mes:=TMimeMess.Create;
  MesCopy:=TMimeMess.Create;
  index:= COuntOfMessage - listbox1.ItemIndex;
  IMAP.FetchMess(index, buffer);
  ResultStringList.Create;
  Mes.Clear;
  Mes.Lines.AddStrings(buffer);
  Mes.DecodeMessage;
  GetPartsModify(Mes.MessagePart);
  ResultStringList:=DencryptStringList(ResultStringList);
  //showmessage(inttostr(listbox1.ItemIndex));
  MaForm.Memo1.Clear;
  MesCopy.Clear;
  //showmessage(buffer.Text);
  //showmessage(ResultStringList.Text);
  MesCopy.Lines.AddStrings(ResultStringList);
  MesCopy.DecodeMessage;
  GetParts(MesCopy.MessagePart);
  CopyMessage:=TStringList.Create;
  CopyMessage.Clear;
  for I := 0 to Memo1.Lines.Count - 1 do
    CopyMessage.Add(Memo1.Lines[i]);
end;

procedure TMaForm.N3Click(Sender: TObject);
begin
  Settings.show;
  UpdateSettingData;
  maform.Hide;
  //continue;
end;

procedure TMaForm.N4Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open', 'c:\windows\notepad.exe', 'manual.txt', nil, SW_SHOWNORMAL);
end;

procedure TMaForm.N5Click(Sender: TObject);
begin
  form2.show;
  MaForm.Hide;
end;

end.