Winsock APIでTCPクライアントを作る ~Delphiソースコード集 ~Delphiでお手軽プログラミング
1.汎用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.
2.ユニット「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;