'************************************************* '* This example is for reading/setting file * '* attributes. It also is an example of how * '* to read file names from the disk. BC 7.1 * '* and VB DOS all support the DIR$ function, * '* but QB does not, so we will low-level code * '* our own DIR function and call it READDIR * '* * '* This code is the copyright of George Spafford * '* * '* v1.0 04/29/93 Initial Release * '************************************************* 'We use interrupt 21H and the following functions: ' ' 1AH : Set DTA address ' 43H, Subfunction 1 : Set file attributes ' 4EH : Find first matching file ' 4FH : Find the next matching file ' '=================================================== DEFINT A-Z 'make variables integer by default TYPE RegType AX AS INTEGER bx AS INTEGER CX AS INTEGER DX AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER Flags AS INTEGER END TYPE TYPE RegTypeX AX AS INTEGER bx AS INTEGER CX AS INTEGER DX AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER Flags AS INTEGER DS AS INTEGER es AS INTEGER END TYPE TYPE F Buffer AS STRING * 21 'reserved for DOS Attrib AS STRING * 1 'file attribute Time AS INTEGER 'file time Date AS INTEGER 'file date Size AS LONG 'file size Name AS STRING * 13 'file name (12 + CHR$(0)) END TYPE DIM Arg$(10) 'holds command arguments DIM Finfo AS F 'holds located file info DIM InRegs AS RegType 'use InReg to hold all registers 'except segment registers DIM OutRegs AS RegType 'Use OutReg to receive values DIM InRegsX AS RegTypeX 'use InReg to hold all registers 'including segment registers DIM OutRegsX AS RegTypeX 'Use OutReg to receive values DECLARE SUB INTERRUPT (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType) DECLARE SUB InterruptX (intnum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX) '******** End of Declarations ******** Title$ = "S3 CHGMOD v1.0 Copyright George Spafford 04/29/93" PRINT PRINT Title$ PRINT PRINT "Name", "Size", "Previous", "New" PRINT 'The next line ensures that the COMMAND line is 'upper case and that left and right spaces are 'stripped. The normal libraries usually do this 'for you, but some libraries (Crescent's PDQ) do 'not provide the same support. CL$ = LTRIM$(RTRIM$(UCASE$(COMMAND$))) IF CL$ = "" THEN GOTO CLHelp 'can not be NULL IF INSTR(CL$, "?") > 0 THEN GOTO CLHelp 'they want help! 'okay, we now need to parse the command line for the 'proper elements. I am going to use white-space (just 'a space) as the separator (delimitter) between 'commands and recognize the "/" as indicative of a 'switch. One space will be added to the end of the 'command line to serve as the final delimitter. CL$ = CL$ + " " Start = 1 'Byte to begin the parse at Look = 1 'where INSTR should start looking 'for spaces DO 'DO loop a = INSTR(Look, CL$, " ") 'store position of space found 'after byte specified as Look IF a > 0 THEN 'Did INSTR find a space? CFound = CFound + 1 'if so, add one to array counter Length = (a - Start) 'this is how long the argument is Arg$(CFound) = MID$(CL$, Start, Length) 'This just uses MID$ to grab it Start = a + 1 'New start is A + 1 Look = Start + 1 'INSTR needs to look for spaces one 'byte further than where Start is END IF 'end block if LOOP UNTIL a = LEN(CL$) 'LOOP until A = the length of our command 'line. This condition will be true when 'it processes the final space that we added 'Okay, now we have all of the arguments loaded in the ARG$() array. 'Here, you could test for the number of arguments found if you wanted 'to force the user to enter a certain number of them. For example: ' IF CFound < 2 then ' Print "ERROR: Usage is: CHGMOD filename [/R+][/R-] ..." ' Print ' end ' end if 'We will not do this here, because if the user does not enter anything on the 'command line, then we capture the condition with IF CL$="" THEN earlier. 'Also, if the user just enters the file name(s), we will display the current 'attributes assigned to that file(s). IF CFound > 1 THEN 'more that one arg? FOR N = 2 TO CFound 'start with #2 SELECT CASE Arg$(N) 'CASE check it CASE "/R+" 'set read only SetReadOnly = 1 CASE "/R-" 'remove RO SetReadOnly = -1 CASE "/S+" 'set system SetSystem = 1 CASE "/S-" 'remove system SetSystem = -1 CASE "/H+" 'set hidden SetHidden = 1 CASE "/H-" 'remove hidden SetHidden = -1 CASE "/A+" 'set archive SetArchive = 1 CASE "/A-" 'remove archive SetArchive = -1 CASE "/-" 'remove all Noattributes = 1 CASE ELSE 'if none of the above GOTO CLHelp 'goto command help END SELECT 'end the CASE NEXT N 'process next argument END IF 'end the block if 'Now, we get down to the hard core stuff. Note, there are two ways 'to get directory entries. The one NOT to use is INT 21H Function 11H. 'This uses the old File Control Blocks (FCB) and only operates in the 'current directory. Function 11H does the initial match and 12H finds the 'next match. 'The method to use is INT 21H, Function 4EH and Function 4FH. 'This method makes use of handles and the Data Transfer Area (DTA). 'The DTA is an area in memory that stores the located file's 'attributes, file time, file date and file size. When combined, 'this information uses the first 43 bytes of the DTA. 'First, we need to set the DTA address. InRegsX.AX = &H1A00 'Load AH with 1A InRegsX.DS = VARSEG(Finfo) 'Load the segment address 'to the DTA block into DS InRegsX.DX = VARPTR(Finfo) 'Load the offset address to 'the DTA block into DX CALL InterruptX(&H21, InRegsX, OutRegsX) 'make the call DIM Hold AS STRING * 65 'assign a 64 + 1 byte buffer 'this means 64 bytes data + 1 CHR$(0) Hold = Arg$(1) + CHR$(0) 'File Name ended with ASCII 0 'do not forget to add the CHR$(0) !!!! 'The file name can contain wildcards. InRegsX.AX = &H4E00 'Function 4EH into AH InRegsX.CX = 1 + 2 + 4 + 32 'Find matches of: 'bit 0: Read Only ' 1: Hidden ' 2: System ' 5: Archive 'essentially, CX holds a attribute 'that is used as a match as well as 'the file specification. InRegsX.DS = VARSEG(Hold) 'point to segment of HOLD$ InRegsX.DX = VARPTR(Hold) 'point to offset of HOLD$ 'SPECIAL NOTE: Since BASIC can move strings around, determine the Segment and ' offsets right before you use them. CALL InterruptX(&H21, InRegsX, OutRegsX) IF OutRegsX.Flags AND 1 THEN 'If bit 0 is on, the carry flag is 'set which means an error occurred. IF OutRegsX.AX = 2 THEN '2 means a path error PRINT "Path Not Found" '18 means not attributes matched. 'We will skip 18. END IF PRINT "No Files match: "; FileSpec$ PRINT END 'end if none are found END IF 'If we make it to this point, we must assume that there exists 'either a single match or multiple matches to the file specification 'that we entered. DO Found = Found + 1 'add one to the number of files found attr = ASC(Finfo.Attrib) Current$ = "" RO = 0 Hidden = 0 SystemA = 0 Archive = 0 'bit attr IF attr AND 1 THEN ' 0 Read-Only RO = 1 Current$ = Current$ + "R" END IF IF attr AND 2 THEN ' 1 Hidden Hidden = 2 Current$ = Current$ + "H" END IF IF attr AND 4 THEN ' 2 System SystemA = 4 Current$ = Current$ + "S" END IF IF attr AND 32 THEN ' 5 Archive Archive = 32 Current$ = Current$ + "A" END IF a = INSTR(Finfo.Name, CHR$(0)) 'find the CHR$(0) 'the next line pulls it out IF a > 0 THEN Out$ = LEFT$(Finfo.Name, (a - 1)) IF CFound > 1 THEN IF SetReadOnly = 1 THEN RO = 1 IF SetReadOnly = -1 THEN RO = 0 IF SetHidden = 1 THEN Hidden = 2 IF SetHidden = -1 THEN Hidden = 0 IF SetSystem = 1 THEN SystemA = 4 IF SetSystem = -1 THEN SystemA = 0 IF SetArchive = 1 THEN Archive = 32 IF SetArchive = -1 THEN Archive = 0 'Remember, remember, remember, we are setting bits 'here that have a corresponding integer depiction. 'Thus, we add them together. NewAttrib = RO + Hidden + SystemA + Archive IF Noattributes THEN NewAttrib = 0 'Lets set the new attributes InRegsX.AX = &H43 * 256 'load 43H into AH InRegsX.AX = InRegsX.AX OR &H1 'load 1H into AL 'Let me explain the previous two lines a bit better. 'First, we loaded &H43 into AH by multiplying it by 256. 'Remember? AX is a 16 bit register that is made up of two" '8-bit registers that can be accessed independently. Frankly," 'I think we should have been given direct access to the 8-bit" 'registers, but we do not. 'Load AH first and then load AL by using the OR operator" 'Using OR will not destroy the value in AH. If you are 'still scratching your head as to why we multiplied the '43H by 256 it is because 8 enabled bits = 256. Look in the 'print tutorial .DOC file for a good explanation. InRegsX.CX = NewAttrib InRegsX.DS = VARSEG(Finfo.Name) InRegsX.DX = VARPTR(Finfo.Name) CALL InterruptX(&H21, InRegsX, OutRegsX) IF OutRegsX.Flags AND 1 THEN PRINT Out$, Finfo.Size, Current$ IF AX = 1 THEN PRINT "Unknown function code" IF AX = 5 THEN PRINT "Attribute can not be changed" PRINT END END IF END IF New$ = "" IF RO THEN New$ = New$ + "R" IF Hidden THEN New$ = New$ + "H" IF SystemA THEN New$ = New$ + "S" IF Archive THEN New$ = New$ + "A" IF Noattributes THEN New$ = "" PRINT Out$, Finfo.Size, Current$, New$ 'Next we look for the next matching file using function 4F. 'If we get an error in the Carry flag bit, we will assume that 'we have read in all of the matching file names. InRegsX.AX = &H4F00 'load AH with 4F CALL InterruptX(&H21, InRegsX, OutRegsX) IF OutRegsX.Flags AND 1 THEN 'look for error EndMatch = 1 END IF LOOP UNTIL EndMatch 'if endmatch, then exit the loop 'If we have found all of our matches, it is time to go bye-bye. END 'The next fragment is just typical of how I do my command line help. 'In 99.9% of my programs, if the user does not enter any parameters, 'enters an unknown parameter, or a "?" on the command line, then I throw 'them into a small code segment that explains how to run the program. CLHelp: CLS PRINT Title$ PRINT PRINT "USAGE: CHGMOD filename [/R+][/R-][/H+][/H-][/S+][/S-][/A+][/A-]" PRINT PRINT " filename <- this is the file specification that you" PRINT " either wish to view or change" PRINT "" PRINT " [/letter + or -]" PRINT " R = Read-Only" PRINT " H = Hidden" PRINT " S = System" PRINT " A = Archive" PRINT " + = adds the attribute to the file(s)" PRINT " - = removes the attribute from the file(s)" PRINT PRINT "Have a thrilling day" END