| [613] | 1 | XUSBSE2 ;FO-OAK/JLI-CONNECT WITH HTTP SERVER AND GET REPLY ;5/24/07 13:47
|
|---|
| 2 | ;;8.0;KERNEL;**404,439**;Jul 10, 1995;Build 12
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | POST(SERVER,PORT,PAGE,DATA) ;
|
|---|
| 6 | Q $$ENTRY(SERVER,$G(PORT),$G(PAGE),"POST",$G(DATA))
|
|---|
| 7 | ;
|
|---|
| 8 | GET(SERVER,PORT,PAGE) ;
|
|---|
| 9 | Q $$ENTRY(SERVER,$G(PORT),$G(PAGE),"GET")
|
|---|
| 10 | ;
|
|---|
| 11 | ENTRY(SERVER,PORT,PAGE,HTTPTYPE,DATA) ;
|
|---|
| 12 | N DONE,XVALUE,XWBICNT,XWBRBUF,XWBSBUF,XWBTDEV,XWBDEBUG,XWBOS,XWBT,XWBTIME,POP
|
|---|
| 13 | N $ESTACK,$ETRAP S $ETRAP="D TRAP^XUSBSE2"
|
|---|
| 14 | S PAGE=$G(PAGE,"/") I PAGE="" S PAGE="/"
|
|---|
| 15 | S HTTPTYPE=$G(HTTPTYPE,"GET")
|
|---|
| 16 | S DATA=$G(DATA),PORT=$G(PORT,80)
|
|---|
| 17 | D SAVDEV^%ZISUTL("XUSBSE") ;S IO(0)=$P
|
|---|
| 18 | D INIT^XWBTCPM
|
|---|
| 19 | D OPEN^XWBTCPM2(SERVER,PORT)
|
|---|
| 20 | I POP Q "DIDN'T OPEN CONNECTION"
|
|---|
| 21 | S XWBSBUF=""
|
|---|
| 22 | U XWBTDEV
|
|---|
| 23 | D WRITE^XWBRW(HTTPTYPE_" "_PAGE_" HTTP/1.0"_$C(13,10))
|
|---|
| 24 | I HTTPTYPE="POST" D
|
|---|
| 25 | . D WRITE^XWBRW("Referer: http://"_$$KSP^XUPARAM("WHERE")_$C(13,10))
|
|---|
| 26 | . D WRITE^XWBRW("Content-Type: application/x-www-form-urlencoded"_$C(13,10))
|
|---|
| 27 | . D WRITE^XWBRW("Cache-Control: no-cache"_$C(13,10))
|
|---|
| 28 | . D WRITE^XWBRW("Content-Length: "_$L(DATA)_$C(13,10,13,10))
|
|---|
| 29 | . D WRITE^XWBRW(DATA)
|
|---|
| 30 | D WRITE^XWBRW($C(13,10))
|
|---|
| 31 | D WBF^XWBRW
|
|---|
| 32 | S XWBRBUF="",DONE=0,XWBICNT=0
|
|---|
| 33 | S XVALUE=$$DREAD($C(13,10)) I XVALUE'[200 S XVALUE=$P(XVALUE," ",2,3)
|
|---|
| 34 | I '$T S XVALUE=$$DREAD($C(13,10,13,10)),XVALUE=$$DREAD($C(13,10))
|
|---|
| 35 | D CLOSE ;I IO="|TCP|80" U IO D ^%ZISC
|
|---|
| 36 | Q $P(XVALUE,$C(13,10))
|
|---|
| 37 | ;
|
|---|
| 38 | CLOSE ;
|
|---|
| 39 | D CLOSE^%ZISTCP,GETDEV^%ZISUTL("XUSBSE") I $L(IO) U IO
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | DREAD(D,TO) ;Delimiter Read
|
|---|
| 43 | N R,S,DONE,C,L
|
|---|
| 44 | N $ES,$ET S $ET="S DONE=1,$EC="""" Q"
|
|---|
| 45 | S R="",DONE=0,D=$G(D,$C(13)),C=0
|
|---|
| 46 | S TO=$S($G(TO)>0:TO,$G(XWBTIME(1))>0:XWBTIME(1),1:60)/2+1
|
|---|
| 47 | U XWBTDEV
|
|---|
| 48 | F D Q:DONE
|
|---|
| 49 | . S L=$F(XWBRBUF,D),L=$S(L>0:L,1:$L(XWBRBUF)+1),R=R_$E(XWBRBUF,1,L-1),XWBRBUF=$E(XWBRBUF,L,32000)
|
|---|
| 50 | . I (R[D)!(C>TO) S DONE=1 Q
|
|---|
| 51 | . R XWBRBUF:2 S:'$T C=C+1 S:$L(XWBRBUF) C=0
|
|---|
| 52 | . I $G(XWBDEBUG)>2,$L(XWBRBUF) D LOG^XWBDLOG($E("rd ("_$L(XWBRBUF)_"): "_XWBRBUF,1,255))
|
|---|
| 53 | . Q
|
|---|
| 54 | Q R
|
|---|
| 55 | ;
|
|---|
| 56 | TRAP ;
|
|---|
| 57 | I '(($EC["READ")!($EC["WRITE")) D ^%ZTER
|
|---|
| 58 | D CLOSE,LOG^XWBDLOG("Error: "_$$EC^%ZOSV):$G(XWBDEBUG),UNWIND^%ZTER
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | ;Test code below here
|
|---|
| 62 | ; MODIFY THE PROGRAM TO CHANGE THE 10.161.12.182 TO
|
|---|
| 63 | ; IP ADDRESSES FOR THE WORKSTATION WITH THE BSE SAMPLE
|
|---|
| 64 | ; SERVER
|
|---|
| 65 | EN(ADDRESS) ; test with input address or 10.161.12.182 if none entered
|
|---|
| 66 | N VALUE,PAGE,SERVER,PORT
|
|---|
| 67 | S ADDRESS=$G(ADDRESS,"10.237.131.26")
|
|---|
| 68 | S PAGE="/",SERVER=ADDRESS,PORT=80
|
|---|
| 69 | I SERVER["/" D
|
|---|
| 70 | . I SERVER["//" S SERVER=$P(SERVER,"//",2)
|
|---|
| 71 | . I SERVER["/" S PAGE="/"_$P(SERVER,"/",2,99),SERVER=$P(SERVER,"/")
|
|---|
| 72 | . I SERVER[":" S PORT=$P(SERVER,":",2),SERVER=$P(SERVER,":")
|
|---|
| 73 | . Q
|
|---|
| 74 | S VALUE=$$ENTRY(SERVER,PORT,PAGE) ; $G(ADDRESS,"10.237.131.26"))
|
|---|
| 75 | D HOME^%ZIS ;I IO="|TCP|80" U IO D ^%ZISC
|
|---|
| 76 | W !,VALUE
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | EN1 ;
|
|---|
| 80 | D EN("10.237.131.26/page1.htm")
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | EN2 ;
|
|---|
| 84 | D EN("10.237.131.26/level2/page2.htm")
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ;
|
|---|
| 88 | TESTPOST ;
|
|---|
| 89 | W !,$$POST("10.237.131.26","/","xVAL=XWBHDL851-487411_0")
|
|---|
| 90 | I IO="|TCP|80" U IO D ^%ZISC
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | ;Sample of what IIS returns
|
|---|
| 94 | ;HTTP/1.1 200 OK
|
|---|
| 95 | ;Server: Microsoft-IIS/5.1
|
|---|
| 96 | ;Date: Mon, 12 Feb 2007 22:57:55 GMT
|
|---|
| 97 | ;X-Powered-By: ASP.NET
|
|---|
| 98 | ;X-AspNet-Version: 1.1.4322
|
|---|
| 99 | ;Set-Cookie: ASP.NET_SessionId=vsiqfgygjwsaru55bj4aik45; path=/
|
|---|
| 100 | ;Cache-Control: private
|
|---|
| 101 | ;Content-Type: text/html; charset=utf-8
|
|---|
| 102 | ;
|
|---|
| 103 | ;999999999^MONSON,STEVE^CLEVELAND VAMC^541^136672^^
|
|---|
| 104 | ;
|
|---|
