home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / INDEX.CMD < prev    next >
OS/2 REXX Batch file  |  1994-01-14  |  8KB  |  254 lines
  1. 'index commands
  2. GOTO EXITSELECT
  3. PtrIXOPEN:'     CASE "IXOPEN"
  4.         ' IXOPEN Filename AS Buffer
  5.         FI$=POPARG$
  6.         V$=LITERAL$(ArgPtr%) ' buffer
  7.         FF=FREEFILE
  8.         VSET2 V$, STR$(FF)
  9.         Dummy$=POPARG$
  10.         IxPtr&(FF,0)=0 ' Current pointer
  11.         IxPtr&(FF,1)=0 ' RecordSize
  12.         IxPtr&(FF,2)=0 ' Last recnum read
  13.         IxPtr&(FF,3)=0 ' Previous pointer (for lost Ptr val in no find)
  14.         OPEN FI$ FOR BINARY SHARED AS FF
  15.         GET$ FF,4,A$
  16.         IxPtr&(FF,1) = CVL(A$) ' first four bytes contains the field length+4
  17.  
  18. GOTO EXITSELECT
  19. PtrIXCLOSE:'    CASE "IXCLOSE"
  20.         V$=LITERAL$(ArgPtr%)
  21.     FF=VAL(POPARG$)
  22.         CLOSE #FF
  23.         VCLEAR V$
  24.         IxPtr&(FF,0)=0
  25.         IxPtr&(FF,1)=0
  26.         IxPtr&(FF,2)=0
  27.         IxPtr&(FF,3)=0
  28.  
  29. GOTO EXITSELECT
  30. PtrREST:'       CASE "REST"
  31.     RestFlag%=%True
  32.  
  33. GOTO EXITSELECT
  34. PtrIXSCAN:'     CASE "IXSCAN"
  35.         FF=VAL(POPARG$)
  36.         S$=UCASE$(POPARG$)
  37.      temp=0
  38.      IF LEN(S$) THEN
  39.         SEEK FF,IxPtr&(FF,1)+1
  40.         IF RestFlag% THEN
  41.          R&=IXPtr&(FF,0)
  42.          RestFlag%=0
  43.          SEEK FF,(IxPtr&(FF,0) * IxPtr&(FF,1))+1
  44.         ELSE
  45.          R&=0
  46.         END IF
  47.        DO
  48.         INCR R&
  49.         GET$ FF,IxPtr&(FF,1),I$
  50.         IF INSTR(I$,S$) THEN
  51.                 IxPtr&(FF,3)=IxPtr&(FF,0)
  52.                 IxPtr&(FF,0)=R&
  53.                 IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  54.                 PUSHARG STR$(IxPtr&(FF,2))
  55.                 Temp=1
  56.             EXIT LOOP
  57.     END IF
  58.        IF INSTAT OR COMChars% THEN IF BOZOINKEY$=CHR$(27) THEN PUSHARG "0":EXIT LOOP
  59.        LOOP WHILE NOT EOF(FF)
  60.        END IF
  61.     IF TEMP=0 THEN PUSHARG "0"
  62.  
  63. GOTO EXITSELECT
  64. PtrIXFIND:'     CASE "IXFIND"
  65. FF=VAL(POPARG$)
  66. S$=UCASE$(POPARG$)
  67. IF LEN(S$) THEN
  68. IXPtr&(FF,3)=IXPtr&(FF,0)
  69. IxPtr&(FF,0) = (LOF(FF) \ (IxPtr&(FF,1)) \ 2): '  start in the middle of index TRG
  70. HalfIxPtr& = IxPtr&(FF,0)
  71. DO
  72. HalfIxPtr& = ((HalfIxPtr& - 1) \ 2) + 1
  73. IF IxPtr&(FF,0) < 1 THEN LET IxPtr&(FF,0) = 1
  74. IF IxPtr&(FF,0) > (LOF(FF) \ IxPtr&(FF,1)) THEN LET IxPtr&(FF,0) = (LOF(FF) \ (IxPtr&(FF,1)))
  75. SEEK #FF, (IxPtr&(FF,0) * (IxPtr&(FF,1))) - (IxPtr&(FF,1)) + 1
  76. GET$ #FF, IxPtr&(FF,1), I$
  77. IF INSTR(I$,S$) = 1 THEN EXIT DO
  78.  
  79. IF S$ > I$ THEN IxPtr&(FF,0) = IxPtr&(FF,0) + HalfIxPtr&
  80. IF S$ < I$ THEN IxPtr&(FF,0) = IxPtr&(FF,0) - HalfIxPtr&
  81.  
  82. IF HalfIxPtr& <= 1 THEN incr Flag
  83. LOOP WHILE Flag < 3
  84.  
  85. IF Flag => 3 THEN PUSHARG "0":IXPtr&(FF,0)=IXPtr&(FF,3):GOTO EndIXFindSub
  86.  
  87. DO
  88. IF IxPtr&(FF,0) = 1 THEN EXIT DO
  89. DECR IxPtr&(FF,0)
  90.  
  91. SEEK #FF, (IxPtr&(FF,0) * (IxPtr&(FF,1))) - (IxPtr&(FF,1)) + 1
  92. GET$ #FF, IxPtr&(FF,1), I$
  93. IF INSTR(S$,I$) <> 1 THEN INCR IxPtr&(FF,0): EXIT DO
  94. LOOP WHILE IxPtr&(FF,0) > 0
  95.  
  96. SEEK #FF, (IxPtr&(FF,0) * (IxPtr&(FF,1)))-(IxPtr&(FF,1))+1
  97. GET$ #FF, IxPtr&(FF,1), I$
  98. IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  99. DECR IxPtr&(FF,0),2 ' adjust
  100. PUSHARG STR$(IxPtr&(FF,2))
  101.  
  102. ENDIXFINDSUB:
  103. END IF
  104.  
  105. GOTO EXITSELECT
  106. PtrIXSKIP:'     CASE "IXSKIP"
  107.         FF=VAL(POPARG$)
  108.         sk&=VAL(POPARG$)
  109.  
  110.         IxPtr&(FF,3)=IxPtr&(FF,0)
  111.         IxPtr&(FF,0)=IxPtr&(FF,0)+Sk&
  112.         SEEK FF,1+(IxPtr&(FF,0)*IxPtr&(FF,1))
  113.         GET$ FF,IxPtr&(FF,1),I$
  114.         IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  115.         PUSHARG STR$(IxPtr&(FF,2))
  116.  
  117. GOTO EXITSELECT
  118. PtrIXPREV:'     CASE "IXPREV"
  119.         FF=VAL(POPARG$)
  120.         sk&=-1
  121.  
  122.         IxPtr&(FF,3)=IxPtr&(FF,0)
  123.         IxPtr&(FF,0)=IxPtr&(FF,0)+Sk&
  124.         SEEK FF,1+(IxPtr&(FF,0)*IxPtr&(FF,1))
  125.         GET$ FF,IxPtr&(FF,1),I$
  126.         IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  127.         PUSHARG STR$(IxPtr&(FF,2))
  128. GOTO EXITSELECT
  129. PtrIXNEXT:'     CASE "IXNEXT"
  130.         FF=VAL(POPARG$)
  131.         sk&=1
  132.  
  133.         IxPtr&(FF,3)=IxPtr&(FF,0)
  134.         IxPtr&(FF,0)=IxPtr&(FF,0)+Sk&
  135.         SEEK FF,1+(IxPtr&(FF,0)*IxPtr&(FF,1))
  136.         GET$ FF,IxPtr&(FF,1),I$
  137.         IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  138.         PUSHARG STR$(IxPtr&(FF,2))
  139.  
  140. GOTO EXITSELECT
  141. PtrIXTOP:'      "IXFIRST"        CASE "IXTOP","IXFIRST"
  142.         FF=VAL(POPARG$)
  143.  
  144.         IxPtr&(FF,3)=IxPtr&(FF,0)
  145.         IxPtr&(FF,0)=1
  146.         SEEK FF,1+(IxPtr&(FF,0)*IxPtr&(FF,1))
  147.         GET$ FF,IxPtr&(FF,1),I$
  148.         IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  149.         PUSHARG STR$(IxPtr&(FF,2))
  150.  
  151. GOTO EXITSELECT
  152. PtrIXBOTTOM:'    "IXLAST"        CASE "IXBOTTOM", "IXLAST"
  153.         FF=VAL(POPARG$)
  154.  
  155.  
  156.         IxPtr&(FF,3)=IxPtr&(FF,0)
  157.         IxPtr&(FF,0)=(LOF(FF)\IxPtr&(FF,1))-1
  158.         SEEK FF,1+(IxPtr&(FF,0)*IxPtr&(FF,1))
  159.         GET$ FF,IxPtr&(FF,1),I$
  160.         IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  161.         PUSHARG STR$(IxPtr&(FF,2))
  162.  
  163. GOTO EXITSELECT
  164. PtrIXEOF:'      CASE "IXEOF"
  165.         FF=VAL(POPARG$)
  166.         IF IxPtr&(FF,0)=(LOF(FF)\IxPtr&(FF,1))-1 THEN PUSHARG "-1" ELSE PUSHARG "0"
  167. GOTO EXITSELECT
  168. PtrIXBOF:'      CASE "IXBOF"
  169.     FF=VAL(POPARG$)
  170.         IF IxPtr&(FF,0)=1 THEN PUSHARG "-1" ELSE PUSHARG "0"
  171.  
  172. GOTO EXITSELECT
  173. PtrIX:' CASE "IX"
  174.         PUSHARG STR$(IxPtr&(FF,2))
  175.  
  176. GOTO EXITSELECT
  177. PtrIXWAS:'      CASE "IXWAS"
  178.         IF IxPtr&(FF,3)>0 THEN
  179.         IxPtr&(FF,0)=IxPtr&(FF,3)
  180.         SEEK FF,1+(IxPtr&(FF,0)*IxPtr&(FF,1))
  181.         GET$ FF,IxPtr&(FF,1),I$
  182.         IxPtr&(FF,2)=CVL(RIGHT$(I$,4))
  183.         PUSHARG STR$(IxPtr&(FF,2))
  184.         ELSE
  185.         PUSHARG "0"
  186.         END IF
  187.  
  188. GOTO EXITSELECT
  189. PtrIXSTITCH:'   ' IXSTITCH indexname, data, recordnumber, (length)        CASE "IXSTITCH" ' IXSTITCH indexname, data, recordnumber, (length)
  190.         FF=FREEFILE
  191.         Fi$=POPARG$
  192.         D$=POPARG$
  193.         R&=VAL(POPARG$)
  194.         IF ArgPtr% THEN L=VAL(POPARG$)
  195.         IF DIR$(Fi$)<>"" THEN
  196.                 OPEN Fi$ FOR BINARY SHARED AS FF
  197.                 GET$ FF,4,A$
  198.                 L=CVL(A$)
  199.         ELSE
  200.                 OPEN Fi$ FOR BINARY SHARED AS FF
  201.                 PUT$ FF, MKL$(R&)+SPACE$(L-4)
  202.         END IF
  203.         SEEK FF,LOF(FF)
  204.         IF LEN(D$)<L-4 THEN D$=D$+SPACE$((L-4)-LEN(D$))
  205.         IF LEN(D$)>L-4 THEN D$=LEFT$(D$,L-4)
  206.         PUT$ FF, D$+MKL$(R&)
  207.         CLOSE FF
  208.  
  209.  
  210. GOTO EXITSELECT
  211. PtrIXCREATE:'   'IXCREATE filename, fieldname FROM filebuffer        CASE "IXCREATE" 'IXCREATE filename, fieldname FROM filebuffer
  212.     FF=FREEFILE                     'buffer for index
  213.         Fi$=POPARG$                     'index file name
  214.         VM$=LITERAL$(ArgPtr%)           'literal map var name
  215.         DUMMY$=POPARG$
  216.         VL$=LEFT$(VM$,INSTR(VM$,".")-1) 'map field
  217.         IF VL$="" THEN ERROR 103        'bad map variable
  218.         VS$=MID$(VM$,INSTR(VM$,".")+1)+"$"+VL$ ' field name
  219.      ARRAY SCAN VAR$(1),COLLATE UCASE, =VS$, TO i% 'find field var
  220.         IF i% THEN
  221.              O%=CVI(LEFT$(VALUE$(i%),2)) ' establish field position
  222.                  L%=CVI(RIGHT$(VALUE$(i%),2)) ' establish field length
  223.                  ELSE
  224.                   ERROR 103             ' bad map
  225.                  END IF
  226.         ARRAY SCAN VAR$(1),COLLATE UCASE,=VL$, TO i% 'find VALUE$(i%)
  227.         IF i%=0 THEN ERROR 103         'map var not found
  228.  
  229.         FB=VAL(POPARG$)         'file buffer for database
  230.         OPEN Fi$ FOR OUTPUT AS #FF      'prepare to write to index file
  231.  
  232.         'PRINT #FF,MKL$(L%+4)+SPACE$(L%); ' create header (take this out)
  233.         PRINT #FF, STRING$(L%+4,0); ' space header prior to quiksort
  234.         HDR$=MKL$(L%+4)+SPACE$(L%) ' save header
  235.         FOR R&=1 TO LOF(FB)\LEN(VALUE$(i%)) ' rec 1 through endrec
  236.         GET #FB,R&,VALUE$(i%)    'get record
  237.                 FLD$=MID$(VALUE$(i%),O%,L%)
  238.                 PRINT #FF, FLD$+MKL$(R&);
  239.     NEXT R&
  240.         CLOSE #FF
  241.         QUIKSORT Fi$,L%+4
  242.         OPEN Fi$ FOR BINARY AS #FF
  243.         PUT$ #FF, HDR$
  244.         CLOSE #FF
  245.  
  246. GOTO EXITSELECT
  247. PtrIXRESORT:'   CASE "IXRESORT"
  248.  
  249. GOTO EXITSELECT
  250. PtrIXUPDATE:'   CASE "IXUPDATE"
  251.  
  252. GOTO EXITSELECT
  253. PtrIXDELETE:'   CASE "IXDELETE"
  254.