home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / DATABASE.CMD < prev    next >
OS/2 REXX Batch file  |  1994-01-14  |  6KB  |  195 lines
  1. 'database commands
  2. $IF NOT %NODBASE
  3. GOTO EXITSELECT
  4. PtrUSE:'        CASE "USE"
  5.     F$=POPARG$
  6.         IF F$="" THEN DBUSE "",e%:GOTO EXITSELECT
  7.         IF INSTR(F$,".")=0 THEN F$=F$+".DBF"
  8.         DBUSE F$,e%
  9.         SELECT CASE e%
  10.                 CASE 1:PROZOPRINT "Database file not found"+CrLf$
  11.                 CASE 2:PROZOPRINT "Zero byte file"+CrLf$
  12.                 CASE 3:PROZOPRINT "File has no fields"+CrLf$
  13.                 CASE 4:PROZOPRINT "Not a dBASE database file"+CrLf$
  14.         END SELECT
  15.         IF Prog%=0 THEN
  16.         PROZOPRINT STR$(Numberoffields?) + " fields in " + STR$(NumberOfRecords???)+ " records."+CrLf$
  17.     END IF
  18. $ENDIF
  19. GOTO EXITSELECT
  20. PtrMAPPED:'     CASE "MAPPED"
  21.     MapFlag%=%True
  22.  
  23. GOTO EXITSELECT
  24. PtrGET:'        ' GET MAPPED variable IN database RECORD n        CASE "GET" ' GET MAPPED variable IN database RECORD n
  25.         ' mapped variable reads directly into the var array.  Very fast.
  26.         IF MapFlag% THEN
  27.             MapFlag%=%False
  28.                  ARRAY SCAN VAR$(1),COLLATE UCASE,=LITERAL$(ArgPtr%), TO i%
  29.                  IF i% THEN
  30.                   DUMMY$=POPARG$ ' replace with DECR ArgPtr%
  31.                   Buf=VAL(POPARG$)
  32.                   R&=VAL(POPARG$)
  33.                   GET #Buf,R&,VALUE$(i%)
  34.                  ELSE
  35.                   DUMMY$=POPARG$:DUMMY$=POPARG$:DUMMY$=POPARG$
  36.                   ERROR 103
  37.                  END IF
  38.  
  39.         ELSE
  40. $IF NOT %NODBASE
  41.     R???=VAL(POPARG$)
  42.         dBGetRecord R???,e%
  43.         SELECT CASE e%
  44.                 CASE 0 ' success
  45.                                 CASE 1:PROZOPRINT "Database not open"+CrLf$
  46.                 CASE 2,3:PROZOPRINT "Invalid record number"+CrLf$
  47.     END SELECT
  48. $ENDIF
  49.     END IF
  50. GOTO EXITSELECT
  51. PtrPUT:'        CASE "PUT"
  52.         IF MapFlag% THEN
  53.             MapFlag%=%False
  54.                   DAT$=POPARG$
  55.                   Buf=VAL(POPARG$)
  56.                   R&=VAL(POPARG$)
  57.                   PUT #Buf,R&,DAT$
  58.         ELSE
  59. $IF NOT %NODBASE
  60.     R???=VAL(POPARG$)
  61.     DBPutRecord R???,e%
  62.         SELECT CASE e%
  63.                 CASE 1:PROZOPRINT "Database not open"+CrLf$
  64.                 CASE 2:PROZOPRINT "Invalid Record Number"+CrLf$
  65.     END SELECT
  66. IF LEN(INDEX$) THEN
  67.     BT Index$,"A", UCASE$(DBGetCField$(IndexField$,e%)),MKDWD$(RecNum???),"","",r%
  68.         IF NOT r% THEN PROZOPRINT "Error updating index file"+CrLf$
  69. END IF
  70. $ENDIF
  71.     END IF
  72.  
  73. $IF NOT %NODBASE
  74. GOTO EXITSELECT
  75. PtrCREATEFORMAT:'       CASE "CREATEFORMAT"
  76.     IF Comline=0 AND dBASEOpen% THEN
  77.     DBCreateFormat
  78.         ELSE
  79.         PROZOPRINT "Cannot create a format now."+CrLf$
  80.         END IF
  81.  
  82. GOTO EXITSELECT
  83. PtrCREATEINDEX:'        CASE "CREATEINDEX"
  84.     I$=POPARG$:IF INSTR(I$,".")=0 THEN I$=I$+".BTX"
  85.         F$=POPARG$:IF F$="" THEN F$=LEFT$(I$,INSTR(I$,".")-1)
  86.         DBCreateIndex I$, F$, e%
  87.         SELECT CASE e%
  88.         CASE 1:PROZOPRINT "Database not open"
  89.         CASE 2:PROZOPRINT "Invalid Field name"
  90.         CASE 3:PROZOPRINT "Cannot create file"
  91.         CASE 4:PROZOPRINT "Error reading database"
  92.         CASE 5:PROZOPRINT CrLf$+"*ABORTED*"
  93.         CASE 6:PROZOPRINT "Internal error"
  94.         CASE 7:PROZOPRINT "Disk Write Error"
  95.         END SELECT
  96.         PROZOPRINT CrLf$
  97. GOTO EXITSELECT
  98. PtrFORMAT:'     CASE "FORMAT"
  99.         ARG$=POPARG$
  100.         IF ARG$="" THEN
  101.         dBDefaultFormat
  102.         ELSE
  103.     dBSetFormatTo ARG$,e%
  104.         IF e% THEN PROZOPRINT "Format file not found"+CrLf$
  105.     END IF
  106. GOTO EXITSELECT
  107. PtrVIEW:'       CASE "VIEW"
  108.     DBView
  109.  
  110. GOTO EXITSELECT
  111. PtrEDIT:'       CASE "EDIT"
  112.         e%=0
  113.         R???=VAL(POPARG$)
  114.         IF R???=0 THEN CALL dBEditFields (e%) ELSE dBEditRecord R???,e%
  115.          IF e% THEN PROZOPRINT "Invalid Record Number"+CrLf$
  116. GOTO EXITSELECT
  117. PtrAPPEND:'     CASE "APPEND"
  118.     dBAppendRecord e%
  119.         IF e% THEN PROZOPRINT "APPEND error"+CrLf$
  120.  
  121. GOTO EXITSELECT
  122. PtrDELIMITED:'  CASE "DELIMITED"
  123.     PUSHARG DBGetASCII$
  124.  
  125. GOTO EXITSELECT
  126. PtrINDEX:'      CASE "INDEX"
  127.     I$=POPARG$
  128.         IF I$="" THEN DBSetIndexTo "","",e%:GOTO EXITSELECT
  129.         IF INSTR(I$,".")=0 THEN I$=I$+".BTX"
  130.         F$=POPARG$:IF F$="" THEN F$=LEFT$(I$,INSTR(I$,".")-1)
  131.         DBSetIndexTo I$, F$, e%
  132.             SELECT CASE e%
  133.                         CASE 1:PROZOPRINT "Database not open"+CrLf$
  134.                         CASE 2:PROZOPRINT "Invalid Field Name"+CrLf$
  135.                         CASE 3:PROZOPRINT "Index file not found"+CrLf$
  136.         END SELECT
  137.  
  138. GOTO EXITSELECT
  139. PtrFIND:'       CASE "FIND"
  140.     Findme$=POPARG$
  141.         F$=FINDME$
  142.         DBSearchIndex Findme$,e%
  143.         IF e% THEN PROZOPRINT "FIND error"+CrLf$:GOTO EXITSELECT
  144.         IF UCASE$(F$)<>UCASE$(LEFT$(FINDME$,LEN(F$))) THEN _
  145.          PROZOPRINT "Not found"+CrLf$:Found=%False ELSE Found=%True
  146. GOTO EXITSELECT
  147. PtrNEXT:'       CASE "NEXT"
  148.         DBSkip 1, E%
  149.                 IF e% THEN PROZOPRINT "Can't SKIP"+CrLf$:DBEND%=-1
  150. GOTO EXITSELECT
  151. PtrPREV:'       "PREVIOUS"        CASE "PREV","PREVIOUS"
  152.         DBSkip -1, E%
  153.                 IF e% THEN PROZOPRINT "Can't SKIP"+CrLf$:DBEND%=-1
  154. GOTO EXITSELECT
  155. PtrSKIP:'       CASE "SKIP"
  156.     R&=VAL(POPARG$):IF R&>32767 OR R&<-32767 THEN _
  157.                 PROZOPRINT "SKIP out of range"+CrLf$:GOTO EXITSELECT
  158.     R%=R&
  159.         DBSkip R%, E%
  160.         IF e% THEN PROZOPRINT "Can't SKIP"+CrLf$
  161.     DBEND%=e%
  162. GOTO EXITSELECT
  163. PtrTOP:'        "FIRST"        CASE "TOP","FIRST"
  164.     DBGOTOTOP e%
  165.         IF e%=1 THEN PROZOPRINT "Database error"+CrLf$
  166.         IF e%=2 THEN PROZOPRINT "Index error"+CrLf$
  167. GOTO EXITSELECT
  168. PtrBOTTOM:'     "LAST"        CASE "BOTTOM","LAST"
  169.     DBEND%=-1
  170.     DBGOTOBOTTOM e%
  171.         IF e%=1 THEN PROZOPRINT "Database error"+CrLf$
  172.         IF e%=2 THEN PROZOPRINT "Index error"+CrLf$
  173. GOTO EXITSELECT
  174. PtrISOPEN:'     CASE "ISOPEN"
  175. PUSHARG STR$(ISTRUE dBaseOpen%)
  176. GOTO EXITSELECT
  177. PtrRECNUM:'     "RECNO"        CASE "RECNUM","RECNO"
  178. PUSHARG STR$(RecNum???)
  179. GOTO EXITSELECT
  180. PtrNUMFIELDS:'  CASE "NUMFIELDS"
  181. PUSHARG STR$(NumberOfFields?)
  182. GOTO EXITSELECT
  183. PtrCOUNT:'      CASE "COUNT"
  184. PUSHARG STR$(NumberOfRecords???)
  185. GOTO EXITSELECT
  186. PtrINDEXFILE:'  CASE "INDEXFILE"
  187. PUSHARG INDEX$
  188. GOTO EXITSELECT
  189. PtrINDEXFIELD:' CASE "INDEXFIELD"
  190. PUSHARG INDEXFIELD$
  191. GOTO EXITSELECT
  192. PtrDBEND:'      CASE "DBEND"
  193. PUSHARG STR$(DBEND%)
  194. $ENDIF
  195.