Delphi SSL/TLS未対応のメールソフトでSSL/TLS送受信

#概要
SSL/TLS未対応のメーラー（を含むアプリ）でSSL/TLSのみ対応のメールサーバーを
使ってメールの送受信を行う必要性に迫られましたが
諸事情によりアプリの改修はできません。
とりあえず急場を凌ぐために、無い知恵を絞った結果途中に中継用のツールを挟んで対応できないか
試してみることにしました。

構成はこんな感じ
　＜メーラー＞
　　↓　↑
　＜サーバーソケット＞
　　↓　↑
　＜SSL/TLS対応クライアントソケット＞
　　↓　↑
　＜メールサーバー＞

#開発環境
開発ツールは Delphi 10.3 です。
SSL/TLS対応ソケットは付属のIndy10.6.2 を使っています。
Indyは仕様がコロコロ変わるので同じバージョンじゃないとコンパイルが通らない
可能性が高いです。

#準備
１．以前のソケットライブラリが標準ではインストールされていないのでインストールしておきます。
　　コンポーネント - パッケージのインストールで
　　C:\Program Files (x86)\Embarcadero\Studio\20.0\bin\clsockets260.bpl
　　を追加します。
２．openssl のDLLをダウンロードしてWindowsのシステムフォルダにコピーしておきます。
　　https://indy.fulgan.com/SSL/ からダウンロードできますので
　　zipファイルをダウンロードして解凍後にlibeay32.dllとssleay32.dllを
　　Windowsのシステムフォルダにコピーしてください。

#コンポーネント配置
以下のイメージの様に必要なコンポーネントを配置します。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/625152/ad2d7424-9a59-8d8d-b543-df27aa2fa1e5.png)

#ソースリスト
```Pascal
unit t1;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms,  IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
  IdComponent, IdBaseComponent,
  IdTCPConnection, IdTCPClient, IdAntiFreezeBase, IdAntiFreeze,
  Vcl.StdCtrls, Vcl.ExtCtrls, System.Win.ScktComp, th1;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    Memo1: TMemo;
    ServerSocket1: TServerSocket;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure FormCreate(Sender: TObject);
    procedure IdTCPClient1Disconnected(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure IdTCPClient1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure IdSSLIOHandlerSocketOpenSSL1Status(ASender: TObject;
      const AStatus: TIdStatus; const AStatusText: string);
    procedure ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocket1ThreadStart(Sender: TObject;
      Thread: TServerClientThread);
    procedure ServerSocket1ThreadEnd(Sender: TObject;
      Thread: TServerClientThread);
    procedure ServerSocket1GetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      var SocketThread: TServerClientThread);
    procedure ServerSocket1GetSocket(Sender: TObject; Socket: NativeInt;
      var ClientSocket: TServerClientWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 宣言 }
    th1 : TClientMsgThread;
    procedure init;
    procedure AddMsg(msg : String);
    procedure OnTerminate(Sender : TObject);
    procedure OnClientReceive(Sender : TObject; msg : AnsiString; count : integer);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  init;
  memo1.Lines.Clear;
  ServerSocket1.Open;
end;

// 初期設定
procedure TForm1.init;
begin
  ServerSocket1.Port := 9999;  // 受け入れポート番号
  IdTCPClient1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;
  IdTCPClient1.host := 'xxx.co.jp';  // メールサーバーのホスト名を指定
  IdTCPClient1.port := 995;                  // メールサーバーのポート番号を指定
  IdSSLIOHandlerSocketOpenSSL1.SSLOptions.SSLVersions := [sslvTLSv1,sslvTLSv1_1,sslvTLSv1_2];
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ServerSocket1.Close;
end;

procedure TForm1.AddMsg(msg : String);
begin
  memo1.Lines.Add(msg);
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var l : integer;
    buf : AnsiString;
begin
  l := socket.ReceiveLength;
  setLength(buf,l);
  socket.ReceiveBuf(pointer(buf)^,l);
  AddMsg('snd>'+buf);
  IdTCPClient1.IOHandler.Write(buf);
end;

procedure TForm1.IdSSLIOHandlerSocketOpenSSL1Status(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: string);
begin
  AddMsg(format('[SSL](%d)%s',[ord(Astatus),AStatusText]));
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  AddMsg('[Client]Conncted');
  th1 := TClientMsgThread.Create;
  th1.client := IdTCPClient1;
  th1.OnReceive := OnClientReceive;
  th1.OnTerminate := OnTerminate;
  th1.resume;
end;

procedure TForm1.IdTCPClient1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  AddMsg(format('[Client](%d)%s',[ord(Astatus),AStatusText]));
  if AStatus = hsDisconnected then
  begin
    IdTCPClient1.DisConnect;
    try
    if ServerSocket1.Socket.ActiveConnections > 0 then
      ServerSocket1.Socket.Connections[0].Close;
    except
      on e:exception do
        AddMsg(e.Message);
    end;
  end;
end;

procedure TForm1.OnClientReceive(Sender: TObject; msg: AnsiString; count: integer);
begin
  try
    AddMsg(format('rcv(%d)>%s',[count,msg]));
    if ServerSocket1.Socket.ActiveConnections > 0 then
      ServerSocket1.Socket.Connections[0].SendText(msg);
  except
    on e:exception do
      AddMsg(e.message);
  end;
end;

procedure TForm1.OnTerminate(Sender: TObject);
begin
  AddMsg('[thread]Terminate');
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  AddMsg('[Sever]Conncted');
  IdTCPClient1.Connect;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  AddMsg('[Sever]DisConncted');
end;

procedure TForm1.ServerSocket1GetSocket(Sender: TObject; Socket: NativeInt;
  var ClientSocket: TServerClientWinSocket);
begin
  AddMsg('[Sever]GetSocket');
end;

procedure TForm1.ServerSocket1GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
  AddMsg('[Sever]GetThread');
end;

procedure TForm1.ServerSocket1Listen(Sender: TObject; Socket: TCustomWinSocket);
begin
  AddMsg('[Sever]Listen');
end;

procedure TForm1.ServerSocket1ThreadEnd(Sender: TObject;
  Thread: TServerClientThread);
begin
  AddMsg('[Sever]ThreadEnd');
end;

procedure TForm1.ServerSocket1ThreadStart(Sender: TObject;
  Thread: TServerClientThread);
begin
  AddMsg('[Sever]ThreadStart');
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
  AddMsg('[Client]DisConncted');
  ServerSocket1.Close;
end;
end.
```

Indyのソケットコンポーネントは同期動作とのことなので別スレッドで応答メッセージを
待ち受けます。

```Pascal
unit th1;
interface
uses
  System.SysUtils, System.Classes, IdIOHandler, idGlobal, IdTCPClient;

type
  TRcvEvent = procedure(Sender : TObject; msg : AnsiString; count : integer) of object;

  TClientMsgThread = class(TThread)
  private
    FOnReceive : TRcvEvent;
    FOnMsg : TRcvEvent;
  protected
    procedure Execute; override;
  public
    Client : TIdTcpClient;
    property OnReceive : TRcvEvent read FOnReceive write FOnReceive;
  end;

implementation

{ TClientMsgThread }

procedure TClientMsgThread.Execute;
var Bytes: TIdBytes;
  Count: Integer;
  s : AnsiString;
  i : integer;
begin
  while true do
  begin
    if (Client = nil) or (client.IOHandler = nil) then
      exit;
    begin
      setlength(bytes,0);
      Client.IOHandler.ReadBytes(Bytes,-1,true);
      count := length(bytes);
      setlength(s,count);
      for i := 0 to count-1 do
        s[i+1] := ansichar(bytes[i]);
      if Assigned(FOnReceive) then
        FOnReceive(self,s,count);
    end;
  end;
end;
end.
```

#実行
このテストツールは1つのポートにしか対応していないでの受信用と送信用の
2つをサーバーソケットの受信ポートを分けて起動しておく必要があります。
メーラーの送受信の設定にこのテストツールを実行するホスト名（IP)と
サーバーソケットに設定したポート番号を指定して実行したところ
送受信ができました。

めでたし、めでたし。