home *** CD-ROM | disk | FTP | other *** search
/ Tools / WinSN5.0Ver.iso / VFP50 / SAMPLES / SERVERS / FOXISAPI / T1.PRG < prev   
Encoding:
Text File  |  1996-08-01  |  7.7 KB  |  281 lines
  1. #DEFINE CrLf CHR(13)+CHR(10)
  2. #DEFINE MCOOKIE STRTRAN(STRTRAN(time()+padl(seconds(),10,'0'),":",""),".","")
  3. * cmd /k e:\inetsrv\scripts\timer.bat
  4. clear
  5. set talk on
  6. close data all
  7. public ox
  8. ox=crea("t2")
  9. ox.show
  10. *?ox.simplecall("1","2")
  11. *?left(ox.cmd(MCOOKIE+"command=dir","dd"),800)
  12. *?left(ox.startup("","dd"),800)
  13. *?left(ox.skipit("&jj=kk &Cookie=kcookiek","dd"),800)
  14. *pp="&jj=kk &Cookie=kcookiek &Company = theco"
  15. *?ox.cmd("Cmd=dir+%5C","")
  16. *?ox.cmd("%COOKIE%?Cmd=dir+%5C","")
  17. *?ox.getval(pp,"Cookie")
  18. *?ox.getval(pp,"Company")
  19. *rele ox
  20.  
  21. DEFINE CLASS t2 AS t1
  22.     width = 500
  23.     caption="OLE Custom Server Demo"
  24.     ADD OBJECT lbl1 AS label WITH ;
  25.         caption="Company"
  26.     ADD OBJECT lbl2 AS label WITH ;
  27.         caption="Contact",top = 30
  28.     ADD OBJECT lbl3 AS label WITH ;
  29.         caption="Address",top = 60
  30.     ADD OBJECT cmdQuit AS commandButton WITH ;
  31.         caption="Quit",cancel=.t.
  32.     ADD OBJECT txt1 AS textbox WITH ;
  33.         left = 80,width=200,top = 0
  34.     ADD OBJECT txt2 AS textbox WITH ;
  35.         left = 80,width=200,top = 30
  36.     ADD OBJECT txt3 AS textbox WITH ;
  37.         left = 80,width=200,top=60
  38.     ADD OBJECT txtCust_id AS TEXTBOX WITH ;
  39.         top = 5,left = 300,readonly = .t.,disabled=.t.
  40.     ADD OBJECT cmdNext AS commandButton WITH ;
  41.         caption="Next",top = 120
  42.     ADD OBJECT cmdPrev AS commandButton WITH ;
  43.         caption="Prev",top = 120,left=110
  44.     ADD OBJECT cmdSave AS commandButton WITH ;
  45.         caption="Save",top = 120,left=220
  46.     PROCEDURE init
  47.         t1::init
  48.         thisform.txt1.controlsource="customer.company"
  49.         thisform.txt2.controlsource="customer.contact"
  50.         thisform.txt3.controlsource="customer.address"
  51.         thisform.txtCust_ID.controlsource="customer.cust_id"
  52.     procedure cmdSave.click
  53.         REPLACE customer.company WITH  thisform.txt1.value
  54.         REPLACE customer.contact WITH  thisform.txt2.value
  55.         REPLACE customer.address WITH  thisform.txt3.value
  56.         UNLOCK
  57.     procedure cmdNext.Click
  58.         thisform.skipit(1)
  59.     procedure cmdPrev.Click
  60.         thisform.skipit(-1)
  61.     procedure skipit(nn)
  62.         SKIP nn IN customer
  63.         thisform.refresh
  64.     procedure cmdQuit.init
  65.         this.top = thisform.height-20
  66.         this.left = thisform.width - 90
  67.     procedure cmdQuit.click
  68.         thisform.release    
  69.  
  70. ENDDEFINE
  71.  
  72. DEFINE CLASS t1 AS form OLEPUBLIC
  73.     dbfname="e:\vfp\samples\data\customer"
  74.     htmlname="e:\inetsrv\scripts\html.dbf"
  75.     cookiename="e:\inetsrv\scripts\cookies.dbf"
  76.     datasession=2
  77.     cookie = ""
  78.     ErrorHtml=""
  79.     PROTECTED PROCEDURE Init
  80.         SET EXCLUSIVE OFF
  81.         IF GETENV("COMPUTERNAME")="CALVIN4"
  82.             this.dbfname="c:\vfp\samples\data\customer"
  83.             this.htmlname="d:\inetsrv\scripts\html.dbf"
  84.             this.cookiename="d:\inetsrv\scripts\cookies.dbf"
  85.         ENDIF
  86.         IF !USED("customer")
  87.             USE (this.dbfname) ORDER 1
  88.             USE (this.htmlname) ORDER 1 ALIAS html IN 2
  89.             SELECT 3
  90.             USE (this.cookiename) alias cookies ORDER 1
  91.         ENDIF
  92.     PROTECTED PROC destroy
  93.         this.writeCookie
  94.     PROTECTED PROC WriteCookie
  95.         IF !EMPTY(this.cookie)
  96.             SELECT cookies
  97.             SEEK this.cookie
  98.             IF !FOUND()
  99.                 INSERT INTO cookies (cookie) VALUES ;
  100.                         (this.cookie)
  101.             ENDIF
  102.             REPLACE rnum WITH recno("customer")
  103.         ENDIF
  104.     PROCEDURE startup(p1,p2)
  105.     *called when client first visits: generate a cookie
  106.         this.cookie = MCOOKIE
  107.         return this.GenHTML("FORM","aa")
  108.     
  109.     procedure Getval(cstr,cVal)
  110.         LOCAL n1,c2
  111.         n1 = AT(m.cVal,m.cStr)
  112.         IF n1 = 0
  113.             return ""
  114.         ENDIF
  115.         c2 = ALLTRIM(SUBSTR(m.cStr,n1 + LEN(m.cVal)))
  116.         IF LEFT(m.c2,1) = '='
  117.             c2 = SUBSTR(m.c2,2)
  118.         ENDIF
  119.         IF "&"$c2
  120.             RETURN ALLTRIM(LEFT(m.c2,AT('&',m.c2)-1))
  121.         ELSE
  122.             RETURN ALLTRIM(m.c2)
  123.         ENDIF
  124.     PROC FixURL(m.cStr)
  125.         LOCAL m.n1,m.rv
  126.         m.cstr=STRTRAN(m.cstr,"+"," ")
  127.         m.rv = ""
  128.         DO WHILE .T.
  129.             IF "%" $ m.cStr
  130.                 m.n1 = AT('%',m.cStr)
  131.                 IF m.n1 > LEN(m.cStr) - 2
  132.                     m.rv = m.rv + m.cStr
  133.                     EXIT
  134.                 ENDIF
  135.                 IF !ISDIGIT(SUBSTR(m.cStr,m.n1+1))
  136.                     m.rv = m.rv + LEFT(m.cStr,m.n1)
  137.                     m.cStr = SUBSTR(m.cStr,m.n1+1)
  138.                     LOOP
  139.                 ENDIF
  140.                 m.rv = m.rv + LEFT(m.cStr,m.n1-1) + ;
  141.                     CHR(EVAL("0x"+SUBSTR(m.cStr,m.n1+1,2)))
  142.                 IF LEN(m.cStr) > m.n1 + 2
  143.                     m.cStr = SUBSTR(m.cStr,m.n1+3)
  144.                 ELSE
  145.                     EXIT
  146.                 ENDIF
  147.             ELSE
  148.                 m.rv = m.rv + m.cStr
  149.                 EXIT
  150.             ENDIF
  151.         ENDDO
  152.         m.cStr = m.rv
  153.         RETURN m.rv
  154.     protected procedure GetCookie(cstr)
  155.         this.FixURL(@m.cStr)
  156.         IF EMPTY(this.cookie)
  157.             IF "Cookie="$ m.cStr
  158.                 this.cookie=this.getval(m.cStr,"Cookie")
  159.             ELSE
  160.                 this.cookie= LEFT(m.cstr,LEN(MCOOKIE))
  161.             ENDIF
  162.         ENDIF
  163.         cstr= STRTRAN(m.cstr,this.cookie,"")
  164.         IF !SEEK(this.cookie,"cookies")
  165.             INSERT INTO cookies (cookie) VALUES ;
  166.                     (this.cookie)
  167.         ELSE
  168.             GOTO (cookies.rnum) IN customer
  169.         ENDIF
  170.         return m.cstr
  171.     proc cmd(p1,p2)
  172.         LOCAL m.cmd,rv
  173.         this.FixURL(@m.p1)
  174.         m.cmd=SUBSTR(m.p1,AT('=',m.p1)+1)
  175.         IF !EMPTY(m.cmd)
  176.             IF "FOXCMD"$m.p1
  177.                 m.p2 = EVAL(m.cmd)
  178.                 DO CASE
  179.                 CASE TYPE("m.p2") = 'N'
  180.                     IF INT(m.p2) # m.p2
  181.                         m.p2 = STR(m.p2,15,3)
  182.                     ELSE
  183.                         m.p2 = STR(m.p2)
  184.                     ENDIF
  185.                 CASE TYPE("m.p2") = 'D'
  186.                     m.p2 = DTOC(m.p2)
  187.                 ENDCASE
  188.             ELSE
  189.                 creat curs temp (dat m)
  190.                 append blank
  191.                 m.cmd = UPPER(m.cmd)
  192.                 IF m.cmd = "DEL" OR m.cmd="FORMAT" OR m.cmd ="ERASE"
  193.                     REPLACE dat WITH "You do not have rights"
  194.                 ELSE
  195.                     ! &cmd >c:\t.txt
  196.                     append memo dat from c:\t.txt
  197.                 ENDIF
  198.                 p2 = "<hr><p><pre>"+temp.dat+"<hr><p></pre>"
  199.                 use in temp
  200.             ENDIF
  201.         ELSE
  202.             p2 = "No command given"            
  203.         ENDIF
  204.         p2 = STRTRAN(m.p2,"<DIR>","(DIR)")
  205.         p2 = left(m.p2,3500)
  206.         rv = THIS.GenHTML("CMD",m.p2)
  207.         IF "FOXCMD"$m.p1
  208.             rv = strtran(m.rv,"%CMDTYPE%","Fox Expression")
  209.         ELSE
  210.             rv = strtran(m.rv,"%CMDTYPE%","DOS Command")
  211.         ENDIF
  212.         rv = strtran(m.rv,"%COMMAND%",m.cmd)
  213.         rv = strtran(m.rv,"%RESULTS%",m.p2)
  214.         RETURN m.rv
  215.     procedure skipit(p1,p2)
  216.         this.GetCookie(@m.p1)
  217.         IF ATC("prev",m.p1)>0
  218.             skip -1 in customer
  219.         ELSE
  220.             skip in customer
  221.         ENDIF
  222.         this.writeCookie
  223.         return THIS.GenHTML("FORM","b")
  224.  
  225.     PROCEDURE DoGet(request,Response)
  226.         Return THIS.CreateStdResponse("using the GET method", request)
  227.  
  228.     PROCEDURE DoPost(request,Response)
  229.         IF EMPTY(Response)
  230.             Response = ""
  231.         ENDIF
  232.         Return THIS.CreateStdResponse("using the POST method", request)
  233.     PROTECTED PROCEDURE Error(nError,cMethod,nLine)
  234.         LOCAL rv
  235.         rv = THIS.GenHTML("ERROR","")
  236.         rv = strtran(m.rv,"%METHOD%",m.cMethod)
  237.         rv = strtran(m.rv,"%ERRORNO%",STR(m.nError,4))
  238.         rv = strtran(m.rv,"%ERRORMSG%",Message(1))
  239.         rv = strtran(m.rv,"%LINENO%",STR(m.nLine,4))
  240.         THIS.ErrorHTML = m.rv
  241.         RETURN
  242.     PROCEDURE DoSave(p1,p2)
  243.         LOCAL m.tt
  244.         this.GetCookie(@m.p1)
  245.         REPLACE customer.company WITH  this.GetVal(m.p1,"Company")
  246.         REPLACE customer.contact WITH  this.GetVal(m.p1,"Contact")
  247.         REPLACE customer.address WITH  this.GetVal(m.p1,"Address")
  248.         return THIS.GenHTML("FORM",m.p1)
  249.     PROCEDURE GenHTML(p1,p2)
  250.         LOCAL rv
  251.         IF !EMPTY(THIS.ErrorHTML)
  252.             RETURN this.ErrorHtml
  253.         ENDIF
  254.         =SEEK(m.p1,"html")
  255.         rv = html.html
  256.         rv = strtran(m.rv,"%COOKIE%",this.cookie)
  257.         rv = strtran(m.rv,"%TEST%","t2")
  258.         rv = strtran(m.rv,"%VERSION%",vers(1))
  259.         rv = strtran(m.rv,"%DATE%",dtoc(date()))
  260.         rv = strtran(m.rv,"%TIME%",time())
  261.         rv = strtran(m.rv,"%CUST_ID%",customer.cust_id)
  262.         rv = strtran(m.rv,"%RECNO%",STR(RECNO("customer"),4))
  263.         rv = strtran(m.rv,"%COMPANY%",customer.company)
  264.         rv = strtran(m.rv,"%CONTACT%",customer.contact)
  265.         rv = strtran(m.rv,"%ADDRESS%",customer.address)
  266.         rv = strtran(m.rv,"%TESTP1%","calvin")
  267.         rv = strtran(m.rv,"%TESTP2%",m.p2)
  268.         RETURN m.rv
  269.  
  270.     Function CreateStdResponse(cMethod,cRequest)
  271.         LOCAL CreateStdResponse 
  272.         IF EMPTY(Response)
  273.             Response = ""
  274.         ENDIF
  275.         CreateStdResponse = "Content-Type: text/html" + CrLf + CrLf ;
  276.             + "<body><h1>This is a test response " + m.cMethod + ".</h1>" ;
  277.             + "<p><b>Parameters: </b>" + m.cRequest + "</body>"
  278.         RETURN CreateStdResponse 
  279. ENDDEFINE
  280.  
  281.