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$(4),SEQ(3),ANS$(520):init "EMM:"
10020 read MYMAC$,MYIP$,MYMASK$,MYGW$,MYDNS$
10030 gosub *INITLAN:MYPORT=4999
10035 *MAIN1
10040 CH=1:PORT=6000:PROTO=2:gosub *INITSOCK   'SOCK_DGRAM(UDP)
10050 MYPORT=MYPORT+1
10060 CH=0:PORT=MYPORT:PROTO=1:gosub *INITSOCK   'SOCK_STREAM(TCP)
10069 '
10070 'URL$="http://192.168.1.82/index.html"
10080 'URL$="www.retropc.net/ohishi/index.html"
10090 input "URL:";URL$:init "EMM:"
10100 gosub *URLCONV
10110 gosub *RESRVIP:DISTIP$=IP$
10120 if len(DISTIP$)=4 then print asc(left$(DISTIP$,1));".";asc(mid$(DISTIP$,2,1));".";asc(mid$(DISTIP$,3,1));".";asc(right$(DISTIP$,1)) else print DISTIP$
10129 '
10130 CH=0:LOOP=0
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 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
10499 '
10600 open "I",#1,"EMM:BODY":CFLAG=0:KJIN=0:print
10610 while eof(1)=0
10620   H$=input$(1,#1)
10630   if H$=chr$(&HA) then 10790
10635   if H$=chr$(&H1B) then H$=input$(2,#1):if mid$(H$,2,1)="B" then KJIN=KJIN-(left$(H$,1)="$")+(left$(H$,1)="("):goto 10790
10640   if H$=chr$(&HD) or H$=chr$(9) or H$=" " then if pos(0)=0 then 10790 else H$=" "
10650   if KJIN=0 and H$="<" then TAG$=input$(1,#1):CFLAG=1:goto 10660
10655   if KJIN>0 then H$=H$+input$(1,#1):print chr$(val("&J"+ascchr$(H$))); else print H$;
10658   goto 10790
10660   H$=input$(1,#1)
10670   if H$<>" " and H$<>">" then TAG$=TAG$+H$:goto 10660
10680   for I=1 to len(TAG$)
10690     if asc(mid$(TAG$,I,1))>&H60 and asc(mid$(TAG$,I,1))<&H7E then mid$(TAG$,I,1)=chr$(asc(mid$(TAG$,I,1))-&H20)
10700   next
10710   if TAG$="LI" or TAG$="/UL" or TAG$="BR" or TAG$="/BLOCKQUOTE" or TAG$="/P" or TAG$="/TITLE" then print:goto 10730
10720   if TAG$="HR" then if pos(0)=0 then print " ";string$(78,"-") else print:print " ";string$(78,"-")
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 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,10:out &H63,10 '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 3
30150   read HEAD$(I):HEAD$(I)=HEAD$(I)+hexchr$("0D0A")
30160 next
30170 HEAD$(4)=hexchr$("0D0A")  'ヘッダ終端の空行
30180 return
30199 '
30200 *HEADER
30210 data "GET / HTTP/1.0"
30220 data "Host:"
30230 data "User-Agent: Brown/0.10 (MZ-2500 BASIC-M25)"
30240 data "Accept-Charset: Shift_JIS"
30399 '
30400 *REQUEST
30410 HEAD$(0)="GET "+PATH$+" HTTP/1.0"+hexchr$("0D0A")
30420 HEAD$(1)="Host: "+HOST$+hexchr$("0D0A")
30430 CH=0:gosub *GETTXWR:gosub *GETTXAK
30440 SIZE=4096-(TXWR#-TXAK#)
30450 ADDR=&H4000+TXWR#-int(TXWR#/4096)*4096:GLEN=0
30460 for I=0 to 4
30470   DLEN=len(HEAD$(I))
30480   if DLEN+ADDR>&H4FFF then
30490     BUF$=HEAD$(I):NUM=&H5000-ADDR:DATA$=left$(BUF$,NUM):gosub *ADSET
30500     GLEN=GLEN+NUM
30510     ADDR=&H4000:DATA$=mid$(BUF$,NUM+1):DLEN=DLEN-NUM:gosub *ADSET
30520   else
30530     DATA$=HEAD$(I):gosub *ADSET
30540   end if
30550   ADDR=ADDR+DLEN:GLEN=GLEN+DLEN
30560 next
30570 TXWR#=TXWR#+GLEN
30580 out &H61,0:out &H62,&H40+CH*12              'Cx_TW_PR
30590 NUM=int(TXWR#/16777216):TXWR#=TXWR#-NUM*16777216:NUM=NUM mod 256:out &H63,NUM
30600 NUM=int(TXWR#/65536):TXWR#=TXWR#-NUM*65536:out &H63,NUM
30610 NUM=int(TXWR#/256):TXWR#=TXWR#-NUM*256:out &H63,NUM
30620 out &H63,TXWR#
30630 out &H61,0:out &H62,CH:out &H63,&H60 'Send
30640 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 '
31500 *RESRVIP
31510 QUE$=HOST$:DATA$=QUE$:gosub *HEXIP
31520 if DATA$<>hexchr$("00000000") then IP$=HOST$:return
31530 QUE$="."+QUE$+".":NUM=2
31540 repeat
31550   DOT=instr(mid$(QUE$,NUM),".")
31560   mid$(QUE$,NUM-1,1)=chr$(DOT-1)
31570   NUM=NUM+DOT
31580 until len(QUE$)<=NUM
31590 QUE$=left$(QUE$,len(QUE$)-1)
31600 QUE$=hexchr$("000101000001000000000000")+QUE$+hexchr$("0000010001")
31605 CH=1:DATA$=MYDNS$:gosub *SETDISTIP
31606      NUM=53      :gosub *SETDISTPT
31610 gosub *GETTXWR:gosub *GETTXRD
31620 ADDR=&H5000+TXWR#-int(TXWR#/4096)*4096
31630   DLEN=len(QUE$)
31640   if DLEN+ADDR>&H5FFF then
31650     BUF$=QUE$:NUM=&H6000-ADDR:DATA$=left$(BUF$,NUM):gosub *ADSET
31670     ADDR=&H5000:DATA$=mid$(BUF$,NUM+1):gosub *ADSET
31680   else
31690     DATA$=QUE$:gosub *ADSET
31700   end if
31720 TXWR#=TXWR#+DLEN
31730 out &H61,0:out &H62,&H40+CH*12              'Cx_TW_PR
31740 NUM=int(TXWR#/16777216):TXWR#=TXWR#-NUM*16777216:NUM=NUM mod 256:out &H63,NUM
31750 NUM=int(TXWR#/65536):TXWR#=TXWR#-NUM*65536:out &H63,NUM
31760 NUM=int(TXWR#/256):TXWR#=TXWR#-NUM*256:out &H63,NUM
31770 out &H63,TXWR#
31780 out &H61,0:out &H62,CH:out &H63,&H60 'Send
31790 '
31800 LOOP=0
31810 if LOOP>199 then IP$="":return
31820 gosub *GETRXWR:gosub *GETRXRD
31830 SIZE=RXWR#-RXRD#
31840 if SIZE>0 then 31870
31850 out &H61,0:out &H62,&HA0+CH*24:if inp(&H63)=0 then IP$="":return
31860 LOOP=LOOP+1:goto 31810
31870 ADDR=&H7000+RXRD#-int(RXRD#/4096)*4096:NUM=0
31878 out &H60,&H80:out &H61,int(ADDR/256):out &H62,ADDR and 255
31880 M=inp(&H63):out &H60,&H81
31890 if SIZE+ADDR<32768 then
31900   for I=1 to SIZE:M=inp(&H63)
31930     ANS$(NUM)=chr$(M):NUM=NUM+1
31940   next
31950 else
31960   for I=1 to 32768-ADDR:M=inp(&H63)
31990     ANS$(NUM)=chr$(M):NUM=NUM+1
32000   next
32010   out &H60,&H80:out &H61,&H70:out &H62,0
32020   M=inp(&H63):out &H60,&H81
32030   for I=1 to SIZE-(32768-ADDR):M=inp(&H63)
32060     ANS$(NUM)=chr$(M):NUM=NUM+1
32070   next
32080 end if
32085 RXRD#=RXRD#+SIZE
32090 out &H61,0:out &H62,&H14+CH*12              'Cx_RR_PR
32100 NUM=int(RXRD#/16777216):RXRD#=RXRD#-NUM*16777216:NUM=NUM mod 256:out &H63,NUM
32110 NUM=int(RXRD#/65536):RXRD#=RXRD#-NUM*65536:out &H63,NUM
32120 NUM=int(RXRD#/256):RXRD#=RXRD#-NUM*256:out &H63,NUM
32130 out &H63,RXRD#
32139 '
32140 if ANS$(7)<>chr$(53) then 31800
32150 NUM=len(QUE$)+8:'NAM$=mid$(QUE$,13,len(QUE$)-16)
32160 'NMO$="":OFS=NUM
32170 'if asc(ANS$(OFS))>=&HC0 then OFS=asc(ANS$(OFS+1))+8:goto 32170
32180 'if ANS$(OFS)<>chr$(0) then NMO$=NMO$+ANS$(OFS):OFS=OFS+1:goto 32170
32190 'NMO$=NMO$+chr$(0)
32200 if asc(ANS$(NUM))>=&HC0 then NUM=NUM+1:goto 32220
32210 if ANS$(NUM)<>chr$(0) then NUM=NUM+1:goto 32200
32220 NUM=NUM+1
32230 if asc(ANS$(NUM))*256+asc(ANS$(NUM+1))<>1 then NUM=NUM+10+asc(ANS$(NUM+8))*256+asc(ANS$(NUM+9)):goto 32160
32240 'if NAM$<>NMO$ then NUM=NUM+10+asc(ANS$(NUM+8))*256+asc(ANS$(NUM+9)):print:goto 32160
32250 IP$=ANS$(NUM+10)+ANS$(NUM+11)+ANS$(NUM+12)+ANS$(NUM+13)
32260 return
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#/4096)*4096
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=&H7000 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: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