UWSCでnonblocking版Winsockにファイル転送能力を追加

興味本位で、ばっと書いて公開するの忘れてた。

ファイル転送能力のないものは、以下
UWSCでnonblocking版Winsockを使う - じゅんじゅんのきまぐれ
また長くなった、、、。

スクリプト

Winsock.uws

OPTION EXPLICIT

IFB GET_UWSC_NAME = "Winsock.uws" THEN
	Winsock.Startup()
	DIM s = Winsock.Create(), res = 0, cs = s, mode = "client", port, addr, x = 600, y = 0
	IFB s <> Winsock.SOCKET_ERROR THEN
		IFB MSGBOX("server?", BTN_YES OR BTN_NO) = BTN_YES THEN
			mode = "server"
			x = 0
		ENDIF
		WHILE res <> Winsock.SOCKET_ERROR
			SELECT SLCTBOX(SLCT_BTN, 0, x, y, mode + "処理 " + Winsock.GetStatus(cs), "接続", "送信", "受信", "切断")
			CASE SLCT_1
				port = VAL(INPUT("port", "12345", FALSE, x, y))
				addr = INPUT("addr", "127.0.0.1", FALSE, x, y)
				IFB mode = "server" THEN
					res = Winsock.ListenN(s, port, addr)
					IF res = 0 THEN cs = Winsock.AcceptB(s)
					IF cs = Winsock.SOCKET_ERROR THEN res = cs
				ELSE
					res = Winsock.ConnectB(cs, port, addr)
					IF res = Winsock.SOCKET_ERROR THEN MSGBOX("connect fail.", BTN_OK, x, y)
				ENDIF
			CASE SLCT_2
				res = INPUT(mode, "", FALSE, x, y)
				IFB LENGTH(res) THEN
					IFB FOPEN(res, F_EXISTS) THEN
						res = Winsock.SendBFile(cs, res)
					ELSE
						res = Winsock.SendBString(cs, res)
					ENDIF
				ENDIF
			CASE SLCT_3
				res = Winsock.RecvBData(cs)
				IFB res <> Winsock.SOCKET_ERROR THEN
					IFB res = 0 THEN
						MSGBOX(mode + "<#CR> timeout", BTN_OK, x, y)
					ELSE
						MSGBOX(mode + "<#CR> recv: " + res, BTN_OK, x, y)
					ENDIF
				ENDIF
			DEFAULT
				res = Winsock.SOCKET_ERROR
			SELEND
		WEND
		MSGBOX(mode + "<#CR> fin.", BTN_OK, x, y)
		IF cs <> s THEN Winsock.Close(cs)
		Winsock.Close(s)
	ENDIF
	Winsock.Cleanup()
ENDIF


MODULE Winsock

	CONST AF_INET     = 2               //* internetwork: UDP, TCP, etc. */
	CONST SOCK_STREAM = 1               //* stream socket */
	CONST SOCK_DGRAM  = 2               //* datagram socket */
	CONST SOMAXCONN   = $7FFFFFFF
	CONST INADDR_ANY  = 0
	CONST IPPROTO_TCP = 6
	CONST IPPROTO_UDP = 17
	CONST FD_SETSIZE  = 64
	CONST FIONBIO     = $8004667E		//* set/clear non-blocking i/o */
	CONST WAIT_UNIT   = 100
	CONST WAIT_NUM    = 600
	CONST SOCKADDR_LENGTH = 16
	CONST SOCKET_ERROR = -1

	DEF_DLL socket(int, int, int): int: ws2_32
	DEF_DLL closesocket(int): int: ws2_32
	DEF_DLL bind(int, DWORD[], int): int: ws2_32
	DEF_DLL gethostbyname(string): DWORD: ws2_32
	DEF_DLL listen(int, int): int: ws2_32
	DEF_DLL accept(int, DWORD[], var int): int: ws2_32
	DEF_DLL connect(int, DWORD[], int): int: ws2_32
	// NULLも送受信するなら、stringではダメ
	//DEF_DLL recv(int, var string, int, int): int: ws2_32
	//DEF_DLL send(int, string, int, int): int: ws2_32
	//DEF_DLL recvfrom(int, var string, int, int, var DWORD[], var int): int: ws2_32
	//DEF_DLL sendto(int, string, int, int, DWORD[], int): int: ws2_32
	DEF_DLL select(int, var DWORD[], var DWORD[], var DWORD[], long[]): int: ws2_32
	//DEF_DLL __WSAFDIsSet(int, var DWORD[]): int: ws2_32
	DEF_DLL ioctlsocket(int, DWORD, var DWORD): int: ws2_32

	//DEF_DLL htonl(DWORD): DWORD: ws2_32
	//DEF_DLL ntohl(DWORD): DWORD: ws2_32
	DEF_DLL htons(WORD): WORD: ws2_32
	DEF_DLL ntohs(WORD): WORD: ws2_32
	//DEF_DLL inet_addr(string): DWORD: ws2_32
	DEF_DLL inet_ntoa(DWORD): string: ws2_32


	//DEF_DLL RtlMoveMemory(var string, DWORD, DWORD): kernel32
	//DEF_DLL RtlFillMemory(DWORD, DWORD, BYTE): kernel32
	DEF_DLL VirtualAlloc(DWORD, DWORD, DWORD, DWORD): DWORD: kernel32
	DEF_DLL VirtualFree(DWORD, DWORD, DWORD): bool: kernel32
	CONST PAGE_READWRITE = 4
	CONST MEM_COMMIT = $1000
	CONST MEM_RELEASE = $8000


	DEF_DLL CreateFileW(wstring, dword, dword, dword, dword, dword, dword): dword: kernel32.dll
	CONST GENERIC_READ = $80000000
	CONST GENERIC_WRITE = $40000000
	CONST FILE_SHARE_READ = 1
	CONST FILE_SHARE_WRITE = 2
	CONST FILE_SHARE_DELETE = 4
	CONST CREATE_NEW = 1
	CONST CREATE_ALWAYS = 2
	CONST OPEN_EXISTING = 3
	CONST OPEN_ALWAYS = 4
	CONST TRUNCATE_EXISTING = 5
	CONST INVALID_HANDLE_VALUE = $FFFFFFFF
	DEF_DLL GetFileSize(dword, var dword): dword: kernel32.dll
	DEF_DLL ReadFile(dword, dword, dword, var dword, dword): bool: kernel32.dll
	DEF_DLL WriteFile(dword, dword, dword, var dword, dword): bool: kernel32.dll
	DEF_DLL CloseHandle(dword): bool: kernel32.dll
	CONST FILE_BUF_SIZE = 4096


	HASHTBL _socks
	HASHTBL _allocs

	DIM _mode = -1


	// return: 0:ok  SOCKET_ERROR:error
	FUNCTION Startup(verReq=$0202)
		DEF_DLL WSAStartup(WORD,var WORD[]): int: ws2_32
		DIM WSAData[2+(256+128+2)/2+4]
		RESULT = WSAStartup(verReq, WSAData)
	FEND

	// return: 0:ok  SOCKET_ERROR:error
	FUNCTION Cleanup()
		WHILE LENGTH(_socks)
			Close(_socks[0, HASH_KEY])
		WEND
		DEF_DLL WSACleanup(): int: ws2_32
		RESULT = WSACleanup()

		WHILE LENGTH(_allocs)
			Free(_allocs[0, HASH_KEY])
		WEND
	FEND

	// return: SOCKET_ERROR:error  other:socket
	FUNCTION Create(type=SOCK_STREAM, af=AF_INET, protocol=0)
		RESULT = socket(af, type, protocol)
		IF RESULT <> SOCKET_ERROR THEN _socks[RESULT] = ""
	FEND

	// return: 0:ok  SOCKET_ERROR:error
	FUNCTION Close(s)
		RESULT = _socks[s, HASH_REMOVE]
		RESULT = closesocket(s)
	FEND

	FUNCTION GetStatus(s)
		RESULT = ""
		IF _socks[s, HASH_EXISTS] THEN RESULT = _socks[s]
	FEND

	FUNCTION GetAddrByName(name)
		DIM ptr = gethostbyname(name), hostent[3], addr[0]
		DEF_DLL RtlMoveMemory(var DWORD[], DWORD, DWORD): kernel32
		IF ptr THEN RtlMoveMemory(hostent, ptr, LENGTH(hostent) * 4)
		RESULT = 0
		IFB INT(hostent[2] / $10000) > 0 THEN
			RtlMoveMemory(addr, hostent[3], 4)
			RtlMoveMemory(addr, addr[0], 4)
			RESULT = addr[0]
		ENDIF
	FEND

	FUNCTION ConvFromPort(port, addr=INADDR_ANY)
		RESULT = SAFEARRAY(0, 3)
		RESULT[0] = AF_INET + htons(port) * $10000
		IF VARTYPE(addr) = VAR_USTR THEN addr = GetAddrByName(addr)
		RESULT[1] = addr
	FEND
	FUNCTION ConvToPort(tar[], len, var port, var addr)
		IF len >= 4 THEN port = ntohs(INT(tar[0] / $10000))
		IF len >= 8 THEN addr = inet_ntoa(tar[1])
		RESULT = tar[1]
	FEND

	// return: 0:ok  SOCKET_ERROR:error
	FUNCTION BindN(s, port, addr=INADDR_ANY)
		DIM tar = ConvFromPort(port, addr)
		RESULT = bind(s, tar, SOCKADDR_LENGTH)
		IF RESULT = 0 THEN _socks[s] = "B:" + port + ":" + addr
	FEND

	// return: 0:ok  SOCKET_ERROR:error
	FUNCTION ListenN(s, port=0, addr=INADDR_ANY, backlog=SOMAXCONN)
		RESULT = 0
		IF port THEN RESULT = BindN(s, port, addr)
		IF RESULT = 0 THEN RESULT = listen(s, backlog)
		IF RESULT = 0 THEN _socks[s] = _socks[s] + ",L"
	FEND

	// return: 0:no request  SOCKET_ERROR:error  other:socket
	FUNCTION AcceptB(s, c=WAIT_NUM, t=WAIT_UNIT)
		DIM port, addr
		RESULT = 0
		WHILE RESULT = 0 AND c > 0
			RESULT = AcceptN(s, port, addr, t)
			c = c - 1
		WEND
	FEND
	FUNCTION AcceptN(s, var port, var addr, t=WAIT_UNIT)
		RESULT = Check(s, 1, t)
		IFB RESULT <> SOCKET_ERROR AND RESULT <> 0 THEN
			DIM tar = ConvFromPort(0, 0), len = SOCKADDR_LENGTH
			RESULT = accept(s, tar, len)
			IFB RESULT <> SOCKET_ERROR THEN
				ConvToPort(tar, len, port, addr)
				_socks[RESULT] = "A:" + port + ":" + addr
			ENDIF
		ENDIF
	FEND

	// return: 0:processing  SOCKET_ERROR:error  other:!
	FUNCTION Check(s, m=1, t=WAIT_UNIT)
		DIM fds[FD_SETSIZE], tm[1]
		tm[0] = INT(t / 1000)	// sec
		tm[1] = t * 1000 MOD 1000000 // microseconds
		SETCLEAR(fds, 0)
		fds[0] = 1
		fds[1] = s
		SELECT m
		CASE 1
			RESULT = select(0, fds, NULL, NULL, tm)
		CASE 2
			RESULT = select(0, NULL, fds, NULL, tm)
		DEFAULT
			RESULT = select(0, NULL, NULL, fds, tm)
		SELEND
	FEND

	// return: 0:processing  SOCKET_ERROR:error  other:connect
	FUNCTION ConnectB(s, port, addr, c=WAIT_NUM, t=WAIT_UNIT)
		RESULT = ConnectN(s, port, addr, t)
		WHILE RESULT = 0 AND c > 0
			RESULT = IsOK(s, t)
			c = c - 1
		WEND
	FEND
	FUNCTION IsOK(s, t=WAIT_UNIT)
		RESULT = Check(s, 2, t)
		IF RESULT = 0 THEN RESULT = Check(s, 3, t)
		RESULT = (RESULT = 0)
	FEND
	FUNCTION ConnectN(s, port, addr, t=WAIT_UNIT)
		DIM argp = 1
		RESULT = ioctlsocket(s, FIONBIO, argp)
		IFB RESULT = 0 THEN
			DIM tar = ConvFromPort(port, addr)
			RESULT = connect(s, tar, SOCKADDR_LENGTH)	// 本当はWSAGetLastErrorを確認すべき
			RESULT = IsOK(s, t)
			IFB RESULT <> SOCKET_ERROR THEN
				IF LENGTH(_socks[s]) THEN _socks[s] = _socks[s] + ","
				_socks[s] = _socks[s] + "C:" + port + ":" + addr
			ENDIF
		ENDIF
	FEND

	// return: 0:can't send  SOCKET_ERROR:error  other:sent
	FUNCTION SendBString(s, msg, size=-1, c=WAIT_NUM, t=WAIT_UNIT)
		DIM to = VARTYPE(VAR_USTR, VAR_INTEGER)
		RESULT = SendB(s, to, 4)
		IF size = -1 THEN size = LENGTHB(msg)
		to = VARTYPE(size, VAR_INTEGER)
		IF RESULT <> SOCKET_ERROR THEN RESULT = SendB(s, to, 4)
		IF RESULT <> SOCKET_ERROR THEN RESULT = SendB(s, msg, to)
	FEND
	FUNCTION SendBFile(s, path, size=FILE_BUF_SIZE, port=0, addr=0, t=WAIT_UNIT)
		DIM handle=INVALID_HANDLE_VALUE, ptr = 0, readsize = 0
		DIM fileSize=INVALID_HANDLE_VALUE, fileSizeHigh=INVALID_HANDLE_VALUE
		handle = CreateFileW(path, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, 0, NULL)
		RESULT = SOCKET_ERROR
		IF handle <> INVALID_HANDLE_VALUE THEN fileSize = GetFileSize(handle, fileSizeHigh)
		IFB fileSize <> INVALID_HANDLE_VALUE AND fileSizeHigh = 0 THEN
			IF size > fileSize THEN size = fileSize
			ptr = Alloc(size)
		ENDIF
		// ファイル情報送る
		DIM fileName, fileNameB = path, tosize
		IFB ptr <> 0 THEN
			tosize = VARTYPE(VAR_EMPTY, VAR_INTEGER)
			RESULT = SendB(s, tosize, 4)	// 厳密にはバイトオーダーを修正するのが正しい
		ENDIF
		IFB RESULT <> SOCKET_ERROR THEN
			WHILE LENGTH(fileNameB)
				fileName = TOKEN("\/", fileNameB)
			WEND
			tosize = VARTYPE(LENGTHB(fileName), VAR_INTEGER)
			RESULT = SendB(s, tosize, 4)
		ENDIF
		IF RESULT <> SOCKET_ERROR THEN RESULT = SendB(s, fileName)
		IFB RESULT <> SOCKET_ERROR THEN
			tosize = VARTYPE(fileSize, VAR_INTEGER)
			RESULT = SendB(s, tosize, 4)
		ENDIF
		// 本体送る
		WHILE fileSize > 0 AND RESULT <> SOCKET_ERROR
			IFB ReadFile(handle, ptr, size, readsize, NULL) THEN
				IFB readsize = 0 THEN
					RESULT = SOCKET_ERROR
				ELSE
					RESULT = SendB(s, ptr, readsize)
				ENDIF
				fileSize = fileSize - readsize
			ELSE
				RESULT = SOCKET_ERROR
			ENDIF
		WEND

		IF ptr <> 0 THEN Free(ptr)
		IF handle <> INVALID_HANDLE_VALUE THEN CloseHandle(handle)
	FEND
	FUNCTION SendB(s, msg, size=-1, c=WAIT_NUM, t=WAIT_UNIT)
		RESULT = 0
		IF size = -1 THEN size = LENGTHB(msg)
		IF size = 0 THEN RESULT = SOCKET_ERROR
		WHILE RESULT = 0 AND c > 0
			RESULT = SendN(s, msg, size, 0, 0, t)
			c = c - 1
		WEND
	FEND
	FUNCTION SendN(s, msg, size=-1, port=0, addr=0, t=WAIT_UNIT)
		RESULT = Check(s, 2, t)
		IF size = -1 THEN size = LENGTHB(msg)
		IF size = 0 THEN RESULT = 0
		IFB RESULT <> SOCKET_ERROR AND RESULT <> 0 THEN
			DIM tar = ConvFromPort(port, addr)
			ChangeMode(VARTYPE(msg))
			RESULT = sendto(s, msg, size, 0, tar, SOCKADDR_LENGTH)
		ENDIF
	FEND

	// return: 0:no data  SOCKET_ERROR:error  other:recv
	FUNCTION RecvBData(s, size=FILE_BUF_SIZE, path=NULL, create=CREATE_NEW, c=WAIT_NUM, t=WAIT_UNIT)
		DIM vt = VARTYPE(0, VAR_INTEGER), ptr = 0
		DIM fromsize = VARTYPE(0, VAR_INTEGER), name = "", handle = INVALID_HANDLE_VALUE
		RESULT = RecvB(s, vt, 4, c, t)
		IF RESULT = SOCKET_ERROR THEN vt = -1

		SELECT vt
		CASE VAR_USTR
			RESULT = RecvB(s, fromsize, 4, c, t)
			IF RESULT <> SOCKET_ERROR AND fromsize > 0 THEN RESULT = RecvB(s, name, fromsize, c, t)
			IF RESULT <> SOCKET_ERROR THEN RESULT = COPY(name, 1, RESULT)
		CASE VAR_EMPTY
			// ファイル名サイズ取得
			DIM writesize
			RESULT = RecvB(s, fromsize, 4, c, t)
			// ファイル名取得
			IF RESULT <> SOCKET_ERROR AND fromsize > 0 THEN RESULT = RecvB(s, name, fromsize, c, t)
			// ファイルサイズ取得
			IFB RESULT <> SOCKET_ERROR AND LENGTH(name) > 0 THEN
				fromsize = VARTYPE(0, VAR_INTEGER)
				RESULT = RecvB(s, fromsize, 4, c, t)
			ENDIF
			// ファイル取得
			IFB RESULT <> SOCKET_ERROR AND fromsize > 0
				IF path = NULL THEN path = name
				IF COPY(path, LENGTH(path), 1) = "\" THEN path = path + name
				handle = CreateFileW(path, GENERIC_WRITE, 0, NULL, create, 0, NULL)
				ptr = Alloc(size)
			ENDIF
			WHILE RESULT <> SOCKET_ERROR AND handle <> INVALID_HANDLE_VALUE AND ptr <> 0 AND fromsize > 0
				RESULT = RecvB(s, ptr, size, c, t)
				IFB RESULT <> SOCKET_ERROR THEN
					IFB WriteFile(handle, ptr, RESULT, writesize, 0) THEN
						IF writesize = 0 THEN RESULT = SOCKET_ERROR
						fromsize = fromsize - writesize
					ELSE
						RESULT = SOCKET_ERROR
					ENDIF
				ENDIF
			WEND

			IF RESULT <> SOCKET_ERROR THEN RESULT = path
			IF ptr <> 0 THEN Free(ptr)
			IF handle <> INVALID_HANDLE_VALUE THEN CloseHandle(handle)
		SELEND
	FEND
	FUNCTION RecvB(s, var ptr, size=1024, c=WAIT_NUM, t=WAIT_UNIT)
		RESULT = 0
		DIM port, addr
		WHILE RESULT = 0 AND c > 0
			RESULT = RecvN(s, port, addr, ptr, size, t)
			c = c - 1
		WEND
		IF RESULT = 0 THEN RESULT = SOCKET_ERROR
	FEND
	FUNCTION RecvN(s, var port, var addr, var ptr, size=1024, t=WAIT_UNIT)
		RESULT = Check(s, 1, t)
		IFB RESULT <> SOCKET_ERROR AND RESULT <> 0 THEN
			DIM tar = ConvFromPort(0, 0), len = SOCKADDR_LENGTH
			SELECT VARTYPE(ptr)
			CASE VAR_DWORD
				IF ptr <= 0 THEN ptr = Alloc(size)
			CASE VAR_INTEGER
				size = 4
			DEFAULT
				ptr = FORMAT(CHR(0), size)
			SELEND
			ChangeMode(VARTYPE(ptr))
			RESULT = recvfrom(s, ptr, size, 0, tar, len)
			IFB RESULT <> SOCKET_ERROR THEN
				IF VARTYPE(ptr) = VAR_USTR THEN ptr = COPYB(ptr, 1, RESULT)
				ConvToPort(tar, len, port, addr)
			ENDIF
		ENDIF
	FEND

	PROCEDURE ChangeMode(mode)
		IFB _mode <> mode THEN
			SELECT mode
			CASE VAR_DWORD
				DEF_DLL sendto(int, DWORD, int, int, DWORD[], int): int: ws2_32
				DEF_DLL recvfrom(int, DWORD, int, int, var DWORD[], var int): int: ws2_32
			CASE VAR_INTEGER
				DEF_DLL sendto(int, var DWORD, int, int, DWORD[], int): int: ws2_32
				DEF_DLL recvfrom(int, var DWORD, int, int, var DWORD[], var int): int: ws2_32
			CASE VAR_USTR
				DEF_DLL sendto(int, string, int, int, DWORD[], int): int: ws2_32
				DEF_DLL recvfrom(int, var string, int, int, var DWORD[], var int): int: ws2_32
			SELEND
			_mode = mode
		ENDIF
	FEND

	FUNCTION Alloc(size, at=MEM_COMMIT, pro=PAGE_READWRITE)
		RESULT = VARTYPE(VirtualAlloc(0, size, at, pro), VAR_DWORD)
		_allocs[RESULT] = 1
	FEND
	FUNCTION Free(ptr, at=MEM_RELEASE)
		RESULT = VirtualFree(ptr, 0, at)
		DIM res
		IF _allocs[ptr, HASH_EXISTS] THEN res = _allocs[ptr, HASH_REMOVE]
	FEND

ENDMODULE

IF文で切ってあるサンプルスクリプトに、ファイル送受信機能を持たせました。
以下の手順で確認できます。

1. Server側：スクリプトを実行し、「server?」に「はい」
2. Server側：「接続」ボタンを押し、待ち受けポート（他で使ってないポート）と待ち受けアドレス（「0.0.0.0」だと全て）を設定する。接続待ちに入る（SLCTBOXが消えたままになる）
3. Client側：スクリプトを実行し、「server?」に「いいえ」
4. Client側：「接続」ボタンを押し、接続先ポート（Serverで決めたポート）とサーバーのアドレスを設定する。接続処理に入り、接続するとSLCTBOXが表示される（Server側も表示される）
5. 送信側：「送信」ボタンを押し、パスを入力する（ファイルが存在しないと、その文字列が送られる）。大きいファイルの場合、バッファに書き込みきれないため、SLCTBOXが消えたままになる
6. 受信側：「受信」ボタンを押す。ファイルを受信した場合、カレントフォルダーに書き込まれる
7. 終了時：「切断」ボタンまたは「×」ボタンを押す。双方行う

送信したファイル名でカレントフォルダーに受信するようにしていますが、RecvBDataの第三引数に

• フルパスを指定すると、そのファイル名で保存
• 末尾「\」のパスを指定すると、送信したファイル名で指定フォルダーに保存

します。
RecvBDataの第二引数は、作業メモリーサイズ。メモリーが潤沢な環境では、大きくしても良いかも。4KB単位で指定するのがおすすめ。