トップへ(mam-mam.net/)

Winsock APIでTCPクライアントを作る ～Delphiソースコード集 ～Delphiでお手軽プログラミング

Winsock APIでTCPクライアントを作る ～Delphiソースコード集 ～Delphiでお手軽プログラミング

１．汎用TcpClientユニット

以下ソースコードをファイル名「MamTcpClient.pas」として保存します。
ちょっと微妙な個所もあります。（すいません。汗） 
unit MamTcpClient;

interface
uses
  SysUtils, Classes, Windows, WinSock,StrUtils,StdCtrls
  ,dialogs,DateUtils;

type
  TMamErrorEvent = procedure(Sender: TObject;SendMessage:string) of object;

  //TCPクライアント
  TMamTcpClient=class(TObject)
    private
      FPort:Word;           //ポート番号 通常は25
      FHost:AnsiString;     //ホスト名
      FConnecting:Boolean;  //接続中かどうか
      FErrCode:Integer;     //エラーコード
      FErrMsg:String;       //エラーメッセージ
      FErrEvent:TMamErrorEvent;
      FSocket:TSocket;      //ソケット
      FBufSize: Integer;
      FRecvTimeout:TTimeVal;
      FConnectTimeout:TTimeVal;
    public
      constructor Create();//コンストラクタ
      destructor Destroy;override;       //デストラクタ
      function Open():boolean;           //接続
      function Close():boolean;          //切断
      procedure SendBytes(b:TBytes);     ////バイト配列を送信
      procedure Send(st:String);         //AnsiString(SJIS)でデータ送信
      procedure SendLn(st:String;EOL:String = #13#10);//AnsiString(SJIS)でCR+LFを付けて送信
      function RecvBytes():TBytes;
      function RecvStr():String;         //AnsiString(SJIS)でデータ受信
      function RecvStrDelCRLF():String; //AnsiString(SJIS)でデータを受信して最後がCR+LFの場合はCR+LFを削除
      procedure RecvStringList(RecvStrings:TStrings;Enc:TEncoding); //エンコーディングEncのデータを受信してRecvStringsへ
      procedure RecvStream(strm:TMemoryStream);//ストリームにテータを受信
      procedure SetRecvTimeout(sec:LongInt);
      procedure SetConnectTimeout(sec:LongInt);
      property Port:Word read FPort write FPort;
      property Host:AnsiString read FHost write FHost;
      property Connecting:Boolean read FConnecting;
      property ErrCode:Integer read FErrCode;
      property ErrMsg:String read FErrMsg;
      property OnErrEvent:TMamErrorEvent read FErrEvent write FErrEvent;
      property RecvTimeout:LongInt read FRecvTimeout.tv_sec write SetRecvTimeout;
      property ConnectTimeout:LongInt read FConnectTimeout.tv_sec write SetConnectTimeout;
    end;

// ホスト名からHostEnt情報を取得
function GetPHostEnt(HostName:AnsiString):PHostEnt;
// WinSockのエラー番号からエラー文字列に変換
function GetSocketErrorMessage(errno:integer):String;

var
  WSAData: TWSAData;

implementation

function GetPHostEnt(HostName:AnsiString):PHostEnt;
//ホスト名からIPアドレスをPHostEnt型で取り出す
var addr: Integer;
    phe: PHostEnt;
begin
  phe := gethostbyname(PansiChar(HostName));
  if phe = nil then
  begin
    // IPアドレスでの指定の場合
    addr := inet_addr(PansiChar(HostName));
    phe  := gethostbyaddr(@addr, 4, AF_INET);
  end;
  Result := phe;
end;

function GetSocketErrorMessage(ErrNo:integer):String;
//Socketのエラーメッセージを出力
var st:string;
begin
  st:='error'+IntToStr(ErrNo)+'：';
  case ErrNo of
    WSABASEERR:          Result :='No Error';
    WSAEINTR:            Result := st+'Interrupted system call';
    WSAEBADF:            Result := st+'Bad file number';
    WSAEACCES:           Result := st+'Permission denied';
    WSAEFAULT:           Result := st+'Bad address';
    WSAEINVAL:           Result := st+'Invalid argument';
    WSAEMFILE:           Result := st+'Too many open files';
    WSAEWOULDBLOCK:      Result := st+'Operation would block';
    WSAEINPROGRESS:      Result := st+'Operation now in progress';
    WSAEALREADY:         Result := st+'Operation already in progress ';
    WSAENOTSOCK:         Result := st+'Socket operation on non-socket';
    WSAEDESTADDRREQ:     Result := st+'Destination address required';
    WSAEMSGSIZE:         Result := st+'Message too long';
    WSAEPROTOTYPE:       Result := st+'Protocol wrong type for socket';
    WSAENOPROTOOPT:      Result := st+'Bad protocol option';
    WSAEPROTONOSUPPORT:  Result := st+'Protocol not supported';
    WSAESOCKTNOSUPPORT:  Result := st+'Socket type not supported';
    WSAEOPNOTSUPP:       Result := st+'Operation not supported on socket';
    WSAEPFNOSUPPORT:     Result := st+'Protocol family not supported';
    WSAEAFNOSUPPORT:     Result := st+'Address family not supported by protocol family';
    WSAEADDRINUSE:       Result := st+'Address already in use';
    WSAEADDRNOTAVAIL:    Result := st+'Can''t assign requested address';
    WSAENETDOWN:         Result := st+'Network is down';
    WSAENETUNREACH:      Result := st+'Network is unreachable';
    WSAENETRESET:        Result := st+'Net dropped connection or reset';
    WSAECONNABORTED:     Result := st+'Software caused connection abort';
    WSAECONNRESET:       Result := st+'Connection reset by peer';
    WSAENOBUFS:          Result := st+'No buffer space available';
    WSAEISCONN:          Result := st+'Socket is already connected';
    WSAENOTCONN:         Result := st+'Socket is not connected';
    WSAESHUTDOWN:        Result := st+'Can''t send after socket shutdown';
    WSAETOOMANYREFS:     Result := st+'Too many referencescan''t splice';
    WSAETIMEDOUT:        Result := st+'Connection timed out';
    WSAECONNREFUSED:     Result := st+'Connection refused';
    WSAELOOP:            Result := st+'Too many levels of symbolic links';
    WSAENAMETOOLONG:     Result := st+'File name too long';
    WSAEHOSTDOWN:        Result := st+'Host is down';
    WSAEHOSTUNREACH:     Result := st+'No Route to Host';
    WSAENOTEMPTY:        Result := st+'Directory not empty';
    WSAEPROCLIM:         Result := st+'Too many processes';
    WSAEUSERS:           Result := st+'Too many users';
    WSAEDQUOT:           Result := st+'Disc Quota Exceeded';
    WSAESTALE:           Result := st+'Stale NFS file handle';
    WSAEREMOTE:          Result := st+'Too many levels of remote in path';
    WSASYSNOTREADY:      Result := st+'Network SubSystem is unavailable';
    WSAVERNOTSUPPORTED:  Result := st+'WINSOCK DLL Version out of range';
    WSANOTINITIALISED:   Result := st+'Successful WSASTARTUP not yet performed';
    WSAHOST_NOT_FOUND:   Result := st+'Host not found';
    WSATRY_AGAIN:        Result := st+'Non-Authoritative Host not found';
    WSANO_RECOVERY:      Result := st+'Non-Recoverable errors: FORMER RREFUSED NOTIMP';
    WSANO_DATA:          Result := st+'Valid name no data record of requested type';
    else                 Result := st+'Other Error';
  end;
end;

{ TMamTcpClient }

function TMamTcpClient.Close: boolean;
begin
  result:=True;
  if FSocket <> INVALID_SOCKET then
  begin
    //ソケットの送受信を無効にする
    //SD_SEND、SD_RECEIVE、SD_BOTHのいずれかを指定
    if winsock.shutdown(FSocket,SD_BOTH)=SOCKET_ERROR then
    begin
      result:=False;
      FErrCode := WSAGetLastError;
      FErrMsg:=GetSocketErrorMessage(FErrCode);
      if Assigned(FErrEvent) then
        FErrEvent(Self,FErrMsg)
      else
        raise Exception.Create(FErrMsg);
    end;
    //ソケットを閉じる
    if winsock.closesocket(FSocket)=SOCKET_ERROR then
    begin
      FErrCode := WSAGetLastError;
      FErrMsg:=GetSocketErrorMessage(FErrCode);
      if Assigned(FErrEvent) then
        FErrEvent(Self,FErrMsg)
      else
        raise Exception.Create(FErrMsg);
    end;
    FSocket:=INVALID_SOCKET;
    FConnecting := False;
  end
  else
  begin
    result:=False;
    FConnecting:=False;
  end;
end;

constructor TMamTcpClient.Create();
begin
  inherited Create();
  FPort:=80;
  FHost:='';
  FConnecting:=false;
  FErrCode:=0;
  FErrMsg:='';
  FErrEvent:=nil;
  FSocket:=INVALID_SOCKET;
  //バッファサイズ
  FBufSize := 1 * 1024;
  //接続タイムアウト 5秒
  FConnectTimeout.tv_sec:=5;
  FConnectTimeout.tv_usec:=0;
  //読み取りタイムアウト5秒
  FRecvTimeout.tv_sec:=5;
  FRecvTimeout.tv_usec:=0;
end;

destructor TMamTcpClient.Destroy;
begin
  if FConnecting then Close;
  if FSocket <> INVALID_SOCKET then
  begin
  end;
  inherited;
end;

function TMamTcpClient.Open: boolean;
//サーバーへ接続する
var phe:PHostEnt;
    sockaddr:sockaddr_in;
    ret:Integer;
    mode:Integer;
    fds:TFDSet;
begin
  Result:=false;
  if FConnecting then
  begin
    if Assigned(FErrEvent) then
      FErrEvent(Self,'既に接続しています')
    else
      raise Exception.Create('既に接続しています');
    Exit;
  end;

  //ホスト名からIPアドレスをPHostEnt型で取り出す
  phe:=GetPHostEnt(FHost);
  if phe=nil then
  begin
    if Assigned(FErrEvent) then
      FErrEvent(Self,'指定したサーバー('+String(FHost)+')が見つかりません')
    else
      raise Exception.Create('指定したサーバー('+String(FHost)+')が見つかりません。');
    Exit;
  end;

  ZeroMemory(@sockaddr,sizeof(sockaddr));
  sockaddr.sin_family:=AF_INET;
  //ポート番号をリトルエンディアンから
  //ビッグエンディアンへ変換して指定する
  sockaddr.sin_port:=htons(FPort);
  sockaddr.sin_addr:=PInAddr(phe.h_addr_list^)^;//接続先アドレスの指定

  //TCPソケットの作成 SOCK_STREAM＝TCP、SOCK_DGRAM=UDP
  //ソケットは
  //  サーバーIP+サーバーPort+クライアントIP+クライアントPort
  //で一意として作られるため接続時に作る(コンストラクタで作らない)
  FSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_TCP);
  if FSocket=INVALID_SOCKET then
  begin
    if Assigned(FErrEvent) then
      FErrEvent(Self,'ソケットを作成することができませんでした')
    else
      raise Exception.Create('ソケットを作成することができませんでした');
    exit;
  end;

  //一旦非同期に設定
  mode:=1;
  ioctlsocket(FSocket,FIONBIO,mode);
  FErrMsg:='';
  //サーバーへ接続する
  ret:=WinSock.connect(FSocket,sockaddr,sizeof(sockaddr));
  if ret=SOCKET_ERROR then
  begin
    FErrCode:=WSAGetLastError;
    if FErrCode=WSAEWOULDBLOCK then
    begin
      FD_ZERO(fds);
      FD_SET(FSocket,fds);
      //winsockのselectの第1引数はUnix互換の為で無視される
      ret:=winsock.select(0,nil,@fds,nil,@FConnectTimeout);
      if ret = SOCKET_ERROR then
      begin
        //送信エラーチェック
        FErrCode := WSAGetLastError;
        FErrMsg:=GetSocketErrorMessage(FErrCode);
      end
      else if ret=0 then
      begin
        //接続タイムアウトの場合
        FErrMsg:='Connection Timeout';
      end;
    end
    else
    begin
      FErrMsg:=GetSocketErrorMessage(FErrCode);
    end;
  end;
  //同期に戻す
  mode:=0;
  ioctlsocket(FSocket,FIONBIO,mode);
  //エラーの場合
  if FErrMsg<>'' then
  begin
    winsock.closesocket(FSocket);
    FSocket:=INVALID_SOCKET;
    if assigned(FErrEvent) then
    begin
      FErrEvent(self,FErrMsg);
      exit;
    end
    else
    begin
      raise Exception.Create(FErrMsg);
    end;
  end;
  FConnecting:=True;
  Result:=True;
end;

function TMamTcpClient.RecvBytes: TBytes;
var strm:TMemoryStream;
    b:TBytes;
begin
  strm:=TMemoryStream.Create;
  try
    Self.RecvStream(strm);
    strm.Position:=0;
    SetLength(b,strm.Size);
    strm.Read(b,strm.Size);
    Result:=b;
  finally
    strm.Free;
  end;
end;

function TMamTcpClient.RecvStr: String;
//受信しデータをAnsiString(SJIS)と想定して返す
var strm:TMemoryStream;
    b:TBytes;
begin
  Result := '';
  strm:=TMemoryStream.Create;
  try
    Self.RecvStream(strm);
    strm.Position:=0;
    SetLength(b,strm.Size);
    strm.Read(b,strm.Size);
    Result:=TEncoding.ANSI.GetString(b);
  finally
    strm.Free;
  end;
end;


function TMamTcpClient.RecvStrDelCRLF: String;
//受信しデータをAnsiString(SJIS)と想定して返すが
//受信データの最後がCR+LFの場合は削除する
var st:String;
begin
  st:=self.RecvStr;
  if AnsiRightStr(st,2)=#13#10 then
    result:=AnsiLeftStr(st,Length(st)-2)
  else
    result:=st;
end;


procedure TMamTcpClient.RecvStream(strm: TMemoryStream);
//データをTStreamに受信
var buf: TBytes;
    ret,rets: Integer;
    fds:TFDSet;
    timeout:TTimeVal;
begin
  if FSocket=INVALID_SOCKET then exit;
  strm.Size:=0;
  SetLength(buf, FBufSize);

  timeout.tv_sec:=0;           //秒
  timeout.tv_usec:=1000*100*1; //マイクロ秒
  FD_ZERO(fds);
  FD_SET(FSocket,fds);
  //読み込み可能になるまでタイムアウト時間待つ
  //winsockのselectの第1引数はUnix互換の為で無視される
  rets:=winsock.select(0,@fds,nil,nil,@FRecvTimeout);
  if rets=0 then
  begin
    //読み込みタイムアウトしたので抜ける
    if strm.Size=0 then
    begin
      FErrMsg:='Receive Timeout';
      if assigned(FErrEvent) then
        FErrEvent(self,FErrMsg)
      else
        raise Exception.Create(ErrMsg);
    end;
    exit;
  end;

  while true do
  begin
    FD_ZERO(fds);
    FD_SET(FSocket,fds);
    //読み込み可能になるまでタイムアウト時間待つ
    //winsockのselectの第1引数はUnix互換の為で無視される
    rets:=winsock.select(0,@fds,nil,nil,@timeout);
    if rets=0 then
    begin
      //読み込みタイムアウトしたので抜ける
      if strm.Size=0 then
      begin
        FErrMsg:='Receive Timeout';
        if assigned(FErrEvent) then
          FErrEvent(self,FErrMsg)
        else
          raise Exception.Create(ErrMsg);
      end;
      Break;
    end;

    if FD_ISSET(FSocket,fds) then
    begin
      // 受信バッファを初期化
      ZeroMemory(@buf[0], FBufSize);
      // 受信処理
      ret := WinSock.recv(FSocket, buf[0], FBufSize, 0);
      //受信エラーチェック
      if ret = SOCKET_ERROR then
      begin
        FErrCode := WSAGetLastError;
        FErrMsg:=GetSocketErrorMessage(FErrCode);
        if assigned(FErrEvent) then
          FErrEvent(self,FErrMsg)
        else
          raise Exception.Create(ErrMsg);
      end;
      //受信したデータ数が0なら受信データがもう無いので抜ける
      if ret = 0 then
      begin
        Break;
      end;
      // ストリームに保存
      strm.Write(buf[0],ret);
      if ret<FBufSize then
      begin
        //Break;
      end;
    end
    else
    begin
      Break;
    end;
  end;
end;


procedure TMamTcpClient.RecvStringList(RecvStrings: TStrings;Enc:TEncoding);
//データをTStringsに受信、Encにエンコードを指定する
var
  strm:TMemoryStream;
begin
  //Streamで読み込んでからTStringsに読み込み
  strm:=TMemoryStream.Create;
  try
    Recvstream(strm);
    strm.Position:=0;
    RecvStrings.LoadFromStream(strm,Enc);
    //RecvStrings.LoadFromStream(strm,TEncoding.GetEncoding(20932));
  finally
    strm.Free;
  end;
end;

procedure TMamTcpClient.SendBytes(b: TBytes);
//バイト配列を送信
begin
  if not FConnecting then Exit;
  if length(b)=0 then exit;
  if WinSock.send(FSocket,b[0],Length(b),0)=SOCKET_ERROR then
  begin
    FErrCode := WSAGetLastError;
    FErrMsg:=GetSocketErrorMessage(FErrCode);
    if Assigned(FErrEvent) then
      FErrEvent(Self,FErrMsg)
    else
      raise Exception.Create(ErrMsg);
  end;
end;

procedure TMamTcpClient.Send(st: String);
//文字列をAnsiString(SJIS)で送信する
var b:TBytes;
begin
  if st = '' then Exit;
  b:=TEncoding.ANSI.GetBytes(st);
  Self.SendBytes(b);
end;

procedure TMamTcpClient.SendLn(st: String;EOL: String = #13#10);
//文字列をAnsiString(SJIS)でCR+LF付きで送信する
begin
  Self.Send(st + EOL);
end;

procedure TMamTcpClient.SetConnectTimeout(sec: LongInt);
begin
  if sec<1 then sec:=1;
  if sec>86400 then sec:=86400;
  FConnectTimeout.tv_sec:=sec;
end;

procedure TMamTcpClient.SetRecvTimeout(sec: LongInt);
begin
  if sec<1 then sec:=1;
  if sec>86400 then sec:=86400;
  FRecvTimeout.tv_sec:=sec;
end;

initialization
// WinSock 初期化
  WSAStartup($0101, WSAData);

finalization
// WinSock 終了処理
  WSACleanup;

end.

２．ユニット「MamTcpClient.pas」を使う

uses MamTcpClient;
として使用します。
以下はButton1を押したときに、「http://localhost/delphi/」をGETします。
Button2を押したときに、「http://localhost/delphi/first.html」をGETします。

uses MamTcpClient;

procedure TForm1.Button1Click(Sender: TObject);
var tc:TMamTcpClient;
    ret:boolean;
    b:TBytes;
begin
  tc:=TMamTcpClient.Create();
  //エラー時はsockerrorプロシージャを呼び出す
  tc.OnErrEvent:=sockerror;
  tc.Port:=80;
  tc.Host:='localhost';

  ret:=tc.Open;
  if ret then
  begin
    //文字列+CR+LFを送信する
    tc.SendLn('GET /delphi/ HTTP/1.1');
    tc.SendLn('User-Agent: MyUserAgent[ja]');
    tc.sendLn('Host: hoge.jp');
    //$0D(CR)+$0A(LF)のみを送信する
    tc.SendLn('');
    //受信タイミングが難しい（相手サーバー次第）
    //即時に送ってくれるか、ゆっくり送るか、送った直後に閉じるプロトコルもあるし
    //複数パケットで送ってくるかもしれないし、そもそも何バイト送ってくるかわからない
    //例えばhttpの場合はContent-Lengthヘッダを調べて受信すべきかも
    //とりあえず適当にちょっと待つ
    sleep(500);
    //バイト配列で受信する場合
    b:=tc.RecvBytes;
    //受信したバイト配列をUTF8に変換
    Memo1.Lines.Add(TEncoding.UTF8.GetString(b));
    tc.Close;
  end;
  tc.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
var tc:TMamTcpClient;
    ret:boolean;
    b:TBytes;
begin
  tc:=TMamTcpClient.Create();
  //エラー時はsockerrorプロシージャを呼び出す
  tc.OnErrEvent:=sockerror;
  tc.Port:=80;
  tc.Host:='localhost';
  ret:=tc.Open;
  if ret then
  begin
    //文字列をバイト配列に変換して送信する場合
    b:=TEncoding.ASCII.GetBytes(
      'GET /delphi/first.html HTTP/1.1'+#13#10+
      'User-Agent: Telnet [ja] (Linux)'+#13#10+
      'Host: hoge.jp'+#13#10+
      #13#10
    );
    tc.SendBytes(b);
    //受信タイミングが難しい（相手サーバー次第）
    //即時に送ってくれるか、ゆっくり送るか、送った直後に閉じるプロトコルもあるし
    //複数パケットで送ってくるかもしれないし、そもそも何バイト送ってくるかわからない
    //例えばhttpの場合はContent-Lengthヘッダを調べて受信すべきかも
    //とりあえず適当にちょっと待つ
    sleep(500);
    //SJIS文字列として受信する場合(UTF8コンテンツは文字化けする)
    Memo1.Lines.Add(tc.RecvStr);
    tc.Close;
  end;
  tc.Free;
end;