home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
pb
/
library2
/
libmake.bas
< prev
next >
Wrap
BASIC Source File
|
1990-09-27
|
9KB
|
267 lines
'Note: This is an Include File for MAKE.BAS
'To create MAKE.EXE, Compile MAKE.BAS
'------------------------------------------------------------------------
'File: LibMake.Bas
'Purpose: Library of functions needed for Make utility
'
'FUNCTION BINTODEC!(BinaryString$) 'RETURNS: Decimal equivelent of binary string
'SUB DTSTAMP$(FileName$,date$,time$)'RETURNS: Date and Time of last change
'FUNCTION FIGDATE&(DATE$) 'IN: DATE$ = mm/dd/yy RETURNS: Julian Date
'FUNCTION FILEEXISTS (FileName$) 'RETURNS: True if file exists
'FUNCTION GETFILENAME$ 'RETURNS:Project main file name
'FUNCTION JULIAN#(D$,T$) 'RETURNS: pseudo julian time/date stamp
'SUB NOISE 'Makes noise
'SUB WAITING 'Process hit any key to continue
'------------------------------------------------------------------------
DEFINT A-Z
'Define register constants
%AX=1 : %BX=2 : %CX=3 : %DX=4 : %SI=5 : %DI=6 : %BP=7 : %DS=8 : %ES=9: %FLAGS=0
SUB DTSTAMP(FL$,D$,T$)
'This sub returns the date and time stamp
'In: fl$ = file name
'Out: d$=date as mm/dd/yy
't$ = time as hr:mn:sc
'1st open file to get it's handle for next part
MAP BinBuff$$*16 'This makes sure that binary string is 16 characters
Buf$=FL$+CHR$(0) 'ASCIIZ String
REG %AX,&H3D02 'DOS Open File Function
REG %DS, STRSEG(Buf$)
REG %DX, STRPTR(Buf$)
CALL INTERRUPT &H21 'Call DOS
'if not on file, assign a time of 0 so it gets recompilied
IF (REG(%FLAGS) AND 1) <> 0 THEN D$="00/00/00" :T$="00:00:00":EXIT SUB
HANDLE = REG(%AX) 'Now AX holds file handle
'Get file date and time
REG %AX,&H5700 'DOS Get time and date function
REG %BX,HANDLE 'Handle to file Fl$
CALL INTERRUPT &H21
TM= REG(%CX) 'Time (encoded)
DT = REG(%DX) 'Date (encoded)
'Now close file
REG %AX,&H3E00 'DOS Close file function
REG %BX,HANDLE 'BX
CALL INTERRUPT &H21
'Now uncode date and time
RSET BinBuff$$=BIN$(TM) 'This insures 16 digits
Hours$ = BinBuff$$
RSET BinBuff$$=BIN$(DT)
Dt$ = BinBuff$$
Hrs%=CINT(BINTODEC!(MID$(Hours$,1,5))) 'Hours
Mns%=CINT(BINTODEC!(MID$(Hours$,6,6))) 'Minutes
Scs%=CINT(BINTODEC!(MID$(Hours$,12)))*2 'Seconds were in 2 sec intervals
Yr$ =MID$(Dt$,1,7)
Yr% = CINT(BINTODEC!(Yr$))+80 'YEAR IS OFFSERT FORM 1980
Mn$=MID$(Dt$,8,4)
Mn% =CINT(BINTODEC!(Mn$)) 'MONTH
Dy$=MID$(Dt$,12,6)
Dy% =CINT(BINTODEC!(Dy$)) 'DAY
'Make up date string as: MM/DD/Yr
MAP DtString$$*8
DtString$$ = "00/00/00"
MID$(DtString$$,1,2)=RIGHT$("00"+REMOVE$(STR$(Mn%)," "),2)
MID$(DtString$$,4,2)=RIGHT$("00"+REMOVE$(STR$(Dy%)," "),2)
MID$(DtString$$,7,2)=RIGHT$("00"+REMOVE$(STR$(Yr%)," "),2)
D$=DtString$$ 'DATE
'Reuse DtString to make time string
DtString$$="00:00:00"
MID$(DtString$$,1,2)=RIGHT$("00"+REMOVE$(STR$(Hrs%)," "),2)
MID$(DtString$$,4,2)=RIGHT$("00"+REMOVE$(STR$(Mns%)," "),2)
MID$(DtString$$,7,2)=RIGHT$("00"+REMOVE$(STR$(Scs%)," "),2)
T$=DtString$$ 'Time String
END SUB
'------------------------------------------------------------------------
FUNCTION FIGDATE&(A$)
'This function was "appropriated" from Howard Balinger's HBLIB file
'on Compuserve
LOCAL A#, M%, D%, Y&, LpYrDys%, W&, A&, B%
M% = VAL(LEFT$(A$,2))
D% = VAL(MID$(A$,4,2))
Y& = VAL(RIGHT$(A$,2))
SELECT CASE M%
CASE <1, >12
GOTO FIGDATEError
CASE 1,3,5,7,8,10,12
IF D% < 1 OR D > 31% THEN FIGDATEError
CASE 4,6,9,11
IF D% < 1 OR D% > 30 THEN FIGDATEError
CASE 2
IF Y&/4 = FIX(Y&/4) AND Y& <> 0 THEN
IF D% < 1 OR D% > 29 THEN FIGDATEError
ELSE
IF D% < 1 OR D% > 28 THEN FIGDATEError
END IF: END SELECT
IF Y& = 0 AND M% < 3 THEN GOTO DateRealOld
IF M% < 3 THEN DECR Y&
A& = FIX(Y&/4): W& = 1461 * A&: A& = Y& - 4*A&
W& = W& + 365 * A&
SELECT CASE M%
CASE 3
B% = 0
CASE 4
B% = 31
CASE 5
B% = 61
CASE 6
B% = 92
CASE 7
B% = 122
CASE 8
B% = 153
CASE 9
B% = 184
CASE 10
B% = 214
CASE 11
B% = 245
CASE 12
B% = 275
CASE 1
B% = 306
CASE 2
B% = 337
END SELECT
FIGDATE& = W& + B% + D% + 59: EXIT FUNCTION
DateRealOld:
IF M% = 2 THEN FIGDATE& = D%+31 ELSE FIGDATE& = D%
EXIT FUNCTION
FIGDATEError:
FIGDATE& = 0
END FUNCTION
'------------------------------------------------------------------------
FUNCTION BINTODEC!(B$)
'returns decimal equivelent of binary string
L = LEN(B$)
Total = 0
Pointer=L
FOR I = 1 TO L
DIGIT$=MID$(B$,I,1)
DECR Pointer
Total=Total+(VAL(DIGIT$)*2^Pointer)
NEXT I
BINTODEC!=Total
END FUNCTION
'------------------------------------------------------------------------
FUNCTION GETFILENAME$
'Returns main project filename
'Assumes .Bas if not specified
'1st see if command line parameter was passed
LOCAL F$ 'Filename
F$ = COMMAND$
IF F$="" THEN 'GET A NAME
PRINT
PRINT "Enter Main File Filename (.BAS is assummed if not specified):";
INPUT F$
END IF
'Check for extension
Ext=INSTR(F$,".")
IF Ext=0 THEN F$=F$+".BAS"
GETFILENAME$=F$
END FUNCTION
'------------------------------------------------------------------------
FUNCTION FILEEXISTS (FileSpec$)
FileSpec1$ = FileSpec$ + CHR$(0)
FileAttribute% = 0
REG %AX, &H4E00
REG %CX, FileAttribute%
REG %DS, STRSEG(FILESPEC1$)
REG %DX, STRPTR(FILESPEC1$)
CALL INTERRUPT &H21
IF (REG(%FLAGS) AND 1) = 0 THEN
FILEEXISTS = -1
ELSE
FILEEXISTS = 0
END IF
END FUNCTION 'FILEEXISTS
'------------------------------------------------------------------------
FUNCTION JULIAN#(D$,T$)
'Creates pseudo julian time/date stamp
'used to compare creation times
'IN: D$ = Date String, T$ = Time String
J&=FIGDATE&(D$) 'Get Julian Date
'Now get fraction of day
'T$ is now in form of HH:MM:SS
Seconds# =(CDBL(VAL(LEFT$(T$,2)))*3600)+(VAL(MID$(T$,4,2))*60)+(VAL(RIGHT$(T$,2)))
'figure part of day that past
PT#=Seconds#/86400 'Divide seconds by # of seconds in a day
'Add it up
JULIAN#=J&+PT#
END FUNCTION
'-------------------------------------------------------------------------
SUB WAITING
BEEP
A$ = INKEY$ 'Clear previous keystrokes into dummy variable
PRINT" < < < Hit any key to continue ! ! ! > > > "
WHILE NOT INSTAT:WEND
A$ = INKEY$ 'Clear keystrokes into dummy variable
END SUB
'-------------------------------------------------------------------------
SUB NOISE
FOR I% = 1 TO 2
FOR X% = 57 TO 59
PLAY "L64 N="+VARPTR$(X%)
NEXT X%
NEXT I%
END SUB
'-------------------------------------------------------------------------
SUB FINDDTSTAMP(F$,D$,T$) 'F$ = Filename D$=Date stamp T$=Timestamp
pbu$=f$ 'save name
'returns date and time of f$ or most recently changed include file of f$
CALL DTSTAMP(F$,D$,T$) 'now d$ and t$ hold stamps of unit main file
'now see if any of it's includes were updated mpre recently
DIM I$(200) 'Hold Included filenames - to search through later
Pointer = 0 'Pointer to next filename in I$()
IncCount=0 'Count of Included filenames
DO
OPEN F$ FOR INPUT AS #1
DO WHILE NOT EOF(1)
LINE INPUT #1,Txt$ '1 line of text from file
IF INSTR(Txt$,"$") THEN 'Use this to speed it up by only
'checking lines with a $ in them
Txt$=UCASE$(REMOVE$(Txt$,ANY CHR$(9,32))) 'Remove tabs and spaces
IF LEFT$(Txt$,8) = "$INCLUDE" THEN
F$=MID$(Txt$,10,12) 'Isolate filename
QUOTE = INSTR(F$,CHR$(34)) 'Remove quote
IF QUOTE>0 THEN F$=LEFT$(F$,QUOTE-1)
IF FILEEXISTS(F$) THEN
INCR IncCount
I$(IncCount)=F$
ELSE
PRINT"WARNING!! ";F$;" is not in current directory,"
PRINT "and will not be checked!!!":beep:CALL WAITING
END IF
END IF
END IF
LOOP
CLOSE #1
INCR POINTER
F$=I$(POINTER) 'Check next file for includes
LOOP WHILE F$<>""
'now check all includes for a date that is less current than d$ and t$
Stamp#= JULIAN#(D$,T$) 'Get julian date to compare easier
FOR I = 1 TO IncCount
FL$=I$(I)
CALL DTSTAMP(FL$,D2$,T2$)
Stamp2#= JULIAN#(D2$,T2$)
IF Stamp2#>Stamp# THEN
Stamp#=Stamp2#
D$=D2$
T$=T2$
END IF
NEXT I
f$=Pbu$ 'restore filename
END SUB