home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / SORTOR1.ZIP / SORTOR.TXT
Text File  |  1990-09-18  |  2KB  |  89 lines
  1. SUB CompressSort STATIC
  2.   DIM Option$(3)
  3.   
  4.   ClearBottom
  5.   Option$(1) = "Compress and Sort Database"
  6.   Option$(2) = "Compress Only"
  7.   Option$(3) = "Return to Main Menu"
  8.   
  9.   Menu = OptionMenu(Option$(), 1, ":1:", Scan)
  10.   IF Scan THEN EXIT SUB
  11.   ClearBottom
  12.   
  13.   SELECT CASE Menu
  14.     CASE 1
  15.       LoadBase 0
  16.       IF ErrorOccured THEN EXIT SUB
  17.       ClearBottom
  18.       Rec$ = ""
  19.       FOR Kount = 1 TO FieldKount
  20.         Rec$ = Rec$ + TypeMask$(FInfo(Kount).FType, FInfo(Kount).Length)
  21.       NEXT Kount
  22.       
  23.       FieldNum = SelectField(Rec$)
  24.       IF FieldNum = 0 THEN
  25.         CLOSE
  26.         FOR Kount = 3 TO 19
  27.           LOCATE Kount, 2: PRINT SPACE$(78);
  28.         NEXT Kount
  29.         EXIT SUB
  30.       END IF
  31.       Start = FInfo(FieldNum).Start
  32.       Length = FInfo(FieldNum).Length
  33.       ClearBottom
  34.     CASE 2
  35.       LoadBase 1
  36.       IF ErrorOccured THEN EXIT SUB
  37.     CASE 3
  38.       EXIT SUB
  39.   END SELECT
  40.   
  41.   LOCATE 21, 3: PRINT "Compressing Database...";
  42.   OPEN Filename$ + ".TMP" FOR RANDOM AS 2 LEN = BaseLen
  43.   FIELD #2, BaseLen AS Record2$
  44.   
  45.   FOR Kount = 1 TO RecordKount
  46.     GET #1, Kount
  47.     IF LEFT$(Record$, 1) <> CHR$(255) THEN
  48.       LSET Record2$ = Record$
  49.       PUT #2
  50.     END IF
  51.   NEXT Kount
  52.   
  53.   IF Menu = 1 THEN
  54.     ClearBottom
  55.     LOCATE 21, 3: PRINT "Sorting Database...";
  56.     RecordKount = LOF(2) \ BaseLen
  57.     Offset = RecordKount \ 2
  58.     DO WHILE Offset > 0
  59.       Limit = RecordKount - Offset
  60.       DO
  61.         Switch = 0
  62.         FOR Kount = 1 TO Limit
  63.           GET #2, Kount
  64.           Sort$ = Record2$
  65.           GET #2, Kount + Offset
  66.           Sort1$ = Record2$
  67.           IF MID$(Sort$, Start, Length) > MID$(Sort1$, Start, Length) THEN
  68.             LSET Record2$ = Sort1$
  69.             PUT #2, Kount
  70.             LSET Record2$ = Sort$
  71.             PUT #2, Kount + Offset
  72.             Switch = Kount
  73.           END IF
  74.         NEXT Kount
  75.         Limit = Switch - Offset
  76.       LOOP WHILE Switch
  77.       Offset = Offset \ 2
  78.     LOOP
  79.     
  80.     FOR Kount = 3 TO 19
  81.       LOCATE Kount, 2: PRINT SPACE$(78);
  82.     NEXT Kount
  83.   END IF
  84.   
  85.   CLOSE
  86.   KILL Filename$ + ".DAT"
  87.   NAME Filename$ + ".TMP" AS Filename$ + ".DAT"
  88. END SUB
  89.