ab.com コミュニティ https://www.activebasic.com/forum/ |
|
[AB4]汎用TCPクライアント https://www.activebasic.com/forum/viewtopic.php?t=1541 |
ページ 1 / 1 |
作成者: | Sinryow [ 2006年9月16日(土) 21:43 ] |
記事の件名: | [AB4]汎用TCPクライアント |
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 ' ========== サーバーをセットする ========== ' アドレスを1つずつ指定する場合 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 近いうちサーバーも作りたいと思っています。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |