home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / PROWHO18.ZIP / PROWHO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-19  |  4.3 KB  |  183 lines
  1.  
  2. (*
  3.  * ProWho.PAS - Door to answer the question: Who uploaded that file?
  4.  *
  5.  * (C) 1988 Samuel H, Smith (05-Feb-88)
  6.  *
  7.  * revision history:
  8.  *   2-19-88  initial coding
  9.  *
  10.  *)
  11.  
  12. {$M 10000,10000,10000}  {Stack, minheap, maxheap}
  13. {$V-}                   {Relax string rules}
  14.  
  15. Program WhoUploaded;
  16.  
  17. {$i prokit.inc}    {include standard 'uses' statement}
  18.  
  19. const
  20.    version = 'ProWho v1.8ß, 04-08-90 (C)1990 S.H.Smith';
  21.  
  22.    shortest = 2;        {shortest search key allowed}
  23.  
  24. var
  25.    buffer:              array[1..20480] of char;
  26.  
  27.    driver:              string;   {driver type; taken care of automatically}
  28.    download_file:       string;   {download listing file}
  29.    welcome_file:        string;   {welcome message file}
  30.    menu_file:           string;   {main menu file}
  31.    close_file:          string;   {closing message file}
  32.  
  33.  
  34. (* ---------------------------------------------------------------- *)
  35. procedure load_info;
  36.    {load the latest configuration file}
  37. var
  38.    fd: text;
  39. begin
  40.    assignText(fd,config_file);
  41.    reset(fd);
  42.    readln(fd,driver);
  43.    readln(fd,download_file);
  44.    readln(fd,welcome_file);
  45.    readln(fd,menu_file);
  46.    readln(fd,close_file);
  47.    close(fd);
  48. end;
  49.  
  50.  
  51. (* ---------------------------------------------------------------- *)
  52. procedure locate_file(name: string);
  53.    {$i \tinc\bline.inc}
  54. var
  55.    table:  Btable;
  56.    fd:     text;
  57.    line:   string;
  58.    uline:  string;
  59.    i:      integer;
  60.    recs:   integer;
  61.    downs:  integer;
  62.    ups:    integer;
  63.    hits:   integer;
  64.  
  65.    procedure scanfile;
  66.    begin
  67.       MakeTable(name,table);
  68.  
  69.       while true do
  70.       begin
  71.          qReadLn(fd,line,sizeof(line));
  72.          if dump_user or (line[1] = ^Z) then exit;
  73.  
  74.          inc(recs);
  75.          if (recs mod 300) = 0 then
  76.          begin
  77.             if nomore then exit;
  78.             disp('.');
  79.          end;
  80.  
  81.          i := BMsearch(line[1],length(line), table, name);
  82.          if i > 0 then
  83.          begin
  84.             if nomore then exit;
  85.  
  86.             displn(^M+aWHITE+copy(line,1,i-1)+
  87.                       aRED  +name+
  88.                       aWHITE+copy(line,i+length(name),255));
  89.  
  90.             inc(hits);
  91.             if pos('(U)',uline) > 0 then inc(ups);
  92.             if pos('(D)',uline) > 0 then inc(downs);
  93.          end;
  94.  
  95.       end;
  96.    end;
  97.  
  98. begin
  99.    AssignText(fd,download_file);
  100.    {$i-} reset(fd); {$i+}
  101.    if ioresult <> 0 then
  102.    begin
  103.       displn(aRED+'Can''t access data file.  Sorry!');
  104.       exit;
  105.    end;
  106.  
  107.    SetTextBuf(fd,buffer);
  108.    downs := 0;
  109.    ups := 0;
  110.    hits := 0;
  111.    recs := 0;
  112.    stoupper(name);
  113.    make_log_entry('Searching for ('+name+') ...',true);
  114.    newline;
  115.  
  116.    scanfile;
  117.  
  118.    close(fd);
  119.    newline;
  120.  
  121.    disp(aGREEN+itoa(recs)+' entries scanned, '+itoa(hits)+' matches');
  122.    if ups > 0 then   disp(', '+itoa(ups)+' uploads');
  123.    if downs > 0 then disp(', '+itoa(downs)+' downloads');
  124.    displn('.');
  125.  
  126.    newline;
  127. end;
  128.  
  129.  
  130. (* ---------------------------------------------------------------- *)
  131. procedure main_menu;
  132.    {main procedure}
  133. begin
  134.  
  135.    repeat
  136.       force_enter;
  137.       display_file(menu_file);
  138.  
  139.       display_time_left;
  140.       disp('Enter the Text to Scan for: (Q)=quit? ');
  141.  
  142.       get_cmdline;              {get cmdline, map to upper case}
  143.       newline;
  144.  
  145.       if cmdline = 'Q' then
  146.          exit;
  147.  
  148.       if length(cmdline) < shortest then
  149.          displn('Please enter a longer search key!')
  150.       else
  151.       if is_wild(cmdline) then
  152.          displn('Wildcards won''t work!  Use keywords only.')
  153.       else
  154.          locate_file(cmdline);
  155.  
  156.    until dump_user or (minutes_left < 1);
  157.  
  158. end;
  159.  
  160.  
  161. (* ---------------------------------------------------------------- *)
  162.  
  163. begin  {main block}
  164.    init;     {must be first - opens com port, loads setup and user data}
  165.  
  166.    newline;
  167.    displn(version);
  168.    load_color_constants('PROCOLOR');
  169.                             {use 'PROCOLOR' to redefine colors; defaults used
  170.                              if this file is missing}
  171.  
  172.    progname := 'ProWho';    {program name on status line, must be 7 characters}
  173.    load_info;               {load info from config file}
  174.  
  175.    display_file(welcome_file);
  176.  
  177.    main_menu;              
  178.    display_file(close_file);
  179.  
  180.    uninit;   {must be last - closes com port and updates database}
  181. end.
  182.  
  183.