home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library2 / libmake.bas < prev    next >
Encoding:
BASIC Source File  |  1990-09-27  |  8.5 KB  |  267 lines
  1. 'Note: This is an Include File for MAKE.BAS
  2. 'To create MAKE.EXE, Compile MAKE.BAS
  3. '------------------------------------------------------------------------
  4. 'File: LibMake.Bas
  5. 'Purpose: Library of functions needed for Make utility
  6. '
  7. 'FUNCTION BINTODEC!(BinaryString$) 'RETURNS: Decimal equivelent of binary string
  8. 'SUB DTSTAMP$(FileName$,date$,time$)'RETURNS: Date and Time of last change
  9. 'FUNCTION FIGDATE&(DATE$)          'IN: DATE$ = mm/dd/yy RETURNS: Julian Date
  10. 'FUNCTION FILEEXISTS (FileName$)      'RETURNS: True if file exists
  11. 'FUNCTION GETFILENAME$             'RETURNS:Project main file name
  12. 'FUNCTION JULIAN#(D$,T$)           'RETURNS: pseudo julian time/date stamp
  13. 'SUB NOISE                         'Makes noise
  14. 'SUB WAITING                       'Process hit any key to continue
  15.  
  16. '------------------------------------------------------------------------
  17. DEFINT A-Z
  18. 'Define register constants
  19. %AX=1 : %BX=2 : %CX=3 : %DX=4 : %SI=5 : %DI=6 : %BP=7 : %DS=8 : %ES=9: %FLAGS=0
  20. SUB DTSTAMP(FL$,D$,T$)
  21.    'This sub returns the date and time stamp
  22.    'In: fl$ = file name
  23.    'Out: d$=date as mm/dd/yy
  24.      't$ = time as hr:mn:sc
  25.    '1st open file to get it's handle for next part
  26.    MAP BinBuff$$*16   'This makes sure that binary string is 16 characters
  27.  
  28.    Buf$=FL$+CHR$(0)       'ASCIIZ String
  29.    REG %AX,&H3D02    'DOS Open File Function
  30.    REG %DS, STRSEG(Buf$)
  31.    REG %DX, STRPTR(Buf$)
  32.    CALL INTERRUPT &H21  'Call DOS
  33.    'if not on file, assign a time of 0 so it gets recompilied
  34.    IF (REG(%FLAGS) AND 1) <> 0 THEN D$="00/00/00" :T$="00:00:00":EXIT SUB
  35.    HANDLE = REG(%AX)   'Now AX holds file handle
  36.  
  37.    'Get file date and time
  38.    REG %AX,&H5700   'DOS Get time and date function
  39.    REG %BX,HANDLE   'Handle to file Fl$
  40.    CALL INTERRUPT &H21
  41.    TM= REG(%CX)    'Time (encoded)
  42.    DT = REG(%DX)  'Date (encoded)
  43.  
  44.    'Now close file
  45.    REG %AX,&H3E00  'DOS Close file function
  46.    REG %BX,HANDLE  'BX
  47.    CALL INTERRUPT &H21
  48.  
  49.    'Now uncode date and time
  50.    RSET BinBuff$$=BIN$(TM)   'This insures 16 digits
  51.  
  52.     Hours$ = BinBuff$$
  53.     RSET BinBuff$$=BIN$(DT)
  54.     Dt$ = BinBuff$$
  55.     Hrs%=CINT(BINTODEC!(MID$(Hours$,1,5)))   'Hours
  56.     Mns%=CINT(BINTODEC!(MID$(Hours$,6,6)))   'Minutes
  57.     Scs%=CINT(BINTODEC!(MID$(Hours$,12)))*2  'Seconds were in 2 sec intervals
  58.  
  59.     Yr$ =MID$(Dt$,1,7)
  60.     Yr% = CINT(BINTODEC!(Yr$))+80  'YEAR IS OFFSERT FORM 1980
  61.     Mn$=MID$(Dt$,8,4)
  62.     Mn% =CINT(BINTODEC!(Mn$))       'MONTH
  63.     Dy$=MID$(Dt$,12,6)
  64.     Dy% =CINT(BINTODEC!(Dy$))        'DAY
  65.  
  66.     'Make up date string as: MM/DD/Yr
  67.     MAP DtString$$*8
  68.     DtString$$ = "00/00/00"
  69.     MID$(DtString$$,1,2)=RIGHT$("00"+REMOVE$(STR$(Mn%)," "),2)
  70.     MID$(DtString$$,4,2)=RIGHT$("00"+REMOVE$(STR$(Dy%)," "),2)
  71.     MID$(DtString$$,7,2)=RIGHT$("00"+REMOVE$(STR$(Yr%)," "),2)
  72.     D$=DtString$$  'DATE
  73.  
  74.     'Reuse DtString to make time string
  75.     DtString$$="00:00:00"
  76.     MID$(DtString$$,1,2)=RIGHT$("00"+REMOVE$(STR$(Hrs%)," "),2)
  77.     MID$(DtString$$,4,2)=RIGHT$("00"+REMOVE$(STR$(Mns%)," "),2)
  78.     MID$(DtString$$,7,2)=RIGHT$("00"+REMOVE$(STR$(Scs%)," "),2)
  79.     T$=DtString$$   'Time String
  80. END SUB
  81. '------------------------------------------------------------------------
  82. FUNCTION FIGDATE&(A$)
  83.    'This function was "appropriated" from Howard Balinger's HBLIB file
  84.    'on Compuserve
  85.   LOCAL A#, M%, D%, Y&, LpYrDys%, W&, A&, B%
  86.   M% = VAL(LEFT$(A$,2))
  87.   D% = VAL(MID$(A$,4,2))
  88.   Y& = VAL(RIGHT$(A$,2))
  89. SELECT CASE M%
  90.     CASE <1, >12
  91.       GOTO FIGDATEError
  92.     CASE 1,3,5,7,8,10,12
  93.       IF D% < 1 OR D > 31% THEN FIGDATEError
  94.     CASE 4,6,9,11
  95.       IF D% < 1 OR D% > 30 THEN FIGDATEError
  96.     CASE 2
  97.       IF Y&/4 = FIX(Y&/4) AND Y& <> 0 THEN
  98.         IF D% < 1 OR D% > 29 THEN FIGDATEError
  99.       ELSE
  100.         IF D% < 1 OR D% > 28 THEN FIGDATEError
  101.            END IF: END SELECT
  102.   IF Y& = 0 AND M% < 3 THEN GOTO DateRealOld
  103.   IF M% < 3 THEN DECR Y&
  104.   A& = FIX(Y&/4): W& = 1461 * A&: A& = Y& - 4*A&
  105.   W& = W& + 365 * A&
  106.   SELECT CASE M%
  107.     CASE 3
  108.       B% = 0
  109.     CASE 4
  110.       B% = 31
  111.     CASE 5
  112.       B% = 61
  113.     CASE 6
  114.       B% = 92
  115.     CASE 7
  116.       B% = 122
  117.     CASE 8
  118.       B% = 153
  119.     CASE 9
  120.       B% = 184
  121.     CASE 10
  122.       B% = 214
  123.     CASE 11
  124.       B% = 245
  125.     CASE 12
  126.       B% = 275
  127.     CASE 1
  128.       B% = 306
  129.     CASE 2
  130.       B% = 337
  131.  END SELECT
  132.  FIGDATE& = W& + B% + D% + 59: EXIT FUNCTION
  133. DateRealOld:
  134.  IF M% = 2 THEN FIGDATE& = D%+31 ELSE FIGDATE& = D%
  135. EXIT FUNCTION
  136.  FIGDATEError:
  137.    FIGDATE& = 0
  138. END FUNCTION
  139. '------------------------------------------------------------------------
  140. FUNCTION BINTODEC!(B$)
  141.   'returns decimal equivelent of binary string
  142.    L = LEN(B$)
  143.    Total = 0
  144.    Pointer=L
  145.    FOR I = 1 TO L
  146.       DIGIT$=MID$(B$,I,1)
  147.       DECR Pointer
  148.       Total=Total+(VAL(DIGIT$)*2^Pointer)
  149.    NEXT I
  150.    BINTODEC!=Total
  151. END FUNCTION
  152. '------------------------------------------------------------------------
  153. FUNCTION GETFILENAME$
  154.     'Returns main project filename
  155.     'Assumes .Bas if not specified
  156.     '1st see if command line parameter was passed
  157.     LOCAL F$  'Filename
  158.     F$ = COMMAND$
  159.     IF F$="" THEN  'GET A NAME
  160.     PRINT
  161.     PRINT "Enter Main File Filename (.BAS is assummed if not specified):";
  162.     INPUT F$
  163.     END IF
  164.     'Check for extension
  165.     Ext=INSTR(F$,".")
  166.     IF Ext=0 THEN F$=F$+".BAS"
  167.     GETFILENAME$=F$
  168. END FUNCTION
  169. '------------------------------------------------------------------------
  170. FUNCTION FILEEXISTS (FileSpec$)
  171.   FileSpec1$ = FileSpec$ + CHR$(0)
  172.   FileAttribute% = 0
  173.   REG %AX, &H4E00
  174.   REG %CX, FileAttribute%
  175.   REG %DS, STRSEG(FILESPEC1$)
  176.   REG %DX, STRPTR(FILESPEC1$)
  177.   CALL INTERRUPT &H21
  178.   IF (REG(%FLAGS) AND 1) = 0 THEN
  179.     FILEEXISTS = -1
  180.   ELSE
  181.     FILEEXISTS = 0
  182.   END IF
  183. END FUNCTION 'FILEEXISTS
  184.  
  185. '------------------------------------------------------------------------
  186. FUNCTION JULIAN#(D$,T$)
  187.  
  188.   'Creates pseudo julian time/date stamp
  189.   'used to compare creation times
  190.   'IN: D$ = Date String, T$ = Time String
  191.     J&=FIGDATE&(D$)  'Get Julian Date
  192.     'Now get fraction of day
  193.     'T$ is now in form of  HH:MM:SS
  194.  
  195.  Seconds# =(CDBL(VAL(LEFT$(T$,2)))*3600)+(VAL(MID$(T$,4,2))*60)+(VAL(RIGHT$(T$,2)))
  196.  
  197.  'figure part of day that past
  198.  PT#=Seconds#/86400     'Divide seconds by # of seconds in a day
  199.  'Add it up
  200.   JULIAN#=J&+PT#
  201.  END FUNCTION
  202. '-------------------------------------------------------------------------
  203. SUB WAITING
  204.    BEEP
  205.    A$ = INKEY$  'Clear previous keystrokes into dummy variable
  206.    PRINT"    < < <    Hit any key to continue ! ! ! > > > "
  207.    WHILE NOT INSTAT:WEND
  208.    A$ = INKEY$  'Clear  keystrokes into dummy variable
  209. END SUB
  210. '-------------------------------------------------------------------------
  211.  
  212. SUB NOISE
  213.  FOR I% = 1 TO 2
  214.     FOR X% = 57 TO 59
  215.     PLAY "L64 N="+VARPTR$(X%)
  216.     NEXT X%
  217.  NEXT I%
  218. END SUB
  219. '-------------------------------------------------------------------------
  220. SUB FINDDTSTAMP(F$,D$,T$)  'F$ = Filename D$=Date stamp  T$=Timestamp
  221.   pbu$=f$  'save name
  222.   'returns date and time of f$ or most recently changed include file of f$
  223.   CALL DTSTAMP(F$,D$,T$)  'now d$ and t$ hold stamps of unit main file
  224.   'now see if any of it's includes were updated mpre recently
  225.    DIM I$(200)  'Hold Included filenames - to search through later
  226.    Pointer = 0  'Pointer to next filename in I$()
  227.    IncCount=0  'Count of Included filenames
  228.     DO
  229.       OPEN F$ FOR INPUT AS #1
  230.     DO WHILE NOT EOF(1)
  231.        LINE INPUT #1,Txt$   '1 line of text from file
  232.        IF INSTR(Txt$,"$") THEN  'Use this to speed it up by only
  233.              'checking lines with a $ in them
  234.          Txt$=UCASE$(REMOVE$(Txt$,ANY CHR$(9,32)))  'Remove tabs and spaces
  235.          IF LEFT$(Txt$,8) = "$INCLUDE" THEN
  236.            F$=MID$(Txt$,10,12)  'Isolate filename
  237.            QUOTE = INSTR(F$,CHR$(34))  'Remove quote
  238.            IF QUOTE>0 THEN F$=LEFT$(F$,QUOTE-1)
  239.          IF FILEEXISTS(F$) THEN
  240.              INCR IncCount
  241.              I$(IncCount)=F$
  242.           ELSE
  243.              PRINT"WARNING!! ";F$;" is not in current directory,"
  244.              PRINT "and will not be checked!!!":beep:CALL WAITING
  245.           END IF
  246.          END IF
  247.        END IF
  248.        LOOP
  249.       CLOSE #1
  250.       INCR POINTER
  251.       F$=I$(POINTER)    'Check next file for includes
  252.       LOOP WHILE F$<>""
  253.       'now check all includes for a date that is less current than d$ and t$
  254.       Stamp#= JULIAN#(D$,T$)  'Get julian date to compare easier
  255.     FOR I = 1 TO IncCount
  256.        FL$=I$(I)
  257.        CALL DTSTAMP(FL$,D2$,T2$)
  258.        Stamp2#= JULIAN#(D2$,T2$)
  259.        IF Stamp2#>Stamp# THEN
  260.      Stamp#=Stamp2#
  261.      D$=D2$
  262.      T$=T2$
  263.        END IF
  264.     NEXT I
  265.     f$=Pbu$ 'restore filename
  266. END SUB
  267.