'=========================================================================== ' Subject: COLLECTION OF FN FUNCTIONS Date: 09-05-99 (21:34) ' Author: Antoni Gual Code: QB, PDS ' Origin: agual@eic.ictnet.es Packet: MISC.ABC '=========================================================================== 'I think FN functions can be useful to reduce the View Sub's list of a big program 'These functions are not popular, I made a search in the ABC files and found 'no more than 40 programs using them. About a half used only the same single 'function that calculates an integer random number. Probably it hapens because 'MS labeled these functions as "obsolete", not to be suported in further 'versions. In fact They switched so fast to windows that no one cares about 'the "unportability" of FN functions. ' 'Facts: 'They must be declared in the main part of the module, before they are used 'Can't be shared with other modules 'Variables used are shared with te main part of the module. 'Variables can be made local by declaring them as STATIC 'Paremeters are received by value 'Can't receive user defined vars or arrays as parameters 'As Procedure functions, they can only return simple values 'Don't appear in View sub's listing 'QB has a bug: String paremeters passed to a FN are not deleted 'when exiting function so if they are big, tou must assign them to "" 'before exiting. 'Two sintaxes: ' single line DEF FNname%(x,y)=x+y*2 ' multiple line DEF FNname%(x,y) ' FNname% = 2 ' IF x > 0 THEN EXIT DEF ' FNname% = x + y * 2 ' END DEF 'Here is a small library of functions. Almost any small procedure not to 'be shared between modules can be made a FN function. DEFINT A-Z '$INCLUDE: 'qb.bi' DIM SHARED regs AS RegTypeX '----------------------file attributes DEF fnAtr2Str$ (a$) 'converts file attr byte to a char fnAtr2Str$ = STRING$(8, "-") a1 = ASC(a$) IF a1 AND 1 THEN MID$(fnAtr2Str$, 1, 1) = "R" 'readonly IF a1 AND 2 THEN MID$(fnAtr2Str$, 2, 1) = "H" 'hidden IF a1 AND 4 THEN MID$(fnAtr2Str$, 3, 1) = "S" 'system IF a1 AND 8 THEN MID$(fnAtr2Str$, 4, 1) = "V" 'volume label IF a1 AND 16 THEN MID$(fnAtr2Str$, 5, 1) = "D"'directory IF a1 AND 32 THEN MID$(fnAtr2Str$, 6, 1) = "A"'archive IF a1 AND 64 THEN MID$(fnAtr2Str$, 7, 1) = "7"'long filename? IF a1 AND 128 THEN MID$(fnAtr2Str$, 8, 1) = "8" END DEF '----------------------time function substitute DEF fngettime& 'stores 18'2ths of second since midnight to a long regs.AX = 0 CALL INTERRUPT(&H1A, regs, regs) fngettime& = CVL(MKI$(regs.DX) + MKI$(regs.CX)) END DEF '-----------------------math CONST PI180# = 3.14159226# / 180 DEF FnRad# (x#) = x# * PI180# 'degrees to rad DEF fndeg# (x#) = x# / PI180# 'rad to degrees DEF fnmax% (x, y) 'max fnmax% = x IF y > x THEN fnmax% = y END DEF DEF fnmin% (x, y) 'min fnmin% = x IF y < x THEN fnmin% = y END DEF DEF FNR (a) = INT(RND * a) 'random integer 0<=x LEN(a$) THEN EXIT DEF IF from = 0 THEN from = LEN(a$) IF LEN(c$) = 0 THEN EXIT DEF IF LEN(a$) = 0 THEN EXIT DEF DEF SEG = VARSEG(a$) car = ASC(c$) t1 = SADD(a$) t2 = t1 + from fnbINSTR% = 0 DO WHILE t2 >= t1 IF PEEK(t2) = car THEN fnbINSTR% = t2 - t1 + 1: EXIT DO t2 = t2 - 1 LOOP DEF SEG a$ = "" END DEF DEF fncentr$ (a$, b$) 'centers string b$ in a$ Temp = (LEN(a$) - LEN(b$)) \ 2 MID$(a$, Temp) = b$ fncentr$ = a$ END DEF DEF fnAsciiz2Str$ (txt$) 'C type string to basic fnAsciiz2Str$ = LEFT$(txt$, INSTR(txt$, CHR$(0)) - 1) END DEF DEF fnstr2Asciiz$ (txt$) 'C type string to basic fnstr2Asciiz$ = txt$ + CHR$(0) END DEF '--------------------- unsigned int's DEF fnuint2Lng& (x) 'converts an unsigned integer (2 bytes) to a LONG fnuint2Lng& = x IF x < 0 THEN fnuint2Lng& = x + 65536 END DEF DEF fnlng2uint% (x&) 'convert a long to an unsigned int fnlng2uint% = CVI(LEFT$(MKL$(x&), 2)) END DEF DEF FNWoRD (x, y) 'forms word from 2 bytes Temp$ = MKL$(x * 256& + y) FNWoRD = CVI(LEFT$(Temp$, 2)) END DEF 'Subject: BIOS MEMORY USAGE SUMMARY Date: 10-20-97 (10:34) ' Author: William A. Deer Code: QB, QBasic, PDS ' Get the Base Addresses of each Com Port 1-4 DEF FnCom1Address$ : DEF SEG = &H40: FnCom1Address$ = HEX$(PEEK(&H1)) + (HEX$(PEEK(&H0))): END DEF DEF FnCom2Address$ : DEF SEG = &H40: FnCom2Address$ = HEX$(PEEK(&H2)) + (HEX$(PEEK(&H3))): END DEF DEF FnCom3Address$ : DEF SEG = &H40: FnCom3Address$ = HEX$(PEEK(&H4)) + (HEX$(PEEK(&H5))): END DEF DEF FnCom4Address$ : DEF SEG = &H40: FnCom4Address$ = HEX$(PEEK(&H6)) + (HEX$(PEEK(&H7))): END DEF ' Get the Base Addresses of each LPTn Port 1-4 DEF FnLPT1Address$ : DEF SEG = &H40: FnLPT1Address$ = HEX$(PEEK(&H8)) + (HEX$(PEEK(&H9))): END DEF DEF FnLPT2Address$ : DEF SEG = &H40: FnLPT2Address$ = HEX$(PEEK(&HA)) + (HEX$(PEEK(&HB))): END DEF DEF FnLPT3Address$ : DEF SEG = &H40: FnLPT3Address$ = HEX$(PEEK(&HC)) + (HEX$(PEEK(&HD))): END DEF DEF FnLPT4Address$ : DEF SEG = &H40: FnLPT4Address$ = HEX$(PEEK(&HE)) + (HEX$(PEEK(&HF))): END DEF ' Keyboard Rountine DEF FnCapsLockStatus% : DEF SEG = &H40: FnCapsLockStatus% = ((PEEK(&H17) AND &H40) / &H40): END DEF DEF FnNumbLockStatus% : DEF SEG = &H40: FnNumbLockStatus% = ((PEEK(&H17) AND &H20) / &H20): END DEF DEF FnScrlLockStatus% : DEF SEG = &H40: FnScrlLockStatus% = ((PEEK(&H17) AND &H10) / &H10): END DEF DEF FnInsertMode% : DEF SEG = &H40: FnInsertMode% = ((PEEK(&H17) AND &H80) / &H80): END DEF DEF FnR.AltKeyStatus% : DEF SEG = &H40: FnR.AltKeyStatus% = ((PEEK(&H17) AND &H8) / &H8): END DEF DEF FnRCtrlKeyStatus% : DEF SEG = &H40: FnRCtrlKeyStatus% = ((PEEK(&H17) AND &H4) / &H4): END DEF DEF FnRShftKeyStatus% : DEF SEG = &H40: FnRShftKeyStatus% = ((PEEK(&H17) AND &H1) / &H1): END DEF DEF FnLShftKeyStatus% : DEF SEG = &H40: FnLShftKeyStatus% = ((PEEK(&H17) AND &H2) / &H2): END DEF DEF FnL.AltKeyStatus% : DEF SEG = &H40: FnL.AltKeyStatus% = ((PEEK(&H18) AND &H2) / &H2): END DEF DEF FnLCtrlKeyStatus% : DEF SEG = &H40: FnLCtrlKeyStatus% = ((PEEK(&H18) AND &H1) / &H1): END DEF ' Installed Hardware DEF FnFloppyNo% : DEF SEG = &H40: FnFloppyNo% = 1 + (PEEK(&H10) AND &H1) + (PEEK(&H10) AND &H2): END DEF DEF FnPrnAdaptors% : DEF SEG = &H40: FnPrnAdaptors% = ((PEEK(&H11) AND &H80) / &H40) + ((PEEK(&H11) AND &H40) / &H40): END DEF DEF FnInternalModem% : DEF SEG = &H40: FnInternalModem% = ((PEEK(&H11) AND &H20) / &H20): END DEF DEF FnComPorts% : DEF SEG = &H40: FnComPorts% = ((PEEK(&H11) AND &H8) / &H2) + ((PEEK(&H11) AND &H4) / &H2) + ((PEEK(&H11) AND &H2) / &H2): END DEF DEF FnTotalMemory$ : DEF SEG = &H40: FnTotalMemory$ = HEX$(PEEK(&H14)) + (HEX$(PEEK(&H13))): END DEF '----------------------------Found in Ethan Winer's book DEF FNPeekWord& (a&) 'peek a word FNPeekWord& = PEEK(a&) + 256& * PEEK(a& + 1) END DEF DEF FnRound# (Value#, Digits%) 'round a value to Digits Mult% = 10 ^ Digits% FnRound# = FIX((Mult% * Value#) + (SGN(Value#)) * .5#) / Mult% END DEF DEF FnGetDrive% 'gets default drive regs.ax = &H1900 CALL INTERRUPT(&H21, regs, regs) FnGetDrive% = (regs.ax AND &HFF) + 65 END DEF DEF fnDriveValid% (TestDrive$) 'is a drive name valid? STATIC Current 'local to this function Current = FnGetDrive% 'save the current drive fnDriveValid% = 0 'assume not valid SHELL "Testdrive$" + ":" IF ASC(UCASE$(TestDrive$)) = FnGetDrive% THEN fnDriveValid% = -1 'they match so it's valid END IF SHELL "Current$" + ":" 'either way restore it END DEF 'calculate position of a record DEF FNSeekLoc& (RecNumber, RecLen) = ((RecNumber - 1) * CLNG(RecLen)) + 1 DEF FnGetDir$ (Drive$) 'returns default dir of a drive STATIC Temp$, Drive, Zero 'local variables IF LEN(Drive$) THEN 'did they pass a drive? Drive = ASC(UCASE$(Drive$)) - 64 ELSE Drive = 0 END IF Temp$ = SPACE$(65) 'DOS stores the name here regs.ax = &H4700 'get directory service regs.dx = Drive 'the drive goes in DL regs.si = SADD(Temp$) 'show DOS where Temp$ is regs.ds = -1 'use this with QuickBASIC CALL INTERRUPT(&H21, regs, regs)'call DOS IF regs.flags AND 1 THEN 'must be an invalid drive FnGetDir$ = "" ELSE Zero = INSTR(Temp$, CHR$(0)) 'find the zero byte FnGetDir$ = "\" + LEFT$(Temp$, Zero) END IF END DEF TYPE DTA 'used by find first/next Reserved AS STRING * 21 'reserved for use by DOS Attribute AS STRING * 1 'the file's attribute FileTime AS STRING * 2 'the file's time FileDate AS STRING * 2 'the file's date FileSize AS LONG 'the file's size FileName AS STRING * 13 'the file's name END TYPE DIM SHARED DTAData AS DTA 'shared so LoadNames can DEF FnFileExist% (Spec$) 'file Spec$ exists? FnFileExist% = -1 'assume the file exists regs.dx = VARPTR(DTAData) 'set a new DOS DTA regs.ds = VARSEG(DTAData) regs.ax = &H1A00 CALL INTERRUPTX(&H21, regs, regs) Spec$ = Spec$ + CHR$(0) 'DOS needs an ASCIIZ string regs.ax = &H4E00 'find file name service regs.cx = 39 'attribute for any file regs.dx = SADD(Spec$) 'show where the spec is regs.ds = VARSEG(Spec$) CALL INTERRUPTX(&H21, regs, regs) IF regs.flags AND 1 THEN FnFileExist% = 0 END DEF DEF FnFileCount% (Spec$, Attribute) STATIC Count 'make this private regs.dx = VARPTR(DTAData) 'set new DTA address regs.ds = -1 'the DTA is in DGROUP regs.ax = &H1A00 'specify service 1Ah CALL INTERRUPTX(&H21, regs, regs) Count = 0 'clear the counter Spec$ = Spec$ + CHR$(0) 'make an ASCIIZ string IF Attribute AND 16 THEN 'find directory names? DirFlag = -1 'yes ELSE DirFlag = 0 'no END IF regs.dx = SADD(Spec$) 'the file spec address regs.ds = -1 'this is for QuickBASIC regs.cx = Attribute 'assign the attribute regs.ax = &H4E00 'find first matching name DO CALL INTERRUPTX(&H21, regs, regs) IF regs.flags AND 1 THEN EXIT DO 'no more IF DirFlag THEN IF ASC(DTAData.Attribute) AND 16 THEN IF LEFT$(DTAData.FileName, 1) <> "." THEN Count = Count + 1 'increment the counter END IF END IF ELSE Count = Count + 1 'they want regular files END IF regs.ax = &H4F00 'find next name LOOP FnFileCount% = Count 'assign the function END DEF '----- This function loads a group of file names to an array DEF FNLoadNames% STATIC Count '---- define a new Data Transfer Area for DOS regs.dx = VARPTR(DTAData) regs.ds = VARSEG(DTAData) regs.ax = &H1A00 CALL INTERRUPTX(&H21, regs, regs) Count = 0 'zero the file counter Spec$ = Spec$ + Zero$ 'DOS needs an ASCIIZ string regs.dx = SADD(Spec$) 'show where the spec is regs.ds = VARSEG(Spec$) regs.cx = 39 'the attribute for any file regs.ax = &H4E00 'find file name service '---- Read the file names that match the search specification. The Flags ' regs indicates when no more matching files are found. Copy ' each file name to the string array. Service &H4F is used to ' continue the search started with service &H4E using the same file ' specification. DO CALL INTERRUPTX(&H21, regs, regs) IF regs.flags AND 1 THEN EXIT DO Count = Count + 1 Array$(Count) = DTAData.FileName regs.ax = &H4F00 LOOP WHILE Count < MaxFiles% FNLoadNames% = Count 'return the number of files END DEF