home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / WIN95 / INTERNET / h12395co.exe / data.1 / dba.hei < prev    next >
Encoding:
Text File  |  1997-12-05  |  22.0 KB  |  814 lines
  1. <includeonce
  2. // Filename: dba.hei version 1.2
  3. // Release date: March 3rd, 1997
  4. // 
  5. // (C) 1996-97 H.E.I. GmbH and suppliers all rights reseved
  6. // 
  7. // Redistribution and use in source and binary forms, with or without
  8. // modification, are permitted provided that the following conditions
  9. // are met:
  10. // 1. Redistributions of source code must retain the above copyright
  11. //    notice, this list of conditions and the following disclaimer.
  12. // 2. Redistributions in binary form must reproduce the above copyright
  13. //    notice, this list of conditions and the following disclaimer in the
  14. //    documentation and/or other materials provided with the distribution.
  15. // 3. Neither the name of H.E.I. GmbH nor the names of its contributors
  16. //    may be used to endorse or promote products derived from this software
  17. //    without specific prior written permission.
  18. // 4. The complete licensing conditions of heitml apply also to this file,
  19. //    be sure to have read and accepted these conditions before using this
  20. //    file. This file may be used and modified freely in conjunction with 
  21. //    a valid heitml license.
  22. // 
  23. // THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
  24. // WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  25. // MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  26. // IN NO EVENT SHALL THE H.E.I. OR CONTRIBUTORS BE LIABLE FOR ANY
  27. // DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  28. // DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
  29. // GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
  30. // INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
  31. // IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  32. // OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  33. // IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  34.  
  35. if false; def sessionUrl; /def; def sessionHidden; /def; /if;
  36.  
  37. // Embedded customizable database application 
  38. // (c) H.E.I. may be used freely in combination with heitml
  39. // You can easily build an application processing one relation
  40. // in the database. You can insert a form in your page to display,
  41. // modify or delete records in the database. 
  42. // For complete documentation and examples see www.h-e-i.de
  43.  
  44.  
  45. // How to use it:
  46. //    First use   <dbapp app, rel, maint=false>  to define an application.
  47. //       rel   gives the name of the database relation
  48. //       app   gives a name to the application,   
  49. //       maint sets maintenance mode, be sure to switch it off in real operation
  50.  
  51. //    Then you can insert several checking and control statements:
  52. //       dbappcreate   is an environment and can contain create table
  53. //                     statements. The are performed with action=create
  54. //                     and maint=true
  55.  
  56.  
  57. //    Insert the main dbapp form 
  58. def dbapp *app, rel, src=SrvLocalUrl, maint=false;
  59.    app=emptytuple; 
  60.    app.rel = rel;
  61.    app.maint = maint;
  62.    app.keyfi  = emptytuple; /* fields names of key      */
  63.    app.fitype = emptytuple; /* types of special fields  */ 
  64.    app.src = src;           /* page to call application */
  65. /def;
  66.  
  67. defenv dbacreate app; 
  68.    ff.action = default(ff.action);
  69. // >   DBACREATE <? ff.action> < 
  70.    if app.maint;
  71.     if (ff.action=="drop" || ff.action=="drcreate");
  72.       dbupdate > drop table <? app.rel> </dbupdate;
  73.     /if;
  74.     if (ff.action=="create" || ff.action=="drcreate"); 
  75.         defbody
  76.           > Tables Created. < 
  77.     /if
  78.    /if
  79. /defenv
  80.  
  81. def dbakeyfield app fn order="asc";
  82.    app.keyfi[fn]=order;
  83. /def;
  84.  
  85. def dbafitype app fn ty;
  86.    app.fitype[fn]=ty;
  87. /def;
  88.  
  89. def dbaTinteger app fn;
  90.    app.fitype[fn]="int";
  91. /def;
  92.  
  93. def dbaTreal app fn;
  94.    app.fitype[fn]="real";
  95. /def;
  96.  
  97.  
  98. def dbaTtext app fn;
  99.    app.fitype[fn]="hstv";
  100. /def;
  101.  
  102.  
  103. def dbaFixKey app k;
  104.    i=0;
  105.    if k != null;
  106.    while (i<len(app.keyfi));
  107.     n = fname(app.keyfi[i]);
  108.     t = app.fitype[n];
  109.     if (t=="int"); k[n]=integer(k[n]); /if;
  110.     if (t=="real"); k[n]=real(k[n]); /if;
  111.     i=i+1;
  112.    /while;
  113.    /if
  114. /def;
  115.  
  116. defenv dbaKeyComputed app;
  117.     app.keycomputed = "t";
  118.     if isdecl(ff.r);
  119.         if isempty(ff.k) && !isempty(ff.submit);
  120.             i=0;
  121.               while (i<len(app.keyfi));
  122.                 n = fname(app.keyfi[i]);
  123.                 if !isempty(ff.r[n]); break; /if;
  124.                 i=i+1;
  125.             /while;
  126.             if (len(app.keyfi)<=i);
  127.                 defbody;
  128.             /if;
  129.         /if;
  130.     /if;
  131. /defenv;
  132.  
  133. // do not perform an action, but do a redisplay an error
  134. def dbaredisplay; ff.redisplay=true; /def;
  135.  
  136. defenv dbaerrmsg headmsg="No Update Performed">
  137.    <hr><h2><font color="Red"><h2><? headmsg html></h2><br>
  138.    <defbody></font></h2><hr><dbaredisplay;ff.dbalasterrmsg=headmsg;
  139. /defenv
  140.  
  141.  
  142. defenv fehler;
  143.    dbaerrmsg "Änderung noch nicht durchgeführt.";defbody;/dbaerrmsg;
  144. /defenv;
  145.  
  146. // *********** Subroutines *************
  147.  
  148. def dbaKeyQueryCmp key keyfi rel; 
  149.   if isNull(key); return ""; /if;
  150.   assign kq;
  151.     if 1<len(key) >(< /if;
  152.     j=0;
  153.      while j<len(key);
  154.         if (0<j)> OR < /if;
  155.         if 1<len(key) >(< /if;
  156.         i=0;
  157.         while i<j;
  158.            if (0<i)> AND </if;
  159.            ? key[i]"Qn"; 
  160.         i=i+1;
  161.         /while
  162.         if (0<i)> AND </if;
  163.  
  164.         rel1 = rel; 
  165.         if keyfi[j]=="desc"; 
  166.        if rel1==">"; rel1="<"; else rel1=">"; /if;
  167.         /if;
  168.         if (j==len(key)-1); rel1=rel1+"="; /if
  169.         ?fname(key[j]); ? rel1; ? key[j] "Q"; 
  170.         j=j+1;
  171.         if 1<len(key) >)< /if;
  172.      /while
  173.      if 1<len(key) >)</if;
  174.   /assign;
  175.   return kq;
  176. /def;
  177.  
  178. def dbaFieldOrder app  desc=false;    
  179.    i=0; 
  180.    assign s;
  181.      while (i<len(app.keyfi));
  182.     if (0<i) >, </if;
  183.     ? fname(app.keyfi[i]);
  184.     if (app.keyfi[i]=="desc" && !desc) || (app.keyfi[i]!="desc" && desc);
  185.        > DESC <
  186.         /if;
  187.     i=i+1;
  188.      /while;
  189.    /assign;
  190.    return s;
  191. /def;
  192.    
  193.  
  194.  
  195. // execute a SQL update statement, update 
  196. // process all form fields r. and h. 
  197. def dbaperfupdate  app  key  rec;
  198.   dbupdate 
  199.      >  update <?app.rel> set <
  200.      let i=0;
  201.      while i<len(rec); 
  202.         if i!=0 >, </if;
  203.         ty = app.fitype[fname(rec[i])];
  204.         if ((Contains(SrvDbSys,"YARD") || Contains(SrvDbSys,"ODBC") ||
  205.          Contains(SrvDbSys,"ADABAS")) && ty=="hstv");
  206.       ? fname(rec[i]) >=< ? rec[i] hstv;
  207.         else if (ty=="int");
  208.           ? rec[i] "AnNV">=<? integer(rec[i])"ANN";
  209.         else if (ty=="real");
  210.           ? rec[i] "AnNV">=<? real(rec[i])"ANN";
  211.         else
  212.           ? rec[i]"Qn";
  213.         /if; /if; /if;
  214.         i=i+1;
  215.      /while;
  216.     > where  <? key" AND %Qn"> 
  217.    </dbupdate;
  218. /def;
  219.  
  220. // execute a SQL insert statement
  221. // process all form fields r. and h. 
  222. def dbaperfinsert app key rec; 
  223.   i=0; upd=""; insfn= ""; ihstv=0;
  224.  
  225.   dbupdate
  226.      > insert into <?app.rel> ( <? rec"QnNV"> )
  227.        values (
  228. <
  229.      while i<len(rec); 
  230.     if i!=0 >, </if;
  231.         ty = app.fitype[fname(rec[i])];
  232.         if ((Contains(SrvDbSys,"YARD") || Contains(SrvDbSys,"ODBC") || Contains(SrvDbSys,"ADABAS")) && ty=="hstv");
  233.        ? rec[i] hstv;
  234.         else if (ty=="int");
  235.           ? integer(rec[i]) "ANN";
  236.         else if (ty=="real");
  237.           ? real(rec[i])"ANN";
  238.         else
  239.           ? rec[i]"Q";
  240.         /if; /if; /if;
  241.         i=i+1;
  242.      /while;
  243. >)<
  244.   /dbupdate;
  245. /def;
  246.  
  247. // execute a delete 
  248. def dbaperfdelete app key;
  249.  dbupdate> 
  250.      delete from <? app.rel> where <? key" AND %Qn">
  251.  </dbupdate
  252. /def;
  253.  
  254.  
  255. def dbaupdateaction app;
  256.    if (!isnull(ff.submit)); return "submit"; /if;
  257.    if (!isnull(ff.delete)); return "delete"; /if;
  258.    return null;
  259. /def;
  260.  
  261.  
  262. // read the record determined by key into r
  263. // if not found r is null afterwards
  264. defenv dbaReadRecord app *r key=ff.k;
  265.     r = null; dbaFixKey app key;
  266.     dbquery q>
  267.       select * from <? app.rel> where <? key" AND %Qn"> 
  268.     <dbrow;
  269.       app.q=q; r=q; defbody;
  270.     /db;
  271. /defenv;
  272.  
  273.  
  274. def dbasetaction a;
  275. //  if !isnull(a);
  276.   ff[a]="t"; 
  277. //  /if;
  278. /def; 
  279.  
  280. def dbaCheckKey app rec;
  281.    i=0; 
  282.    while (i<len(app.keyfi));
  283.     if (isempty(rec[fname(app.keyfi[i])]));
  284.            dbaerrmsg > The field <? fname(app.keyfi[i])> must be given 
  285.        </dbaerrmsg; 
  286.         /if; 
  287.         i=i+1;
  288.    /while;
  289. /def;
  290.  
  291. // perform database update or insert or delete,
  292. // depending on the action 
  293. // the record is read beforehand and the body is executed
  294. // if the record is found 
  295. defenv dbaupdate app *r *o action=dbaupdateaction(app) key=default(ff.k)
  296.        rec=default(ff.r) submitaction=null ;
  297.    r=rec; o=null;
  298.    if action=="submit"; 
  299.       dbaFixKey app key;
  300.       if !isnull(key) && !isempty(default(key,rec)[0]); // an update 
  301.          dbareadrecord app o key=key;
  302.         app.q=o; 
  303.         defbody; 
  304.         if isnull(ff.redisplay); 
  305.            dbaperfupdate app key=key rec=rec; 
  306.            dbasetaction submitaction;
  307.         /if;
  308.          /dbareadrecord;
  309.      if o==null; dbaerrmsg> Record has been deleted meanwhile </dbaerrmsg;
  310.      /if;
  311.       app.afterupdate = "t";
  312.       else
  313.     key = copy(app.keyfi); TuProject (key,rec);
  314.         dbareadrecord app o key=key;
  315.        dbaerrmsg > Record already stored in database </dbaerrmsg;
  316.     /dbareadrecord;
  317.     defbody;
  318.         dbaCheckKey app rec;
  319.     if isnull(ff.redisplay); 
  320.        dbaperfinsert app key=key rec=rec; 
  321.        dbasetaction submitaction;
  322.        ff.k=key;
  323.     /if;
  324.     app.afterinsert = "t";
  325.       /if;
  326.    /if;
  327. /defenv
  328.  
  329. defenv dbaAfterInsert app *r *o action=dbaupdateaction(app) key=default(ff.k)
  330.     rec=default(ff.r) submitaction=null ;
  331.     r=rec; o=null;
  332.     if action=="submit" && default(app.afterinsert,"") == "t";
  333.         defbody;
  334.     /if;
  335. /defenv
  336.  
  337. defenv dbaAfterUpdate app *r *o action=dbaupdateaction(app) key=default(ff.k)
  338.     rec=default(ff.r) submitaction=null ;
  339.     r=rec; o=null;
  340.     if action=="submit" && default(app.afterupdate,"") == "t";
  341.         defbody;
  342.     /if;
  343. /defenv
  344.  
  345. defenv dbaDelete  app *r action=dbaupdateaction(app) key=default(ff.k)
  346.                   deleteaction="first";
  347.    if action=="delete";
  348.      dbaFixKey app key;
  349.      if isempty(key);
  350.         dbasetaction deleteaction;  
  351.      else
  352.         dbquery q>
  353.            select * from <? app.rel> where <? key" AND %Qn">
  354.         <dbrow;
  355.         app.q = q; r=q; 
  356.         defbody; 
  357.         /db; 
  358.     if isnull(ff.redisplay); 
  359.          dbaperfdelete app key=key;
  360.            dbasetaction deleteaction;
  361.         else
  362.        ff.redisplay=null;
  363.        ff.show=true;
  364.     /if;
  365.      /if
  366.    /if;    
  367.    r=null; app.afterdelete="t";
  368. /defenv;
  369.  
  370. defenv dbaAfterDelete app *r *o action=dbaupdateaction(app) key=default(ff.k)
  371.     rec=default(ff.r) submitaction=null ;
  372.     r=rec; o=null;
  373.     if action=="delete" && default(app.afterdelete,"") == "t";
  374.         defbody;
  375.     /if;
  376. /defenv
  377.  
  378.  
  379. def dbaKeyUpdate;
  380.    if isdecl(ff.k) && isdecl(ff.r) && !isdecl(ff.redisplay); 
  381.       TuProject (ff.k ff.r);
  382.    /if
  383. /def;
  384.  
  385.  
  386. // show field content given by val
  387. def dbafi app fn size=10 maxsize=size def=null;
  388.    if !isnull(app.keyfi[fn]); 
  389.       if app.keywri && default(app.keycomputed,"") == "">
  390.     <input name="<
  391.     if app.keyrec; >r.< else >k.< /if
  392.                  ><?fn>" size=<?size> maxlength=<?maxsize> value=<? default(app.q[fn]) quoted>>
  393.       <else
  394.     if isempty(app.q[fn]); ? def html; else ? app.q[fn]; /if;
  395.       /if;
  396.    else
  397.       if app.writeable >
  398.     <input name="r.<?fn>" size=<?size> maxlength=<?maxsize> value=<? default(app.q[fn]) quoted>>
  399.       <else
  400.     if isempty(app.q[fn]); ? def html; else ? app.q[fn]; /if;
  401.       /if;
  402.    /if;
  403. /def;
  404.  
  405. def dbamailto app fn size=30 maxsize=size def=null;
  406.       if app.writeable;
  407.         dbafi app fn size maxsize;
  408.       else
  409.     if !isempty (app.q[fn]);
  410.         > <a href=mailto:<? app.q[fn]>><? app.q[fn]></a> <
  411.         else
  412.                 ? def html;
  413.     /if;
  414.       /if;
  415. /def
  416.  
  417. def dbalink app fn size=30 maxsize=size def=null;
  418. //      app.q[fn]=default(app.q[fn],"http://");
  419.       if app.writeable;
  420.         dbafi app fn size maxsize;
  421.       else
  422.     if !isempty (app.q[fn]);
  423.           > <a href="<
  424.         if !contains(app.q[fn],"://") >http://< /if;
  425.         ><? app.q[fn]>"><? app.q[fn]></a> <
  426.     else 
  427.             ? def html;
  428.     /if;
  429.       /if;
  430. /def
  431.  
  432.  
  433. def dbaTextArea app fn rows=10 cols=60 wrap="physical" disp="normal";
  434.       if app.writeable >
  435.     <textarea name="r.<?fn>" cols=<? cols> rows=<? rows> wrap=<? wrap quoted>><?default(app.q[fn])></textarea>
  436.       <else
  437.     if disp=="pre"> 
  438.     <pre> 
  439.     <? default(app.q[fn])>
  440.     </pre>
  441. <    else
  442.      if disp=="html"> 
  443.      <? default(app.q[fn]) html>
  444. <     else  
  445.           if disp=="heitml">
  446.           <? default(app.q[fn]) heitml>
  447. <         else>
  448.           <? default(app.q[fn])>
  449. <         /if;
  450.      /if;
  451.         /if;
  452.       /if;
  453. /def;
  454.  
  455.    
  456. defenv dbacheckbox app fn trueval="T" falseval="";
  457.     if app.writeable;
  458.     defbody;
  459.     > <input name="r.<?fn>" type="hidden" value=<?falseval quoted>> 
  460.       <input name="r.<?fn>" type="checkbox" value=<?trueval quoted> <
  461.         if app.q[fn]==trueval> checked  </if
  462.       > > <
  463.     else
  464.     if app.q[fn]==trueval; 
  465.         defbody;
  466.     /if;
  467.     /if;
  468. /defenv
  469.  
  470. defenv dbaRadio app fn val;
  471.     if app.writeable;
  472.     > <input name="r.<?fn>" type="radio" value=<?val quoted> <
  473.         if app.q[fn]==val> checked  </if
  474.       > > <
  475.     defbody;
  476.     else
  477.     if app.q[fn]==val; 
  478.         defbody;
  479.     /if;
  480.     /if;
  481. /defenv
  482.  
  483. defenv dbaSelect app fn;
  484.    app.selectvalue = trim(default (app.q[fn]," "));
  485.    if app.writeable;
  486.     > <select name="r.<?fn>"> 
  487.           <defbody> 
  488.       </select> 
  489.         < 
  490.    else 
  491.     defbody;
  492.    /if;
  493. /defenv;
  494.  
  495. def dbaOptionV app value;
  496.    if app.writeable;
  497.     > <option value=<? value quoted> < 
  498.       if (app.selectvalue==value) > selected < /if;
  499.     > > <? value;  
  500.    else
  501.         if (app.selectvalue==value); ? value; /if;
  502.    /if
  503. /def;
  504.  
  505. defenv dbaOption app value;
  506.    if app.writeable;
  507.     > <option value=<? value quoted> <
  508.       if (app.selectvalue==value) > selected < /if;
  509.     > > <defbody; 
  510.    else
  511.         if (app.selectvalue==value); defbody; /if;
  512.    /if
  513. /defenv;
  514.  
  515.  
  516. def dbatfi app fn size maxsize=size def=null>
  517.    <tr> <td> <b> <?fn> </b> </td> <td> <dbafi app fn size maxsize def=def> </td> </tr>
  518. </def;
  519.  
  520. def dbatab app fn size maxsize=size>
  521.    <td> <dbafi app fn size maxsize> </td> 
  522. </def;
  523.  
  524. def dbashowaction app;
  525.    if (!isnull(ff.redisplay));   return "redisplay";      /if;
  526.    if (!isnull(ff.empty));       return "empty";      /if;
  527.    if (!isnull(ff.showemp));     return "showemp";    /if;
  528.    if (!isnull(ff.show));        return "show";       /if;
  529.    if (!isnull(ff.display));     return "display";       /if;
  530.    if (!isnull(ff.submit));      return "no";       /if;
  531.    if (!isnull(ff.delete));      return "no";       /if;
  532.    return "no";
  533. /def;
  534.  
  535. defenv dbaform app *r     action=dbashowaction(app) 
  536.                           key=default(ff.k) rec=default(ff.r)
  537.               keyact="no";
  538. //  action  what to do
  539. //     empty      show an empty form
  540. //     showemp    show the record designated by the key, if not found show empty form
  541. //     show       just show record, if not found show nothing r==null
  542. //     display    display not writeable
  543. //     redisplay  show just entered record
  544. //  keyact 
  545. //     no      key fields are not writeable
  546. //     upd     key fields may be updated
  547. //     cpy     key fields can be changed and cause copying
  548. //     del     key fields are shown writeable and empty
  549. // --------------------------------------------------------
  550. //  internal options of show
  551. //     app.writeable   show fields writeable 
  552. //     app.keywri      show key fields writeable
  553. //     app.keyrec      key fields get r prefix
  554. // --------------------------------------------------------
  555. // ? "Action = "; ?  action; 
  556. r=null; app.key=key;
  557. if action=="empty";
  558.   r=default(rec,emptytuple); app.q=r; app.writeable=true; app.keywri=true; app.keyrec=true;
  559.   >
  560.       <form action="<? app.src>" method="post">
  561.     <sessionHidden>
  562. // Here we could insert duplication functionality
  563.       <defbody>
  564.       </form>
  565.   <
  566. /if
  567. if action=="redisplay";
  568.    dbaFixKey app key;
  569.    r=copy(rec); app.q=r; app.writeable=true; app.keywri=false; app.keyrec=false;
  570.    if keyact!="no"; app.keywri=true; /if; 
  571.       > 
  572.          <form action="<? app.src>" method="post">
  573.      <sessionHidden>
  574.          <if keyact=="no" || keyact=="upd"; 
  575.         if !isnull(key);
  576.           k=key; ? k "Fht";
  577.         /if;
  578.         app.keyrec=true;
  579.          /if>
  580.          <defbody>
  581.          </form>
  582.       <
  583. /if;
  584. if action=="show"||action=="showemp"||action=="display">
  585.    <dbaFixKey app key>
  586.    <dbquery q  >select * from <? app.rel> where <? key" AND %Qn"><
  587.    dbrow
  588.       r=q; app.q=q; app.writeable=true; app.keywri=false; app.keyrec=false;
  589.       if keyact!="no"; app.keywri=true; /if;
  590.       if action=="display"; app.keywri=false; app.writeable=false; /if;
  591.       > 
  592.          <form action="<? app.src>" method="post">
  593.      <sessionHidden>
  594.          <if keyact=="no" || keyact=="upd"; k=key; ? k "Fht"; app.keyrec=true;/if>
  595.          <defbody>
  596.          </form>
  597.       <
  598.    dbempty
  599.       gl.found=false; 
  600.       r=key; app.q=r;
  601.       if action=="showemp"; 
  602.      app.writeable=true; app.keywri=false; app.keyrec=true;
  603.         > 
  604.          <form action="<? app.src>" method="post">
  605.      <sessionHidden>
  606.          <if keyact=="no"; k=key; ? k "Fht"; else app.keywri=true;/if>
  607.          <defbody>
  608.          </form>
  609.         <
  610.        /if
  611.    /dbquery
  612. /if
  613. /defenv;
  614.  
  615.  
  616.  
  617. defenv dbaAshow app k=default(app.key) addurl="";
  618.   if !isnull(k) ><a href=<?app.src>?show=t&<? k"Unt"><? addurl>&<sessionUrl>> <defbody></a> </if
  619. /defenv;
  620.  
  621. defenv dbaAdisplay app k=default(app.key) addurl="";
  622.   if !isnull(k) ><a href=<?app.src>?display=t&<? k "Unt"><? addurl>&<sessionUrl>> <defbody></a> </if
  623. /defenv;
  624.  
  625. defenv dbaAshowemp app k=default(app.key) addurl="";
  626.   if !isnull(k) ><a href=<?app.src>?showemp=t&<? k "Unt"><? addurl>&<sessionUrl>><defbody></a></if
  627. /defenv;
  628.  
  629. defenv dbaAdelete app key=default(app.key) addurl="";
  630.   if !isnull(k) ><a href=<?app.src>?delete=t&<? k "Unt"><? addurl>&<sessionUrl>> <defbody></a></if 
  631. /defenv;
  632.  
  633. defenv dbaAPdelete app key=default(app.key);
  634.    if app.writeable; 
  635.       >  <input type="submit" name="delete" value="<defbody>"> <
  636.    /if;
  637. /defenv;
  638.  
  639. defenv dbaPDeleteForm app k=default(app.key);
  640.   if !isnull(k);
  641.      app.writeable=true;
  642.  
  643.    > <form action="<? app.src>" method="post">
  644.     <sessionHidden>
  645.         <? k "Fht"; defbody>
  646.  </form> <
  647.   /if;
  648. /defenv;
  649.  
  650. defenv dbaAsubmit app;
  651.   if  app.writeable> <input type="submit" name="submit" value="<defbody>"></if 
  652. /defenv;
  653.  
  654. defenv dbaAreset app;
  655.   if  app.writeable> <input type="reset"  name="reset" value="<defbody>"></if  
  656. /defenv; 
  657.  
  658. defenv dbaAnext app k=default(app.key) addurl="";
  659.   if !isnull(k)> <a href=<?app.src>?next=t&<? k "Unt">&ofs=<?
  660.    app.cnt-app.i+1><? addurl>&<sessionUrl>><defbody></a></if 
  661. /defenv;
  662.  
  663. defenv dbaAprev app k=default(app.startkey) addurl="";
  664. //   > app.cnt = <?app.cnt>   app.i= <?app.i> < 
  665.   if !isnull(k)> <a href=<?app.src>?prev=t&<? k "Unt">&ofs=<?
  666.    1><? addurl>&<sessionUrl>><defbody></a></if 
  667. /defenv;
  668.  
  669. defenv dbaAfirst app addurl="">
  670.   <a href=<?app.src>?first=t<? addurl>&<sessionUrl>><defbody></a>
  671. </defenv;
  672.  
  673. defenv dbaAlast app addurl="">
  674.   <a href=<?app.src>?last=t<? addurl>&<sessionUrl>><defbody></a>
  675. </defenv;
  676.  
  677. defenv dbaAempty app addurl="">
  678.   <a href=<?app.src>?empty=t<?addurl>&<sessionUrl>><defbody></a>
  679. </defenv;
  680.  
  681.  
  682. def dbalistaction app;
  683.    if (!isnull(ff.first));       return "first";      /if;
  684.    if (!isnull(ff.last));        return "last";       /if;
  685.    if (!isnull(ff.next));        return "next";       /if;
  686.    if (!isnull(ff.prev));        return "prev";       /if;
  687.    return "no";
  688. /def;
  689.  
  690. // return the key of the cnt-next record, starting with key
  691. def dbaScrollDown app key cnt;
  692.    i=0;
  693.  
  694. //   > Scroll Down <assign x><? key "Q"></assign><?x> <br> <
  695.    dbquery q>  select <? app.keyfi"QNVn"> 
  696.                from   <? app.rel> 
  697.            where  <? dbaKeyQueryCmp(key,app.keyfi, ">")> <? app.cond>
  698.            ORDER BY <?dbafieldorder (app)>
  699.    <
  700.    dbrow 
  701.       if i==cnt; return q; /if;
  702.       i=i+1;
  703.    /db;
  704.    return null;
  705. /def; 
  706.  
  707. // return the key of the cnt-prev record, starting with key
  708. def dbaScrollUp app key cnt;
  709.    i=0;
  710.    qu = dbaKeyQueryCmp(key,app.keyfi,"<");
  711. //    ? isempty(qu); ? isempty(app.cond);
  712.    if (isempty(qu) && isempty(app.cond));
  713.       qu = "";
  714.    else 
  715.       if (isempty(qu)); qu = " where "+ substring (app.cond,4,len(app.cond));
  716.       else  qu= "where " + qu + app.cond; /if;
  717.    /if;
  718. //   > Scroll Up <showtuple key> <
  719.    dbquery q>  select <? app.keyfi"QNVn"> from <? app.rel> 
  720.            <? qu>
  721.            ORDER BY <?dbafieldorder (app,true)>
  722.    <
  723.    dbrow 
  724. //       > Read <?i> <?cnt><showtuple q> <
  725.       if i==cnt; return q; /if;
  726.       i=i+1;
  727.    /db;
  728.    return null;
  729. /def; 
  730.  
  731. def dbaScroll app key cnt;
  732. //   > Scroll cnt = <? cnt> < 
  733.    if 0<=cnt; return dbaScrollDown(app, key, cnt);
  734.    else return dbaScrollUp (app, key, -cnt); /if;
  735. /def
  736.  
  737.  
  738. defenv dbaTable app action=dbalistaction(app) key=default(ff.k) cnt=10
  739.                ofs=integer(default(ff.ofs,0)) cond="";
  740.    app.keywri=false; app.writeable=false; app.i=0; r=null; app.cnt=cnt;
  741.  
  742.    
  743.  
  744. //    > Here we are <? ofs> <?cnt> < 
  745.  
  746.    if action=="no"; return; /if;
  747.    dbaFixKey app key;
  748.    app.cond="";
  749.    if !isempty(cond); app.cond=" AND "+cond; /if;
  750.    if action=="first";    key = default(app.firstkey);   /if;
  751.    if action=="next";   key = dbaScroll (app, key, ofs);
  752.       // if already at end of file, just do a last 
  753.       if isnull(key);   key = dbaScroll (app, null, -cnt+2);   /if; 
  754.    /if;
  755.    if action=="prev";   key = dbaScroll (app, key, ofs-cnt-1); /if;
  756.    if action=="last";   key = dbaScroll (app, null, -cnt+2);   /if;
  757.    app.key = key;
  758.    defbody;
  759. /defenv;
  760.  
  761.  
  762. defenv dbaTableEntry app *r;
  763.    r=null;
  764.    qu = dbaKeyQueryCmp(app.key,app.keyfi,">");
  765.    if (isempty(qu) && isempty(app.cond));
  766.       qu = "";
  767.    else 
  768.       if (isempty(qu)); qu = " where " + substring (app.cond,4,len(app.cond));
  769.       else  qu= "where " + qu + app.cond; /if;
  770.    /if;
  771.  
  772.    dbquery q>  select *
  773.            from     <? app.rel> 
  774.                <? qu> 
  775.                ORDER BY <? dbafieldorder (app)>
  776.    <
  777.    dbrow r=q; app.q=q; app.key=copy (app.keyfi); TuProject(app.key,r);
  778.      if app.i==0; app.startkey=app.key; /if;
  779.      defbody;
  780. // > <?app.i> <
  781. //         showtuple q;
  782.      app.i=app.i+1;
  783.          if (app.cnt<=app.i); break; /if;
  784.    /db;
  785. /defenv;
  786.  
  787.  
  788. def dbapasswordcheck app master="*";
  789.   if isempty(ff.r.password); 
  790.      dbaerrmsg> You MUST specify a password. You can use it to modify or
  791.                delete your database entry </dbaerrmsg;
  792.   else 
  793.       ff.r.password=crypt(trim(ff.r.password));
  794.       if !isnull(app.q);
  795. //  > Compare <? app.q.password> and <? ff.r.password> <
  796.     if trim(default(app.q.password,""))!=trim(ff.r.password) &&
  797.        trim(ff.r.password)!=master; 
  798.        dbaerrmsg> The password you entered did not match the one in our database. </dbaerrmsg;
  799.     else
  800.        ff.r.password = app.q.password;
  801.     /if;
  802.       /if; 
  803.   /if;
  804. /def;
  805.  
  806.  
  807. def dbafipassword app fn="Password" size=10 pref="<b> Password: </b>" ;
  808.    if app.writeable;
  809.    > <? pref html> 
  810.      <input type="Password" size=<? size> name="r.<? fn>"> <
  811.    /if
  812. /def;
  813. >
  814.