LoginSignup
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@kenken2go

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

Posted at

概要

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

ソースリスト

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

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)と
サーバーソケットに設定したポート番号を指定して実行したところ
送受信ができました。

めでたし、めでたし。

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?