ab.com コミュニティ

' 参考資料
' ●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やFTPなどの接続に使える、汎用TCPクライアントです。

クラス定義部
[hide][code]' 参考資料
' ●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[/code][/hide]
実行部
[hide][code]#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[/code][/hide]
ダウンロードはこちらから。
http://ab.sinryow.net/tcpclient.php

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