home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PRONTDEM.ZIP / PRONTO.ZIP / WHERE / WHERE.BAS < prev    next >
BASIC Source File  |  1991-02-21  |  12KB  |  421 lines
  1. REM $INCLUDE: 'PRONTO.INC'
  2.  
  3. DEFINT A-Z
  4.  
  5. CONST EOFTYPE = 0, FILETYPE = 1, DIRTYPE = 2, ROOT = "TWH"
  6.  
  7. DECLARE SUB StringAssign(BYVAL SrcAdd&, BYVAL SrcLen%, BYVAL DstSeg%, BYVAL DstOff%, BYVAL DstLen%)
  8. DECLARE FUNCTION StrMake$ (stradd&, strlen%)
  9. DECLARE FUNCTION BasWndProc% (msg%, mp1&, mp2&)
  10. DECLARE FUNCTION Dialog00& (hdlg&, msg%, mp1&, mp2&)
  11. DECLARE FUNCTION Dialog01& (hdlg&, msg%, mp1&, mp2&)
  12. DECLARE SUB ScanDir (PathSpec$, Level, FileSpec$, Row, hdlg&)
  13. DECLARE FUNCTION MakeFileName$ (Num)
  14. DECLARE FUNCTION GetEntry$ (FileNum, EntryType)
  15. DECLARE FUNCTION IsLeapYear% (N%)
  16. DECLARE FUNCTION GetInput% (Prompt$, Row%, LowVal%, HighVal%)
  17. DECLARE SUB PrintCalendar (Year%, Month%)
  18. DECLARE SUB ComputeMonth (Year%, Month%, StartDay%, TotalDays%)
  19. DECLARE SUB myPrint (aStr$, aCol%, aRow%, aClr%)
  20.  
  21. ' Define a data type for the names of the months and the
  22. ' number of days in each:
  23. TYPE MonthType
  24.     Number AS INTEGER  ' Number of days in the month
  25.     MName AS STRING * 9   ' Name  of the month
  26. END TYPE
  27.  
  28.  
  29. DIM MonthData(1 TO 12)   AS MonthType
  30. '
  31. ' Initializations
  32. '
  33. DIM mallocbuf%(8192)
  34.  
  35. COMMON SHARED /NMALLOC/ mallocbuf%()
  36. COMMON SHARED pathspec$, year$, month$
  37.  
  38. ' Initialize month definitions from DATA statements below:
  39. FOR I = 1 TO 12
  40.     READ MonthData(I).MName, MonthData(I).Number
  41. NEXT
  42.  
  43. '
  44. b% = ProntoPM
  45. b% = BStartPMWork
  46. q% = BCreateWindow
  47. b% = BStopPMWork%
  48. END
  49.  
  50. '
  51. ' Window Procedure
  52. '
  53. FUNCTION BasWndProc% (msg%, mp1&, mp2&) STATIC
  54. BasWndProc% = 0
  55.   SELECT CASE msg%
  56.     CASE WMCREATE
  57.       b% = BSetAccelTable%(701)
  58.       eb& = BMenu&(501, SSEGADD(Titolo$))
  59.  
  60.     CASE WMCOMMAND
  61.       CALL BreakLong(mp1&, hiword%, loword%)
  62.       Call ProcessCommand(loword%)
  63.  
  64.     CASE ELSE
  65.       ' Default processing
  66.       BasWndProc% = 0
  67.   END SELECT
  68. END FUNCTION
  69.  
  70. SUB ProcessCommand(Item%)
  71.   SELECT CASE Item%
  72.     CASE 503
  73.       b% = BDialog(256, 0)
  74.     CASE 504
  75.       b% = BDialog(263, 1)
  76.     CASE 505
  77.       b% = BDialog(262, 2)
  78.   END SELECT
  79. END SUB
  80.  
  81. 'IDD_SRCFILE   260
  82. 'IDD_SRCPATH   259
  83. 'IDD_SEARCH    258
  84. 'IDD_MATCHES   257
  85. 'SEARCH_FILE   256
  86. 'IDD_SEARCHING 261
  87.  
  88. FUNCTION Dialog00& (hdlg&, msg%, mp1&, mp2&) STATIC
  89. Dialog00& = 0
  90.   SELECT CASE msg%
  91.     CASE WMINITDLG
  92.       PathSpec$ = Curdir$ + chr$(0)
  93.       FileSpec$ = "" + chr$(0)
  94.       b = BWriteEditControl(hdlg&, 259, SSEGADD(PathSpec$))
  95.       b = BWriteEditControl(hdlg&, 260, SSEGADD(FileSpec$))
  96.       b = BSetFocusOnItem%(hdlg&, 259)
  97.       Dialog00& = 1
  98.     CASE WMCOMMAND
  99.       CALL BreakLong(mp1&, hiword%, loword%)
  100.       SELECT CASE loword%
  101.     CASE 2
  102.       b = BEndDialog%(hdlg&, 1)
  103.       Dialog00& = 1
  104.     CASE 258
  105.       ' Pushed the "Search" Button
  106.       b = BChangePointer(1)
  107.       b = BReadEditControl(hdlg&, 259, StAdd&, StLen%)
  108.       PathSpec$ = StrMake$(StAdd&, StLen%)
  109.  
  110.       b = BReadEditControl(hdlg&, 260, StAdd&, StLen%)
  111.       FileSpec$ = StrMake$(StAdd&, StLen%)
  112.  
  113.       RightCh$ = RIGHT$(PathSpec$, 1)
  114.  
  115.       IF PathSpec$ = "" OR RightCh$ = ":" OR RightCh$ <> "\" THEN
  116.         PathSpec$ = PathSpec$ + "\"
  117.       END IF
  118.  
  119.       FileSpec$ = UCASE$(FileSpec$)
  120.       PathSpec$ = UCASE$(PathSpec$)
  121.       Level = 1
  122.       Row = 3
  123.  
  124.       ' Make the top level call (level 1) to begin the search:
  125.       ScanDir PathSpec$, Level, FileSpec$, Row, hdlg&
  126.  
  127.       KILL ROOT + ".*"  ' Delete all temporary files created
  128.                 ' by the program.
  129.  
  130.       b = BChangePointer(0)
  131.       Dialog00& = 1
  132.     CASE ELSE
  133.       Dialog00& = 1
  134.     END SELECT
  135.     CASE ELSE
  136.       ' Dont't bother about messages
  137.       Dialog00& = 0
  138.   END SELECT
  139. END FUNCTION
  140.  
  141.  
  142. ' IDD_CALMONTH    265
  143. ' IDD_CALYEAR   264
  144. ' CALENDAR      263
  145. FUNCTION Dialog01& (hdlg&, msg%, mp1&, mp2&) STATIC
  146. Dialog01& = 0
  147.   SELECT CASE msg%
  148.     CASE WMINITDLG
  149.       year$ = right$(date$, 4) + chr$(0)
  150.       month$ = left$(date$, 2) + chr$(0)
  151.       b = BWriteEditControl(hdlg&, 264, SSEGADD(year$))
  152.       b = BWriteEditControl(hdlg&, 265, SSEGADD(month$))
  153.       Dialog01& = 1
  154.       b = BSetFocusOnItem%(hdlg&, 1)
  155.     CASE WMCOMMAND
  156.       CALL BreakLong(mp1&, hiword%, loword%)
  157.       SELECT CASE loword%
  158.     CASE 1
  159.       PrintCalendar Val(year$), Val(month$)
  160.       b = BEndDialog%(hdlg&, 1)
  161.       Dialog01& = 1
  162.     CASE 2
  163.       b = BEndDialog%(hdlg&, 0)
  164.       Dialog01& = 1
  165.     CASE ELSE
  166.       Dialog01& = 1
  167.       END SELECT
  168.   CASE ELSE
  169.     Dialog01& = 0
  170.   END SELECT
  171. END FUNCTION
  172.  
  173.  
  174. FUNCTION Dialog02& (hdlg&, msg%, mp1&, mp2&) STATIC
  175. Dialog02& = 0
  176.   SELECT CASE msg%
  177.     CASE WMINITDLG
  178.       Dialog02& = 1
  179.       b = BSetFocusOnItem%(hdlg&, 1)
  180.     CASE WMCOMMAND
  181.       CALL BreakLong(mp1&, hiword%, loword%)
  182.       SELECT CASE loword%
  183.     CASE 1
  184.       b = BWinBeep(3)
  185.       b = BEndDialog%(hdlg&, 1)
  186.       Dialog02& = 1
  187.     CASE ELSE
  188.       Dialog02& = 1
  189.       END SELECT
  190.   CASE ELSE
  191.     Dialog02& = 0
  192.   END SELECT
  193. END FUNCTION
  194.  
  195. ' ======================= GETENTRY ========================
  196. '    This procedure processes entry lines in a DIR listing
  197. '    saved to a file.
  198. '    This procedure returns the following values:
  199. '  GetEntry$   A valid file or directory name
  200. '  EntryType   If equal to 1, then GetEntry$
  201. '        is a file.
  202. '        If equal to 2, then GetEntry$
  203. '        is a directory.
  204. ' =========================================================
  205. FUNCTION GetEntry$ (FileNum, EntryType) STATIC
  206. ' Loop until a valid entry or end-of-file (EOF) is read:
  207. DO UNTIL EOF(FileNum)
  208.   LINE INPUT #FileNum, EntryLine$
  209.   IF EntryLine$ <> "" THEN
  210.     ' Get first character from the line for test:
  211.     TestCh$ = LEFT$(EntryLine$, 1)
  212.     IF TestCh$ <> " " AND TestCh$ <> "." THEN EXIT DO
  213.   END IF
  214. LOOP
  215.  
  216. ' Entry or EOF found, decide which:
  217. IF EOF(FileNum) THEN    ' EOF, so return EOFTYPE
  218.   EntryType = EOFTYPE  ' in EntryType.
  219.   GetEntry$ = ""
  220. ELSE ' Not EOF, so it must be a
  221.      ' file or a directory.
  222.      ' Build and return the entry name:
  223.   EntryName$ = RTRIM$(LEFT$(EntryLine$, 8))
  224.   ' Test for extension and add to name if there is one:
  225.   EntryExt$ = RTRIM$(MID$(EntryLine$, 10, 3))
  226.   IF EntryExt$ <> "" THEN
  227.     GetEntry$ = EntryName$ + "." + EntryExt$
  228.   ELSE
  229.     GetEntry$ = EntryName$
  230.   END IF
  231.   ' Determine the entry type, and return that value
  232.   ' to the point where GetEntry$ was called:
  233.   IF MID$(EntryLine$, 15, 3) = "DIR" THEN
  234.     EntryType = DIRTYPE   ' Directory
  235.   ELSE
  236.     EntryType = FILETYPE  ' File
  237.   END IF
  238. END IF
  239. END FUNCTION
  240.  
  241. ' ===================== MAKEFILENAME$ =====================
  242. '    This procedure makes a file name from a root string
  243. '    ("TWH," defined as a symbolic constant at the module
  244. '    level) and a number passed to it as an argument (Num).
  245. ' =========================================================
  246. FUNCTION MakeFileName$ (Num) STATIC
  247.   MakeFileName$ = ROOT + "." + LTRIM$(STR$(Num))
  248. END FUNCTION
  249.  
  250. ' ======================= SCANDIR =========================
  251. '   This procedure recursively scans a directory for the
  252. '   file name entered by the user.
  253. '   NOTE: The SUB header doesn't use the STATIC keyword
  254. '         since this procedure needs a new set of variables
  255. '         each time it is invoked.
  256. ' =========================================================
  257. SUB ScanDir (PathSpec$, Level, FileSpec$, Row, hdlg&)
  258.  
  259.   text$ = PathSpec$+chr$(0)
  260.   b = BWriteEditControl(hdlg&, 261, SSEGADD(text$))
  261.  
  262.   ' Make a file specification for the temporary file:
  263.   TempSpec$ = MakeFileName$(Level)
  264.  
  265.   ' Get a directory listing of the current directory,
  266.   ' and save it in the temporary file:
  267.   SHELL "DIR " + PathSpec$ + " > " + TempSpec$
  268.  
  269.   ' Get the next available file number:
  270.   FileNum = FREEFILE
  271.  
  272.   ' Open the DIR listing file and scan it:
  273.   OPEN TempSpec$ FOR INPUT AS #FileNum
  274.   ' Process the file, one line at a time:
  275.   DO
  276.     ' Input an entry from the DIR listing file:
  277.     DirEntry$ = GetEntry$(FileNum, EntryType)
  278.     ' If entry is a file:
  279.     IF EntryType = FILETYPE THEN
  280.       ' If the FileSpec$ string matches,
  281.       ' print entry and exit this loop:
  282.       IF DirEntry$ = FileSpec$ THEN
  283.     'add list box entry
  284.     text$ = PathSpec$+DirEntry$+chr$(0)
  285.     b% = BAddListBoxEntry(hdlg&, 257, -1, SSEGADD(text$))
  286.     EntryType = EOFTYPE
  287.       END IF
  288.       ' If the entry is a directory, then make a recursive
  289.       ' call to ScanDir with the new directory:
  290.       ELSEIF EntryType = DIRTYPE THEN
  291.     NewPath$ = PathSpec$ + DirEntry$ + "\"
  292.       ScanDir NewPath$, Level + 1, FileSpec$, Row, hdlg&
  293.       END IF
  294.   LOOP UNTIL EntryType = EOFTYPE
  295.   ' Scan on this DIR listing file is finished, so close it:
  296.   CLOSE FileNum
  297. END SUB
  298.  
  299. FUNCTION StrMake$(stradd&, strlen%)
  300.     Call StringAssign(stradd&, strlen%, VARSEG(S$), VARPTR(S$), 0)
  301.     StrMake$ = S$
  302. END FUNCTION
  303.  
  304. ' ====================== COMPUTEMONTH =====================
  305. '  Computes the first day and the total days in a month
  306. ' =========================================================
  307. '
  308. SUB ComputeMonth (Year, Month, StartDay, TotalDays) STATIC
  309.     SHARED MonthData() AS MonthType
  310.  
  311.     CONST LEAP = 366 MOD 7
  312.     CONST NORMAL = 365 MOD 7
  313.  
  314.     ' Calculate total number of days (NumDays) since 1/1/1899:
  315.  
  316.     ' Start with whole years:
  317.     NumDays = 0
  318.     FOR I = 1899 TO Year - 1
  319.         IF IsLeapYear(I) THEN              ' If leap year,
  320.             NumDays = NumDays + LEAP   ' add 366 MOD 7.
  321.         ELSE                               ' If normal year,
  322.             NumDays = NumDays + NORMAL ' add 365 MOD 7.
  323.         END IF
  324.     NEXT
  325.  
  326.     ' Next, add in days from whole months:
  327.     FOR I = 1 TO Month - 1
  328.         NumDays = NumDays + MonthData(I).Number
  329.     NEXT
  330.  
  331.     ' Set the number of days in the requested month:
  332.     TotalDays = MonthData(Month).Number
  333.  
  334.     ' Compensate if requested year is a leap year:
  335.     IF IsLeapYear(Year) THEN
  336.  
  337.         ' If after February, add one to total days:
  338.         IF Month > 2 THEN
  339.             NumDays = NumDays + 1
  340.  
  341.         ' If February, add one to the month's days:
  342.         ELSEIF Month = 2 THEN
  343.             TotalDays = TotalDays + 1
  344.         END IF
  345.     END IF
  346.  
  347.     ' 1/1/1899 was a Sunday, so calculating "NumDays MOD 7"
  348.     ' gives the day of week (Sunday = 0, Monday = 1, Tuesday
  349.     ' = 2, and so on) for the first day of the input month:
  350.     StartDay = NumDays MOD 7
  351. END SUB
  352.  
  353. ' ====================== ISLEAPYEAR =======================
  354. '   Determines if a year is a leap year or not
  355. ' =========================================================
  356. '
  357. FUNCTION IsLeapYear (N) STATIC
  358.  
  359.     ' If the year is evenly divisible by 4 and not divisible
  360.     ' by 100, or if the year is evenly divisible by 400,
  361.     ' then it's a leap year:
  362.     IsLeapYear = (N MOD 4 = 0 AND N MOD 100 <> 0) OR (N MOD 400 = 0)
  363. END FUNCTION
  364.  
  365. ' ===================== PRINTCALENDAR =====================
  366. '   Prints a formatted calendar given the year and month
  367. ' =========================================================
  368. '
  369. SUB PrintCalendar (Year, Month) STATIC
  370. SHARED MonthData() AS MonthType
  371.  
  372.     CurRow = 1
  373.     LeftMargin = 1
  374.  
  375.     ' Compute starting day (Su M Tu ...)
  376.     ' and total days for the month:
  377.     ComputeMonth Year, Month, StartDay, TotalDays
  378.     b% = Bcls
  379.     Header$ = RTRIM$(MonthData(Month).MName) + "," + STR$(Year)
  380.  
  381.     ' Calculate location for centering month and year:
  382.     LeftMargin = (35 - LEN(Header$)) \ 2
  383. ' Print header:
  384.     text$ = space$(LeftMargin)+Header$+chr$(0)
  385.     myPrint text$, LeftMargin, CurRow, 1
  386.     LeftMargin = 1
  387.     CurRow = 3
  388.     myPRINT "Su", 1, CurRow, 1
  389.     myPRINT "M",  6, CurRow, 1
  390.     myPRINT "Tu", 11, CurRow, 1
  391.     myPRINT "W",  16, CurRow, 1
  392.     myPRINT "Th", 21, CurRow, 1
  393.     myPRINT "F",  26, CurRow, 1
  394.     myPRINT "Sa", 31, CurRow, 1
  395.     ' Recalculate and print tab
  396.     ' to the first day of the month (Su M Tu ...):
  397.     LeftMargin = 5 * StartDay + 1
  398.     CurRow = CurRow + 1
  399.  
  400.     ' Print out the days of the month:
  401.     FOR I = 1 TO TotalDays
  402.         myPRINT right$("  "+str$(i),2), LeftMargin, CurRow, 1
  403.         LeftMargin = LeftMargin+5
  404.         IF LeftMargin > 32 THEN
  405.           CurRow = CurRow + 1
  406.           LeftMargin = 1
  407.         end if
  408.     NEXT
  409.  
  410. END SUB
  411.  
  412. SUB myPrint(aStr$, aCol%, aRow%, aClr%)
  413.     text$ = aStr$ + chr$(0)
  414.     b% = Bxqprint(SSEGADD(text$), aCol%, aRow%, aClr)
  415. END SUB
  416.  
  417. ' Data for the months of a year:
  418. DATA January, 31, February, 28,  March, 31
  419. DATA April, 30,   May, 31, June, 30, July, 31, August, 31
  420. DATA September,   30, October, 31, November, 30, December, 31
  421.