| history | TOP |
2003/08/10:作成
| reference | TOP |
C/C++300の技
http://www.asahi-net.or.jp/~nk2w-ishr/
| overview | TOP |
第3話。第1話はWEBサーバを作ろう-001。第2話はWEBサーバを作ろう-002。
第2話までテストコードを書いてきましたがこんなに短いくせにジョジョに嫌な感じになってきたので整理しておきます。 といっても、Winsock.pasの関数を呼ぶためラッパー関数をくくりだしておくだけですが。
| download | TOP |
20030810iWinSock.zip(3,177bytes):ソース
| code | TOP |
(*
#######################################################
目的 : WinSock.pas のソケット関数のラッパー
履歴 : 2003/08/10 作成
参考 : C/C++300の技
: http://www.asahi-net.or.jp/~nk2w-ishr/
#######################################################
*)
unit iWinSock;
interface
uses
Windows, SysUtils, Classes, WinSock;
function socket(): TSocket;
procedure closesocket(s: TSocket);
function MakeSockAddr(APort: integer; IPorName: string): TSockAddr;
procedure connect(s: TSocket; var name: TSockaddr);
procedure send(s: TSocket; stream: TStream); overload;
procedure send(s: TSocket; command: string); overload;
procedure send(s: TSocket; strings: TStrings); overload;
procedure recv(s: TSocket; stream: TStream); overload;
procedure recv(s: TSocket; strings: TStrings); overload;
function recv(s: TSocket): string; overload;
function recvonce(s: TSocket): string;
procedure bind(s: TSocket; var name: TSockaddr);
procedure listen(s: TSocket);
function accept(s: TSocket; clientname: TSockaddr): TSocket;
var
MaxSocketCount: integer = 0;
implementation
(*
=======================================================
最新のエラーメッセージを例外として生成
-------------------------------------------------------
オリジナル : なし
引数 : 原因となった関数名
戻値 : なし
備考 : なし
=======================================================
*)
procedure RaiseError(AFuncName: string);
begin
raise Exception.CreateFmt('%s(iWinSock.pas):%s', [AFuncName, SysErrorMessage(WSAGetLastError)]);
end;
(*
=======================================================
Winsock 使用開始宣言
-------------------------------------------------------
オリジナル : WSAStartup
引数 : なし
戻値 : 作成可能ソケット数
備考 : Version1.1前提
=======================================================
*)
function WSAStartup(): integer;
const
VERSION: WORD = $0101;
var
WSAData: TWSAData;
begin
if (Winsock.WSAStartup(VERSION, WSAData) = 0) and (WSAData.wVersion = VERSION) then
begin
Result := WSAData.iMaxSockets;
end else
begin
Result := 0;
RaiseError('WSAStartup');
end;
end;
(*
=======================================================
Winsock 使用終了宣言
-------------------------------------------------------
オリジナル : WSACleanup
引数 : なし
戻値 : 作成可能ソケット数
備考 : Version1.1前提
=======================================================
*)
procedure WSACleanup();
begin
if Winsock.WSACleanup <> 0 then RaiseError('WSACleanup');
end;
(*
=======================================================
PHostEnt構造体からh_aliases情報を取り出す
-------------------------------------------------------
オリジナル : なし
引数 : PHostEnt
戻値 : h_aliases情報を,でつないだ文字列
備考 : なし
=======================================================
*)
type
PPChar = ^PChar;
function HostAliases(HostEntry: PHostEnt): string;
var
ppc: PPChar;
begin
Result := '';
try
ppc := PPChar(HostEntry^.h_aliases);
while Assigned(ppc^) do
begin
// ppc は、PPChar = ^PChar なので、ppc^ = PChar になる。
Result := Result + ',' + ppc^;
Inc(ppc);
end;
//1文字目が、絶対に','になってるのでごみ掃除
Result := Copy(Result, 2, Length(Result));
except
RaiseError('HostEntry^.h_aliases');
end;
end;
(*
=======================================================
PHostEnt構造体からh_addr_list情報を取り出す
-------------------------------------------------------
オリジナル : なし
引数 : PHostEnt
戻値 : h_addr_list情報を,でつないだ文字列
備考 : なし
=======================================================
*)
function HostAddressList(HostEntry: PHostEnt): string;
var
ppc: PPChar;
begin
Result := '';
try
ppc := PPChar(HostEntry^.h_addr_list);
while Assigned(ppc^) do
begin
// ppc は、PPChar = ^PChar なので、ppc^ = PChar になる。
Result := Result + ',' + inet_ntoa(PInAddr(ppc^)^);
Inc(ppc);
end;
//1文字目が、絶対に','になってるのでごみ掃除
Result := Copy(Result, 2, MaxInt);
except
RaiseError('HostEntry^.h_addr_list');
end;
end;
(*
=======================================================
IPアドレスかコンピュータ名からPHostEnt作成
-------------------------------------------------------
オリジナル : gethostbyaddr, gethostbyname
引数 : IPアドレス文字列かコンピュータ名
戻値 : PHostEnt
備考 : なし
=======================================================
*)
function gethostby(IPorName: string): PHostEnt;
var
ip : u_long;
begin
// 10進表記かな?
ip := inet_addr(PChar(IPorName));
// だめだ
if ip = INADDR_NONE then
begin
Result := Winsock.gethostbyname(PChar(IPorName));
end else
// ええよ
begin
Result := Winsock.gethostbyaddr(@ip, 4, AF_INET);
end;
// うまくいったかな
if not Assigned(Result) then RaiseError('gethostby****');
end;
(*
=======================================================
IPアドレスかコンピュータ名から整数版IPアドレス作成
-------------------------------------------------------
オリジナル : なし
引数 : IPアドレス文字列かコンピュータ名
戻値 : 整数版IPアドレス
備考 : なし
=======================================================
*)
function InetAddress(IPorName: string): integer;
var
HostEntry: PHostEnt;
begin
// 回りくどいけど
HostEntry := gethostby(IPorName);
// で、
Result := inet_addr(inet_ntoa(PInAddr(HostEntry^.h_addr_list^)^));
end;
(*
=======================================================
socketを作る
-------------------------------------------------------
オリジナル : socket
引数 : なし
戻値 : TSocket
備考 : TCP/IP
=======================================================
*)
function socket(): TSocket;
begin
// 作りましょう
Result := Winsock.socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
// うまくいったかな
if Result = INVALID_SOCKET then RaiseError('socket');
end;
(*
=======================================================
socketを捨てる
-------------------------------------------------------
オリジナル : closesocket
引数 : TSocket
戻値 : なし
備考 : なし
=======================================================
*)
procedure closesocket(s: TSocket);
begin
// 捨てましょう
if Winsock.closesocket(s) = SOCKET_ERROR then RaiseError('closesocket');
end;
(*
=======================================================
TSockAddr作成
-------------------------------------------------------
オリジナル : なし
引数 : ポート番号
IPアドレス文字列かコンピュータ名
戻値 : TSockAddr
備考 : なし
=======================================================
*)
function MakeSockAddr(APort: integer; IPorName: string): TSockAddr;
begin
FillChar(Result, SizeOf(TSockAddr), #0);
Result.sin_family := AF_INET;
Result.sin_port := htons(APort);
if IPorName <> '' then
Result.sin_addr.S_addr := InetAddress(IPorName)
else
Result.sin_addr.S_addr := INADDR_ANY // サーバー用のつもり
;
end;
(*
=======================================================
接続する
-------------------------------------------------------
オリジナル : connect
引数 : TSocket
TSockAddr
戻値 : なし
備考 : なし
=======================================================
*)
procedure connect(s: TSocket; var name: TSockaddr);
begin
if Winsock.connect(s, name, sizeof(name)) = SOCKET_ERROR then RaiseError('connect');
end;
(*
=======================================================
送る
-------------------------------------------------------
オリジナル : send
引数 : TSocket
TStream
戻値 : なし
備考 : スレッドから呼び出すべきかも
=======================================================
*)
procedure send(s: TSocket; stream: TStream);
var
senddat: string;
sendlen, sentlen: integer;
begin
// stream 位置
stream.Position := 0;
// 受信
while True do
begin
// 初期化
senddat := '';
SetLength(senddat, stream.Size);
sendlen := stream.Read(senddat[1], stream.Size);
// 送ってみる
sentlen := Winsock.send(s, senddat[1], sendlen, 0);
// エラーはないか?
if sentlen = SOCKET_ERROR then
begin
RaiseError('send');
end else
// 全部送れてねーよ
if sentlen < sendlen then
begin
// 送れてない分だけ後戻り
stream.Seek(sendlen - sentlen, soFromCurrent);
end else
// 全部送れたよ
begin
Break;
end;
end;
end;
(*
=======================================================
送る
-------------------------------------------------------
オリジナル : send
引数 : TSocket
送信する文字列
戻値 : なし
備考 : スレッドから呼び出すべきかも
=======================================================
*)
procedure send(s: TSocket; command: string);
var
stream: TStream;
begin
stream := TMemoryStream.Create;
try
stream.Write(command[1], Length(command));
send(s, stream);
finally
stream.Free;
end;
end;
(*
=======================================================
送る
-------------------------------------------------------
オリジナル : send
引数 : TSocket
TStrings
戻値 : なし
備考 : スレッドから呼び出すべきかも
=======================================================
*)
procedure send(s: TSocket; strings: TStrings);
var
stream: TStream;
begin
stream := TMemoryStream.Create;
try
strings.SaveToStream(stream);
send(s, stream);
finally
stream.Free;
end;
end;
(*
=======================================================
受ける
-------------------------------------------------------
オリジナル : recv
引数 : TSocket
TStream
戻値 : なし
備考 : スレッドから呼び出すべきかも
=======================================================
*)
procedure recv(s: TSocket; stream: TStream);
var
recvdat: string;
recvlen: integer;
begin
// 受信
while True do
begin
// 初期化
recvdat := '';
SetLength(recvdat, 8 * 1024);
// 受けてみる
recvlen := Winsock.recv(s, recvdat[1], Length(recvdat), 0);
// エラーはないか?
if recvlen = SOCKET_ERROR then
begin
RaiseError('recv');
end else
// 終わったよ
if recvlen = 0 then
begin
Break;
end else
// 読み取り
begin
stream.Write(recvdat[1], recvlen);
end;
end;
// stream 位置
stream.Position := 0;
end;
(*
=======================================================
受ける
-------------------------------------------------------
オリジナル : recv
引数 : TSocket
TStrings
戻値 : なし
備考 : スレッドから呼び出すべきかも
=======================================================
*)
procedure recv(s: TSocket; strings: TStrings);
var
stream: TStream;
begin
stream := TMemoryStream.Create;
try
recv(s, stream);
strings.LoadFromStream(stream);
finally
stream.Free;
end;
end;
(*
=======================================================
受ける
-------------------------------------------------------
オリジナル : recv
引数 : TSocket
戻値 : string
備考 : スレッドから呼び出すべきかも
=======================================================
*)
function recv(s: TSocket): string;
var
stream: TStream;
res: integer;
begin
stream := TMemoryStream.Create;
try
recv(s, stream);
SetLength(Result, stream.Size);
res := stream.Read(Result[1], Length(Result));
SetLength(Result, res);
finally
stream.Free;
end;
end;
(*
=======================================================
受ける(サーバの要求時に上のルーチンを使うと何故かだめ)
-------------------------------------------------------
オリジナル : recv
引数 : TSocket
戻値 : string
備考 : スレッドから呼び出すべきかも
=======================================================
*)
function recvonce(s: TSocket): string;
var
recvlen: integer;
begin
// 初期化
Result := '';
SetLength(Result, 8 * 1024);
// 受けてみる
recvlen := Winsock.recv(s, Result[1], Length(Result), 0);
// エラーはないか?
if recvlen = SOCKET_ERROR then RaiseError('recv');
SetLength(Result, recvlen);
end;
(*
=======================================================
ポート番号とプロセスをバインド
-------------------------------------------------------
オリジナル : bind
引数 : TSocket
TSockAddr
戻値 : なし
備考 : なし
=======================================================
*)
procedure bind(s: TSocket; var name: TSockaddr);
begin
if Winsock.bind(s, name, sizeof(name)) = SOCKET_ERROR then RaiseError('bind');
end;
(*
=======================================================
聞く
-------------------------------------------------------
オリジナル : listen
引数 : TSocket
戻値 : なし
備考 : なし
=======================================================
*)
procedure listen(s: TSocket);
begin
if Winsock.listen(s, SOMAXCONN) = SOCKET_ERROR then RaiseError('listen');
end;
(*
=======================================================
受け付け
-------------------------------------------------------
オリジナル : accept
引数 : TSocket
TSockaddr
戻値 : TSocket
備考 : なし
=======================================================
*)
function accept(s: TSocket; clientname: TSockaddr): TSocket;
var
caddrlen: integer;
begin
// サイズ
caddrlen := SizeOf(clientname);
// 初期化
FillChar(clientname, SizeOf(TSockAddr), #0);
// 受け付け
Result := Winsock.accept(s, @clientname, @caddrlen);
// うまくいった?
if Result = INVALID_SOCKET then RaiseError('accept');
end;
(*
=======================================================
初期化部/終了部
-------------------------------------------------------
Winsock の使用準備/終了準備
=======================================================
*)
initialization
try
MaxSocketCount := WSAStartUp();
except
;
end;
finalization
try
WSACleanup();
except
;
end;
end.
| EOF | TOP |