home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DPSX / TOOL-PAS.ZIP / BINDEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-05-17  |  7.2 KB  |  258 lines
  1.  
  2. (*
  3.  * bIndex - Simple binary index lookup unit
  4.  *
  5.  * Samuel H. Smith, 5/17/90
  6.  *
  7.  *)
  8.  
  9. unit bIndex;
  10.  
  11. interface
  12.  
  13.    uses mdosio,dosmem;
  14.  
  15.    const
  16.       indexNotFound = -1;        {value of fpos when match fails}
  17.  
  18.    type
  19.       (* custom key compare function *)
  20.       compare_function = function (k1,k2: string): integer;
  21.  
  22.       (* file/key type codes *)
  23.       key_types = (StringKey, DateKey);
  24.  
  25.       (* index file header record *)
  26.       bindex_header = record
  27.          keysize: byte;          {actual key size in the file}
  28.          keytype: key_types;     {the type of key/special processing codes}
  29.          recsize: word;          {total record size within bindex file}
  30.       end;
  31.  
  32.       (* this record is passed/returned to process an entry in a bIndex file *)
  33.       bindex_rec = record
  34.          fpos:    longint;       {data file position of this key}
  35.          fid:     longint;       {file identifier of this key (conf/dir, etc.)}
  36.          key:     string;        {the actual key string, fixed size in file}
  37.       end;
  38.  
  39.       (* this record describes an open bIndex file *)
  40.       bindex_handle = record
  41.          dosfd:   dos_handle;    {the dos handle for this file}
  42.          compf:   compare_function;
  43.          hdr:     bindex_header; {the file header record}
  44.          rec:     bindex_rec;    {current index position/record}
  45.          ixpos:   longint;       {current file position in index file}
  46.          ixend:   longint;       {eof position of index file}
  47.          match:   string;        {current key value to match}
  48.          cmp:     integer;       {comparison of current key -1,0,1}
  49.          exact:   boolean;       {require exact matches?}
  50.       end;
  51.  
  52.  
  53.    procedure CreateIndex(  var fd:  bindex_handle;
  54.                            fname:   dos_filename );
  55.  
  56.    procedure OpenIndex(    var fd:  bindex_handle;
  57.                            fname:   dos_filename );
  58.  
  59.    procedure CloseIndex(   var fd:  bindex_handle );
  60.  
  61.    procedure FindKey(      var fd:  bindex_handle );
  62.  
  63.    procedure FindExactKey( var fd:  bindex_handle );
  64.  
  65.    procedure FindNext(     var fd:  bindex_handle );
  66.  
  67.    procedure AddKey(       var fd:  bindex_handle );
  68.  
  69.    procedure DeleteKey(    var fd:  bindex_handle );
  70.  
  71.    function StringCompare (k1,k2: string): integer;
  72.  
  73.  
  74. implementation
  75. function ixn(var fd: bindex_handle): word;
  76. begin
  77.    ixn := (fd.ixpos-sizeof(bindex_header)) div fd.hdr.recsize;
  78. end;
  79.  
  80.    (* -------------------------------------------------------- *)
  81.    procedure CreateIndex(  var fd:  bindex_handle;
  82.                            fname:   dos_filename );
  83.    begin
  84.       fd.dosfd := dos_create(fname);
  85.       fd.hdr.recsize := sizeof(bindex_rec)-sizeof(string)+fd.hdr.keysize+1;
  86.       dos_write(fd.dosfd,fd.hdr,sizeof(bindex_header));
  87.       dos_close(fd.dosfd);
  88.    end;
  89.  
  90.  
  91.    (* -------------------------------------------------------- *)
  92.    procedure OpenIndex(    var fd:  bindex_handle;
  93.                            fname:   dos_filename );
  94.    var
  95.       n: integer;
  96.  
  97.    begin
  98.       fd.dosfd := dos_open(fname,open_update);
  99.       n := dos_read(fd.dosfd,fd.hdr,sizeof(bindex_header));
  100.       dos_lseek(fd.dosfd,0,seek_end);
  101.       fd.ixend := dos_tell;
  102.       fd.compf := StringCompare;
  103.       fillchar(fd.rec,sizeof(fd.rec),0);
  104.    end;
  105.  
  106.  
  107.    (* -------------------------------------------------------- *)
  108.    procedure CloseIndex(   var fd:  bindex_handle );
  109.    begin
  110.       dos_close(fd.dosfd);
  111.    end;
  112.  
  113.  
  114.    (* -------------------------------------------------------- *)
  115.    procedure FindKey(      var fd:  bindex_handle );
  116.    var
  117.       fcur:    longint;
  118.       fmin:    longint;
  119.       fmax:    longint;
  120.       recn:    word;
  121.       n:       integer;
  122.  
  123.    begin
  124.       fd.exact := false;
  125.       fmin := sizeof(bindex_header);
  126.       fmax := fd.ixend-fd.hdr.recsize;
  127.       fd.ixpos := fmax;
  128.  
  129.       while fmax >= fmin do
  130.       begin
  131.          {compute next position to try}
  132.          recn := (fmax-fmin) div fd.hdr.recsize;
  133.          fd.ixpos := fmin + (recn div 2)*fd.hdr.recsize;
  134.  
  135.          {read the selected index record}
  136.          dos_lseek(fd.dosfd,fd.ixpos,seek_start);
  137.          n := dos_read(fd.dosfd,fd.rec,fd.hdr.recsize);
  138.  
  139.          {decide action based on comparison result}
  140.          fd.cmp := fd.compf(fd.rec.key,fd.match);
  141.          if (fd.cmp <> 0) and (fmax=fmin) then
  142.             exit;
  143.  
  144.          case fd.cmp of
  145.             1:    fmax := fd.ixpos-fd.hdr.recsize;
  146.  
  147.             0:    exit;
  148.  
  149.            -1:    fmin := fd.ixpos+fd.hdr.recsize;
  150.          end;
  151.       end;
  152.  
  153.       {not found when we use what was last seen}
  154.    end;
  155.  
  156.  
  157.    (* -------------------------------------------------------- *)
  158.    procedure FindExactKey( var fd:  bindex_handle );
  159.    begin
  160.       FindKey(fd);
  161.  
  162.       {not found when we cancel current position}
  163.       fd.exact := true;
  164.       if fd.cmp <> 0 then
  165.          fd.ixpos := indexNotFound;
  166.    end;
  167.  
  168.  
  169.    (* -------------------------------------------------------- *)
  170.    procedure FindNext(     var fd:  bindex_handle );
  171.    var
  172.       n: integer;
  173.    begin
  174.       if fd.ixpos = indexNotFound then exit;
  175.  
  176.       inc(fd.ixpos,fd.hdr.recsize);
  177.       dos_lseek(fd.dosfd,fd.ixpos,seek_start);
  178.       n := dos_read(fd.dosfd,fd.rec,fd.hdr.recsize);
  179.  
  180.       fd.cmp := fd.compf(fd.rec.key,fd.match);
  181.       if (n = 0) or (fd.exact and (fd.cmp <> 0)) then
  182.          fd.ixpos := indexNotFound;
  183.    end;
  184.  
  185.  
  186.    (* -------------------------------------------------------- *)
  187.    procedure AddKey(       var fd:  bindex_handle );
  188.    const
  189.       bufsize = $F000;
  190.    var
  191.       copysize:   longint;
  192.       copypos:    longint;
  193.       cursize:    word;
  194.       buf:        ^char;
  195.       n:          word;
  196.       rec:        bindex_rec;
  197.  
  198.    begin
  199.       rec := fd.rec;
  200.       if fd.ixend = sizeof(bindex_header) then
  201.          fd.ixpos := fd.ixend
  202.       else
  203.       begin
  204.          fd.match := fd.rec.key;
  205.          FindKey(fd);
  206.          if fd.cmp = -1 then
  207.             inc(fd.ixpos,fd.hdr.recsize);
  208.       end;
  209.  
  210.       copysize := fd.ixend-fd.ixpos{-fd.hdr.recsize};
  211.       if copysize > 0 then
  212.       begin
  213.          dos_getmem(buf,bufsize);
  214.  
  215.          repeat
  216.             if copysize > bufsize then
  217.                cursize := bufsize
  218.             else
  219.                cursize := copysize;
  220.             copypos := fd.ixpos+copysize-cursize;
  221.  
  222.             dos_lseek(fd.dosfd,copypos,seek_start);
  223.             n := dos_read(fd.dosfd,buf^,cursize);
  224.  
  225.             dos_lseek(fd.dosfd,copypos+fd.hdr.recsize,seek_start);
  226.             dos_write(fd.dosfd,buf^,cursize);
  227.             dec(copysize,cursize);
  228.          until copysize = 0;
  229.  
  230.          dos_freemem(buf);
  231.       end;
  232.  
  233.       dos_lseek(fd.dosfd,fd.ixpos,seek_start);
  234.       dos_write(fd.dosfd,rec,fd.hdr.recsize);
  235.       inc(fd.ixend,fd.hdr.recsize);
  236.    end;
  237.  
  238.  
  239.    (* -------------------------------------------------------- *)
  240.    procedure DeleteKey(    var fd:  bindex_handle );
  241.    begin
  242.    end;
  243.  
  244.  
  245.    (* -------------------------------------------------------- *)
  246.    function StringCompare (k1,k2: string): integer;
  247.    begin
  248.       if k1 > k2 then
  249.          StringCompare := 1
  250.       else
  251.       if k1 < k2 then
  252.          StringCompare := -1
  253.       else
  254.          StringCompare := 0;
  255.    end;
  256. end.
  257.  
  258.