ab.com コミュニティ

by **Sinryow** » 2006年9月16日(土) 21:43

HTTPやFTPなどの接続に使える、汎用TCPクライアントです。

クラス定義部

' 参考資料
' ●ActiveBasic本
' ●http://www.tohoho-web.com/wwwperl2.htm#socket
' ●http://www.7key.jp/nw/study3.html

Declare Function gethostbyaddr Lib "Ws2_32" (arrAddr As *Byte, nLen As Long, nType As Long) As *HOSTENT
Declare Function getservbyport Lib "Ws2_32" (port As Long, proto As *Byte) As *SERVENT
Declare Function WSAGetLastError Lib "Ws2_32" () As Long
Declare Sub WSASetLastError Lib "Ws2_32" (nError As Long)

Class TCPClient
Private
	server As *HOSTENT
	port As *SERVENT
	sock As Long
	saddr As SOCKADDR_IN

Public
	' ========== サーバーをセットする ==========

	' アドレスを１つずつ指定する場合	
	Function SetServer(nAddr1 As Byte, nAddr2 As Byte, nAddr3 As Byte, nAddr4 As Byte) As Long
		Dim arrAddr[ELM(4)] = [nAddr1, nAddr2, nAddr3, nAddr4] As Byte
		server = This.SetServer(arrAddr, 4)
		SetServer = (server <> NULL)
	End Function

	' ホスト名で指定する場合
	Function SetServer(strHost As *Byte) As Long
		server = gethostbyname(strHost)
		SetServer = (server <> NULL)
	End Function
	
	' アドレスを配列で指定する場合
	Function SetServerArr(arrAddr As *Byte)(nLenAddr As Long) As Long
		If lenAddr <= 0 Then lenAddr = 4
		server = gethostbyaddr(arrAddr, nLenAddr, AF_INET)
		SetServer = (server <> NULL)
	End Function
	
	' ========== ポートをセットする ==========

	' ポート番号で指定する場合
	Function SetPort(nPort As Word) As Long
		port = getservbyport(htons(nPort) As Long, NULL)
		SetPort = (port <> NULL)
	End Function

	Function SetPort(nPort As Word, strProtocol As *Byte) As Long
		port = getservbyport(htons(nPort) As Long, strProtocol)
		SetPort = (port <> NULL)
	End Function

	' サービス名で指定する場合（例："http"）
	Function SetPort(strService As *Byte) As Long
		port = getservbyname(strService, NULL)
		SetPort = (port <> NULL)
	End Function
	
	Function SetPort(strService As *Byte, strProtocol As *Byte) As Long
		port = getservbyname(strService, strProtocol)
		SetPort = (port <> NULL)
	End Function
	
	' ========== ソケットを開く ==========

	Function OpenSocket() As Long
		sock = socket(AF_INET, SOCK_STREAM, 0)
		OpenSocket = (sock <> INVALID_SOCKET)
	End Function
	
	' ========== シャットダウン ==========

	Function ShutDown()(flgMode As Long) As Long
		If flgMode = 0 Then flgMode = SD_BOTH
		ShutDown = shutdown(sock, flgMode)
	End Function

	' ========== ソケットを閉じる ==========

	Function CloseSocket() As Long
		CloseSocket = closesocket(sock)
	End Function
	
	' ========== サーバーに接続 ==========

	Function Connect() As Long
		' Connect = FALSE

		WSASetLastError(0)
		If server = NULL Or port = NULL Or sock = INVALID_SOCKET Then Exit Function
		
		saddr.sin_family = AF_INET
		saddr.sin_port = port->s_port
		saddr.sin_addr = GetDWord(GetDWord(server->h_addr_list))
		
		If connect(sock, saddr, SizeOf(SOCKADDR_IN)) = 0 Then Connect = TRUE
	End Function
	
	' ========== サーバーとの接続を切る ==========

	Function Disconnect() As Long
		' Connect = FALSE

		WSASetLastError(0)
		If server = NULL Or port = NULL Or sock = INVALID_SOCKET Then Exit Function

		Dim saddr2 As SOCKADDR_IN
		saddr2.sin_family = AF_INET
		saddr2.sin_port = port->s_port
		saddr2.sin_port = 0

		If connect(sock, saddr, SizeOf(SOCKADDR_IN)) = 0 Then Connect = TRUE
	End Function

	' ========== データを送信 ==========

	Function Send(pData As *Byte, nLen As Long) As Long
		Send = send(sock, pData, nLen, 0)
	End Function

	Function SendString(strData As String) As Long
		SendString = This.Send(StrPtr(strData), lstrlen(StrPtr(strData)))
	End Function

	Function SendLine(strData As String) As Long
		strData = strData + Ex"\r\n"
		SendLine = This.Send(StrPtr(strData), lstrlen(StrPtr(strData)))
	End Function

	' ========== データを受信 ==========
	
	Function Recv(pData As *Byte, nLen As Long) As Long
		Recv = recv(sock, pData, nLen, 0)
	End Function

	Function RecvString(nLen As Long) As String
		Dim pData As *Byte, nRd As Long
		pData = malloc(nLen + 1) As *Byte
		nRd = recv(sock, pData, nLen, 0)
		If nRd = SOCKET_ERROR Then
			RecvString = ""
		Else
			pData[nRd] = 0
			RecvString = MakeStr(pData)
		End If
		free(pData)
	End Function

End Class

実行部

[ここをクリックすると内容が表示されます]

コード: 全て選択

#console

Sub Main()
	Dim tcpc As TCPClient
	Dim buf As String

	If tcpc.SetServer("www.activebasic.com") = FALSE Then
		Print "Cannot Find Server"
		Exit Sub
	End If

	If tcpc.SetPort("http") = FALSE Then
		Print "Cannot Find Service"
		Exit Sub
	End If

	If tcpc.OpenSocket() = FALSE Then
		Print "Cannot Open Socket"
		Exit Sub
	End If

	If tcpc.Connect() = FALSE Then
		Print "Cannot Connect to Server"
		Exit Sub
	End If
	
	tcpc.SendLine("GET / HTTP/1.0")
	tcpc.SendLine("Host: www.activebasic.com")
	tcpc.SendLine("Connection: keep-alive")
	tcpc.SendLine("")
	Print "Start Downloading ..."

	Do
		buf = tcpc.RecvString(70)
		Print buf;
	Loop While buf <> ""
End Sub

Dim wsad As WSADATA
WSAStartup(MAKEWORD(1, 1), wsad)
Main()
WSACleanup()

Dim sz As String
Input "エンターキーで終了", sz

ダウンロードはこちらから。
http://ab.sinryow.net/tcpclient.php

近いうちサーバーも作りたいと思っています。

ab.com コミュニティ

[AB4]汎用TCPクライアント

返信する

展開ビュートピックのレビュー: [AB4]汎用TCPクライアント

[AB4]汎用TCPクライアント

[AB4]汎用TCPクライアント

返信する

展開ビュー トピックのレビュー: [AB4]汎用TCPクライアント

[AB4]汎用TCPクライアント

展開ビュートピックのレビュー: [AB4]汎用TCPクライアント