100 data "FF:FF:FF:FF:FF:FF"
110 data "192.168.1.28"
120 data "255.255.255.0"
130 data "192.168.1.1"
140 data "192.168.1.1"
999 '
10000 *MAIN
10005 on error goto *ER
10010 dim HEAD$(15),SEQ(3):init "EMM:"
10020 read MYMAC$,MYIP$,MYMASK$,MYGW$,MYDNS$
10030 gosub *INITLAN:MYPORT=4999
10035 *MAIN1
10040 DISTIP$="192.168.1.82":HOST$=DISTIP$
10050 MYPORT=MYPORT+1
10060 CH=0:PORT=MYPORT:PROTO=1:gosub *INITSOCK 'SOCK_STREAM(TCP)
10069 '
10070 line input "COMMAND>";CMD$
10080 for I=1 to len(CMD$):if mid$(CMD$,I,1)=" " then 10110
10090 if asc(mid$(CMD$,I,1))>&H60 and asc(mid$(CMD$,I,1))<&H7E then mid$(CMD$,I,1)=chr$(asc(mid$(CMD$,I,1))-&H20)
10100 next
10110 if left$(CMD$,3)<>"DIR" and left$(CMD$,3)<>"GET" and left$(CMD$,3)<>"PUT" then 10070
10120 kill "EMM:HEADER":kill "EMM:BODY"
10129 '
10130 CH=0:LOOP=0:PORT=80
10140 DATA$=DISTIP$:gosub *SETDISTIP
10150 NUM=PORT :gosub *SETDISTPT
10160 out &H61,0:out &H62,CH:out &H63,4 'Connect
10170 out &H61,0:out &H62,&HA0+CH*24:NUM=inp(&H63):if NUM=0 then print "切断されました(10170)":goto *MAIN1
10180 if NUM=6 then 10210
10190 LOOP=LOOP+1:if LOOP>199 then 10130 else 10170
10200 'print "接続エラー:";right$("0000000"+bin$(NUM),8):goto *QUIT1
10209 '
10210 if instr(5,CMD$," ")<>0 then
10220 PATH$=mid$(CMD$,5,instr(5,CMD$," ")-5):DIST$=mid$(CMD$,instr(5,CMD$," ")+1)
10230 else
10240 PATH$=mid$(CMD$,5):DIST$=""
10250 end if
10260 if left$(CMD$,3)="PUT" then swap PATH$,DIST$
10270 gosub *REQUEST
10319 '
10320 NAM$="HEADER":BYTE=0:gosub *RECEIVE
10330 open "I",#1,"EMM:HEADER"
10340 while eof(1)=0
10350 line input #1,H$
10360 if instr(H$,"Content-Length:")<>0 then BYTE=val(mid$(H$,16)):goto 10380
10370 wend
10380 close #1
10389 '
10390 NAM$="BODY":gosub *RECEIVE:gosub *QUIT1
10400 if left$(CMD$,3)="GET" then
10410 open "I",#1,"EMM:BODY":open "O",#2,DIST$
10420 while eof(1)=0
10430 print #2,input$(1,#1);
10440 wend
10450 close:print:goto *MAIN1
10460 end if
10499 '
10500 if left$(CMD$,3)="PUT" then *MAIN1
10599 '
10600 open "I",#1,"EMM:BODY":CFLAG=0:print "Directory of ";PATH$;":"
10610 while eof(1)=0
10620 H$=input$(1,#1)
10630 if H$=chr$(&HA) then 10790
10640 if H$=chr$(&HD) or H$=chr$(9) or H$=" " then if pos(0)=0 then 10790 else H$=" "
10650 if H$="<" then TAG$=input$(1,#1):CFLAG=1:goto 10660
10655 'print H$;
10658 goto 10790
10660 H$=input$(1,#1)
10670 if H$<>" " and H$<>">" then TAG$=TAG$+H$:goto 10660
10680 if left$(TAG$,1)="/" and right$(TAG$,8)="response" then locate 0:print ATNAME$;:locate 39:print ATSIZ$;:locate 49:print ATDATE$
10690 if left$(TAG$,1)<>"/" and right$(TAG$,11)="displayname" then H$=input$(1,#1):ATNAME$="":while H$<>"<":ATNAME$=ATNAME$+H$:H$=input$(1,#1):wend
10700 if left$(TAG$,1)<>"/" and right$(TAG$,16)="getcontentlength" then ATSIZ$="":while H$<>">":H$=input$(1,#1):wend:H$=input$(1,#1):while H$<>"<":ATSIZ$=ATSIZ$+H$:H$=input$(1,#1):wend
10710 if left$(TAG$,1)<>"/" and right$(TAG$,15)="getlastmodified" then ATDATE$="":while H$<>">":H$=input$(1,#1):wend:H$=input$(1,#1):while H$<>"<":ATDATE$=ATDATE$+H$:H$=input$(1,#1):wend
10730 if H$=">" then CFLAG=0:goto 10790
10740 while CFLAG>0
10750 H$=input$(1,#1)
10760 if H$=">" then CFLAG=CFLAG-1
10770 if H$="<" then CFLAG=CFLAG+1
10780 wend
10790 wend
10800 close #1:print
10989 '
10990 goto *MAIN1
10999 '
11000 *ER
11010 if err=63 and (erl<10800 and erl>10600) then resume 10800
11020 if err=40 and erl=10120 then resume 10130
11030 print "*ERROR";err;"in";erl:stop
29997 '
29998 ' アプリケーション固有のサブルーチン
29999 '
30000 *INITLAN
30010 out &H60,&H81 'Indirect/Increment mode
30020 DATA$=MYMAC$ :gosub *SETMAC
30030 DATA$=MYIP$ :gosub *SETMYIP
30040 DATA$=MYMASK$:gosub *SETMASK
30050 DATA$=MYGW$ :gosub *SETGWIP
30060 out &H61,0:out &H62,0:out &H63,1 'Init
30070 out &H61,0:out &H62,&H95:out &H63,3:out &H63,3 'Buf size
30080 out &H60,&H80 'Indirect/Non-Increment mode
30090 out &H61,0:out &H62,4:NUM=0
30100 while NUM=0:NUM=inp(&H63):wend
30110 if NUM<>1 then print "W3100A 初期化エラー:";right$("0000000"+bin$(NUM),8):end
30114 out &H61,0:out &H62,0:out &H63,1 'Init
30115 out &H61,0:out &H62,4:NUM=0
30117 while NUM=0:NUM=inp(&H63):wend
30120 out &H60,&H81 'Indirect/Increment mode
30129 '
30130 restore *HEADER
30140 for I=0 to 15
30150 read HEAD$(I):HEAD$(I)=HEAD$(I)+hexchr$("0D0A")
30155 J=1:while (mid$(HEAD$(I),J,1)<>chr$(&HD)):if mid$(HEAD$(I),J,1)="%" then mid$(HEAD$(I),J,1)=chr$(&H22)
30158 J=J+1:wend
30160 next
30170 HEAD$(7)=hexchr$("0D0A") 'ヘッダ終端の空行
30180 return
30199 '
30200 *HEADER
30210 data "GET / HTTP/1.0"
30220 data "Host:"
30225 data "Depth: 1"
30230 data "User-Agent: Brown/0.10 (MZ-2500 BASIC-M25)"
30240 data "Accept-Charset: Shift_JIS"
30250 data "Content-Type: text/xml"
30260 data "Content-Length: 150"
30265 data ""
30270 data ""
30280 data ""
30290 data " "
30300 data " "
30310 data " "
30320 data " "
30330 data " "
30340 data ""
30399 '
30400 *REQUEST
30410 if left$(CMD$,3)="DIR" then HEAD$(0)="PROPFIND "+PATH$+" HTTP/1.0"+hexchr$("0D0A"):HEAD$(6)="Content-Length: 150"+hexchr$("0D0A")
30420 if left$(CMD$,3)="GET" then HEAD$(0)="GET "+PATH$+" HTTP/1.0"+hexchr$("0D0A")
30430 if left$(CMD$,3)="PUT" then
30440 HEAD$(0)="PUT "+PATH$+" HTTP/1.0"+hexchr$("0D0A")
30450 for I=16 to 23
30460 P$=pwd$:devi$ P$,I,A$,B$
30470 if instr(A$,DIST$)<>0 then BYTE=cvi(mid$(A$,instr(A$,DIST$)+19,2)):goto 30500
30480 if instr(B$,DIST$)<>0 then BYTE=cvi(mid$(B$,instr(B$,DIST$)+19,2)):goto 30500
30490 next
30500 HEAD$(6)="Content-Length:"+str$(BYTE)+hexchr$("0D0A")
30510 end if
30520 HEAD$(1)="Host: "+HOST$+hexchr$("0D0A")
30530 CH=0:gosub *GETTXWR:gosub *GETTXAK
30540 SIZE=8192-(TXWR#-TXAK#)
30550 ADDR=&H4000+TXWR#-int(TXWR#/8192)*8192:GLEN=0
30560 for I=0 to 15
30570 if I=6 and left$(CMD$,3)="GET" then 30680
30580 DLEN=len(HEAD$(I))
30590 if DLEN+ADDR>&H5FFF then
30600 BUF$=HEAD$(I):NUM=&H6000-ADDR:DATA$=left$(BUF$,NUM):gosub *ADSET
30610 GLEN=GLEN+NUM
30620 ADDR=&H4000:DATA$=mid$(BUF$,NUM+1):DLEN=DLEN-NUM:gosub *ADSET
30630 else
30640 DATA$=HEAD$(I):gosub *ADSET
30650 end if
30660 ADDR=ADDR+DLEN:GLEN=GLEN+DLEN
30670 if I=7 and left$(CMD$,3)<>"DIR" then 30690
30680 next
30690 TXWR#=TXWR#+GLEN
30700 out &H61,0:out &H62,&H40+CH*12 'Cx_TW_PR
30710 NUM=int(TXWR#/16777216):TXWR#=TXWR#-NUM*16777216:NUM=NUM mod 256:out &H63,NUM
30720 NUM=int(TXWR#/65536):TXWR#=TXWR#-NUM*65536:out &H63,NUM
30730 NUM=int(TXWR#/256):TXWR#=TXWR#-NUM*256:out &H63,NUM
30740 out &H63,TXWR#
30750 out &H61,0:out &H62,CH:out &H63,&H60 'Send
30759 '
30760 if left$(CMD$,3)<>"PUT" then return
30840 open "I",#1,DIST$
30850 CH=0:gosub *GETTXWR:gosub *GETTXAK
30860 SIZE=8192-(TXWR#-TXAK#)
30863 if BYTE<1600 and SIZE&H5FFF then ADDR=&H4000
30910 next
30920 TXWR#=TXWR#+GLEN
30930 out &H61,0:out &H62,&H40+CH*12 'Cx_TW_PR
30940 NUM=int(TXWR#/16777216):TXWR#=TXWR#-NUM*16777216:NUM=NUM mod 256:out &H63,NUM
30950 NUM=int(TXWR#/65536):TXWR#=TXWR#-NUM*65536:out &H63,NUM
30960 NUM=int(TXWR#/256):TXWR#=TXWR#-NUM*256:out &H63,NUM
30970 out &H63,TXWR#
30980 out &H61,0:out &H62,CH:out &H63,&H60 'Send
30983 BYTE=BYTE-GLEN:if BYTE>0 then 30850
30985 close #1
30990 return
30999 '
31000 *INITSOCK
31010 NUM=PORT:gosub *SETMYPT
31020 out &H61,0:out &H62,&HA1+CH*24:out &H63,PROTO
31030 out &H61,0:out &H62,CH:out &H63,2 'Sock_Init
31040 out &H60,&H80 'Indirect/Non-Increment mode
31050 out &H61,0:out &H62,4+CH:NUM=0
31060 while NUM=0:NUM=inp(&H63):wend
31070 if (NUM and 2)<>2 then print "ソケット初期化エラー:";right$("0000000"+bin$(NUM),8):end
31079 '
31080 out &H60,&H81 'Indirect/Increment mode
31090 for I=0 to 3:SEQ(I)=int(rnd(5)*256):next
31110 out &H61,0:out &H62,&H40+CH*12 'Cx_TW_PR
31120 for I=0 to 3:out &H63,SEQ(I):next
31130 out &H61,0:out &H62,&H44+CH*12 'Cx_TR_PR
31140 for I=0 to 3:out &H63,SEQ(I):next
31150 out &H61,0:out &H62,&H18+CH*12 'Cx_TA_PR
31160 for I=0 to 3:out &H63,SEQ(I):next
31180 return
31499 '
32499 '
32500 *RECEIVE
32510 open "O",#1,"EMM:"+NAM$:TOTAL=0:OBYTE=BYTE
32520 CH=0:LOOP=0:SIZE=0:P=0
32530 if LOOP>199 then *QUIT
32540 gosub *GETRXWR:gosub *GETRXRD
32550 SIZE=RXWR#-RXRD#
32555 if BYTE<>0 and RXWR#=0 then SIZE=BYTE
32558 if SIZE>1600 then SIZE=1600
32560 if SIZE>0 then 32590
32570 out &H61,0:out &H62,&HA0+CH*24:if inp(&H63)=0 then *QUIT
32580 LOOP=LOOP+1:goto 32530
32590 ADDR=&H6000+RXRD#-int(RXRD#/8192)*8192
32595 if BYTE<>0 then print TOTAL;"/";OBYTE;"(bytes)";:locate 0:TOTAL=TOTAL+SIZE
32600 out &H60,&H80:out &H61,int(ADDR/256):out &H62,ADDR and 255
32610 M=inp(&H63):out &H60,&H81:RSIZ=SIZE
32620 while RSIZ>0
32630 M=inp(&H63)
32640 if M=&HD then 32670
32650 if M=&HA then M=&HD:P=P+1 else P=0
32660 print #1,chr$(M);
32665 ' if BYTE<>0 then print TOTAL;"/";BYTE;"(bytes)";:locate 0:TOTAL=TOTAL+1
32670 RSIZ=RSIZ-1
32680 if BYTE=0 and P=2 then P=10:goto 32820
32690 ADDR=ADDR+1:if ADDR=32768 then out &H60,&H80:out &H61,&H60:out &H62,0:M=inp(&H63):out &H60,&H81:ADDR=&H6000
32700 wend
32820 RXRD#=RXRD#+SIZE-RSIZ
32830 out &H61,0:out &H62,&H14+CH*12 'Cx_RR_PR
32840 NUM=int(RXRD#/16777216):RXRD#=RXRD#-NUM*16777216:NUM=NUM mod 256:out &H63,NUM
32850 NUM=int(RXRD#/65536):RXRD#=RXRD#-NUM*65536:out &H63,NUM
32860 NUM=int(RXRD#/256):RXRD#=RXRD#-NUM*256:out &H63,NUM
32870 out &H63,RXRD#
32880 out &H61,0:out &H62,CH:out &H63,&H40 'Next receive
32890 if BYTE<>0 then BYTE=BYTE-SIZE+RSIZ
32895 if BYTE<>0 then goto 32520
32899 '
32900 *QUIT
32905 if P<>10 and OBYTE<>0 then print TOTAL;"/";OBYTE;"(bytes)"
32910 close #1:return
32920 *QUIT1
32930 out &H61,0:out &H62,CH:out &H63,&H10 'Close
32940 out &H61,0:out &H62,4+CH:NUM=inp(&H63)
32950 if (NUM and 8)<>8 then 32940
32960 return
39997 '
39998 ' TCP/IP サービスルーチン
39999 '
40000 *SETMAC 'MAC アドレスの設定
40010 DA$=""
40020 for COUNT=1 to 17 step 3
40030 DA$=DA$+mid$(DATA$,COUNT,2)
40040 next
40050 ADDR=&H88:DATA$=hexchr$(DA$):NUM=6:gosub *ADNSET
40060 return
40099 '
40100 *SETMYIP '自アドレスの設定
40110 gosub *HEXIP
40120 ADDR=&H8E:DATA$=DA$:NUM=4:gosub *ADNSET
40130 return
40149 '
40150 *SETMYPT '自ポートの設定
40160 out &H61,0:out &H62,&HAE+CH*24
40170 out &H63,int(NUM/256):out &H63,NUM and 255
40180 return
40199 '
40200 *SETMASK 'ネットマスクの設定
40210 gosub *HEXIP
40220 ADDR=&H84:DATA$=DA$:NUM=4:gosub *ADNSET
40230 return
40299 '
40300 *SETGWIP 'ゲートウェイアドレスの設定
40310 gosub *HEXIP
40320 ADDR=&H80:DATA$=DA$:NUM=4:gosub *ADNSET
40330 return
40399 '
40400 *HEXIP 'IP アドレスの一般的な表記を文字コード列に変換
40410 DA$="":DATA$=DATA$+"."
40420 DOT=instr(DATA$,".")
40430 for COUNT=1 to 4
40435 if DOT=0 then DA$=DA$+chr$(0):goto 40470
40440 DA$=DA$+chr$(val(left$(DATA$,DOT-1)))
40450 DATA$=mid$(DATA$,DOT+1)
40460 DOT=instr(DATA$,".")
40470 next
40480 DATA$=DA$
40490 return
40499 '
40500 *SETDISTIP '相手アドレスの設定
40510 if len(DATA$)<>4 gosub *HEXIP:DATA$=DA$
40520 ADDR=&HA8+CH*24:NUM=4:gosub *ADNSET
40530 return
40549 '
40550 *SETDISTPT '相手ポートの設定
40560 out &H61,0:out &H62,&HAC+CH*24
40570 out &H63,int(NUM/256):out &H63,NUM and 255
40580 return
40599 '
40600 *URLCONV
40610 if left$(URL$,7)="http://" then HOST$=mid$(URL$,8) else HOST$=URL$
40620 NUM=instr(HOST$,"/")
40630 if NUM=0 or NUM=len(HOST$) then PATH$="/":return
40640 PATH$=mid$(HOST$,NUM):HOST$=left$(HOST$,NUM-1)
40650 NUM=instr(HOST$,":")
40660 if NUM=0 then
40670 PORT=80
40680 else
40690 PORT=val(mid$(HOST$,NUM+1))
40700 ' HOST$=left$(HOST$,NUM-1)
40710 end if
40720 return
40799 '
49997 '
49998 ' W3100A アクセスルーチン
49999 '
50000 *ADNSET 'アドレス・データ数指定書き込み
50010 out &H61,int(ADDR/256):out &H62,ADDR and 255
50020 for COUNT=1 to NUM
50030 out &H63,asc(mid$(DATA$,COUNT,1))
50040 next
50050 return
50099 '
50100 *DNSET 'アドレス継続・データ数指定書き込み
50110 for COUNT=1 to NUM
50120 out &H63,asc(mid$(DATA$,COUNT,1))
50130 next
50140 return
50199 '
50200 *DSET 'アドレス継続・文字列の長さだけ書き込み
50210 for COUNT=1 to len(DATA$)
50220 out &H63,asc(mid$(DATA$,COUNT,1))
50230 next
50240 return
50249 '
50250 *ADSET 'アドレス指定・文字列の長さだけ書き込み
50260 out &H61,int(ADDR/256):out &H62,ADDR and 255
50270 for COUNT=1 to len(DATA$)
50280 out &H63,asc(mid$(DATA$,COUNT,1))
50290 next:return
50299 '
50300 *GETTXWR '送信側書き込みポインタ取得
50310 out &H61,1:out &H62,&HF0+CH*3:NUM=inp(&H63) 'Cx_STW_PR
50320 out &H61,0:out &H62,&H40+CH*12 'Cx_TW_PR
50330 TXWR#=inp(&H63)*16777216#
50340 TXWR#=TXWR#+inp(&H63)*65536#
50350 TXWR#=TXWR#+inp(&H63)*256#
50360 TXWR#=TXWR#+inp(&H63)
50370 return
50399 '
50400 *GETTXAK '送信側送信ポインタ取得
50410 out &H61,1:out &H62,&HE2+CH*3:NUM=inp(&H63) 'Cx_STA_PR
50420 out &H61,0:out &H62,&H18+CH*12 'Cx_TA_PR
50430 TXAK#=inp(&H63)*16777216#
50440 TXAK#=TXAK#+inp(&H63)*65536#
50450 TXAK#=TXAK#+inp(&H63)*256#
50460 TXAK#=TXAK#+inp(&H63)
50470 return
50499 '
50500 *GETRXWR '受信側受信ポインタ取得
50510 out &H61,1:out &H62,&HE0+CH*3:NUM=inp(&H63) 'Cx_SRW_PR
50520 out &H61,0:out &H62,&H10+CH*12 'Cx_RW_PR
50530 RXWR#=inp(&H63)*16777216#
50540 RXWR#=RXWR#+inp(&H63)*65536#
50550 RXWR#=RXWR#+inp(&H63)*256#
50560 RXWR#=RXWR#+inp(&H63)
50570 return
50599 '
50600 *GETRXRD '受信側読み出しポインタ取得
50610 out &H61,1:out &H62,&HE1+CH*3:NUM=inp(&H63) 'Cx_SRR_PR
50620 out &H61,0:out &H62,&H14+CH*12 'Cx_RR_PR
50630 RXRD#=inp(&H63)*16777216#
50640 RXRD#=RXRD#+inp(&H63)*65536#
50650 RXRD#=RXRD#+inp(&H63)*256#
50660 RXRD#=RXRD#+inp(&H63)
50670 return
50699 '
50700 *GETTXRD '送信側送信ポインタ取得(UDP)
50710 out &H61,1:out &H62,&HF1+CH*3:NUM=inp(&H63) 'Cx_STR_PR
50720 out &H61,0:out &H62,&H44+CH*12 'Cx_TR_PR
50730 TXRD#=inp(&H63)*16777216#
50740 TXRD#=TXRD#+inp(&H63)*65536#
50750 TXRD#=TXRD#+inp(&H63)*256#
50760 TXRD#=TXRD#+inp(&H63)
50770 return