home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / comm / rbbs2.zip / RSB51028.MRG < prev    next >
Text File  |  1990-10-28  |  5KB  |  92 lines

  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against 17.3A\RBBSSUB5.BAS to produce 17.3B\RBBSSUB5.BAS
  3. * 17.3A\RBBSSUB5.BAS:  Date 9-25-1990  Size 92565 bytes
  4. * ------------[ Created 10-28-1990 12:00:01 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. * ------[ first line different ]------
  8. ' $title: 'RBBSSUB5.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003
  9. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  10. '  Name ...............: RBBSSUB5.BAS
  11. '  First Released .....: February 11, 1990
  12. '  Subsequent Releases.: August 26, 1990; October 28, 1990
  13. '  Copyright ..........: 1986 - 1990
  14. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  15. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  16. '     require error trapping are incorporated within RBBSSUB 2-5 as
  17. '     separately callable subroutines in order to free up as much
  18. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  19. '  Parameters..........: Most parameters are passed via a COMMON statement.
  20. '
  21. ' Subroutine  Line               Function of Subroutine
  22. '   Name     Number
  23. '  BinSearch      63520  Binary searches sorted file for a key value
  24. '  BreakFileName  63300  Break file name into component parts
  25. '  BufAsUnit      63500  Buffer out a string with CR's
  26. '  SetPrompt      63470  Set prompts based on the user's security
  27. '  DoorReturn     63100  Process door requests
  28. '  FdMacExe       63462  Executes a found macro
  29. '  FileSystem     20117  File System for RBBS-PC
  30. '  FindIt         63490  Check whether file exists and if so open as #2
  31. '  FormRead       63420  Read from file into a form
  32. '  LockAppend     63400  Prepare for a file append
  33. '  MacroExe       63460  Execute internal macro rather than user
  34. '  MsgNameMatch   63540  Match name to one in msg header
  35. '  NoPath         63480  Detects whether string has a path in it
  36. '  RestoreCom     63310  Restore comm port after external program
  37. '  ReadMacro      63330  Read and process macro
  38. '  ShellExit      63320  Exit RBBS via shell
  39. '  TakeOffHook    63530  Take modem off hook
  40. '  UnLockAppend   63410  Clean up after file append
  41. '  VerifyAns      63510  Verify that string passes edits
  42. '  WildCard       63200  Match string to a pattern
  43. '
  44. '  $INCLUDE: 'RBBS-VAR.BAS'
  45. '
  46. * REPLACING old line(s) by new
  47. 20163 ZFileName$ = ZFileNameHold$
  48. * ------[ first line different ]------
  49.       CALL BadName (BadFileNameIndex,ZTrue)                          ' KG101201
  50.       ON BadFileNameIndex GOTO 20164,20176
  51. * REPLACING old line(s) by new
  52. * ------[ first line different ]------
  53. 20235 CALL BadName (BadFileNameIndex,ZTrue)                          ' KG101201
  54.       ON BadFileNameIndex GOTO  20236,20245
  55. * REPLACING old line(s) by new
  56. 63520 ' $SUBTITLE: 'BinSearch - binary search a file'
  57. ' $PAGE
  58. '
  59. '  NAME    -- BinSearch
  60. '                                  MEANING
  61. '  INPUTS  -- PassedSearchFor$  Value you are looking for
  62. '             StartPos          Starting position of sort key
  63. '             NumChars          # of characters in sort key
  64. '             LenRec            Length of record of data file searching
  65. '             High              Record # of last record
  66. '             ZFastTabs$        In a binary integer subfield (2 bytes)
  67. '                                  holds 1st record when might find
  68. '                                  a key beginning with a particular
  69. '                                  character (0-9,A-Z).   Empty if
  70. '                                  no Fast Tab exists for the file.
  71. '
  72. '  OUTPUTS -- RecFoundAt        Record # value found at (0 if none)
  73. '             RecFound$         Full data record when found
  74. '
  75. '  PURPOSE -- Binary searches work file #2 for a key value in a
  76. '             data file that is sorted on a key field
  77. '
  78.       SUB BinSearch (PassedSearchFor$,StartPos, NumChars, LenRec, High, RecFoundAt, RecFound$) STATIC
  79.       SearchFor$ = LEFT$(PassedSearchFor$,NumChars)
  80.       SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$))
  81.       FIELD #2, LenRec AS SearchRec$
  82.       Low = 0
  83.       IF LEN(ZFastTabs$) < 72 THEN _
  84.          GOTO 63522
  85.       WasX$ = LEFT$(SearchFor$,1)
  86.       WasX = INSTR("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",WasX$)
  87.       IF WasX > 0 THEN _
  88. * ------[ first line different ]------
  89.          Low = CVI(MID$(ZFastTabs$,1+2*(WasX-1),2)) - 1 : _          ' KG102701
  90.          IF WasX < 36 THEN _                                         ' KG102701
  91.             High = CVI(MID$(ZFastTabs$,1+2*WasX,2))                  ' KG102701
  92.