クラス定義部
[ここをクリックすると内容が表示されます]
実行部
コード: 全て選択
' 参考資料
' ●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 "エンターキーで終了", szhttp://ab.sinryow.net/tcpclient.php
近いうちサーバーも作りたいと思っています。