I don't ask a lot of questions in this forum so I'm really hoping that somebody can help me out here.
My program requires that a number of files are copied from one directory to another. I wanted to keep the headroom low so I decided not to shell to the command interpreter and perform a COPY (please, don't suggest that I try this). I also wanted to avoid wasting valuable program string space by setting up a file buffer and performing the copy with Qbasic GET and PUT statements, so I ended up calling the DOS services with Interrupt &H21 and using the last seven pages of display memory as a file buffer (hey, if it's just sitting there wasting space, why not put it to use?)
The problem is that the FileCopy sub errors out after copying thirteen files (not twelve, not fourteen, exactly thirteen no matter what the files are, how large the files are or where the files are located).... A bit perplexing, to say the least. maybe somebody will have a heart and take a look at the following code. Sorry about the length!
BTW: I'm trying to run this under Windows XP.
' $DYNAMIC
DEFINT A-Z
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
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
DECLARE FUNCTION Dir$ (FileSpec$, Attrib)
DECLARE FUNCTION IsDirectory (FileSpec$)
DECLARE FUNCTION OpenFile (FileSpec$, AccessType)
DECLARE FUNCTION CloseFile (FileHandle)
DECLARE FUNCTION CreateFile (FileSpec$)
DECLARE SUB PUTfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
DECLARE SUB GETfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
DECLARE SUB FileCopy (Source$, Destination$)
DECLARE SUB GetDTAaddress ()
DECLARE FUNCTION ParsedFileName$ (FileSpec$)
DECLARE FUNCTION ParsedDirName$ (FileSpec$)
DECLARE FUNCTION AccessType$ (Acc)
DECLARE FUNCTION FileSize& ()
DECLARE SUB SaveVideo ()
DECLARE SUB RestoreVideo ()
' SegDTA and OffDTA are the
' Disk Transfer Area addresses
' returned by SUB GetDTAaddress
DIM SHARED SegDTA
DIM SHARED OffDTA
CONST ReadAccess = 0
CONST WriteAccess = 1
DIM SHARED ErrorCode
CLS
PRINT "I've written to various display pages and I"
PRINT "don't want to lose the information during the"
PRINT "file copy, so I save all eight pages to a file"
PRINT "so I can restore them right away."
SaveVideo
' I want to copy all BAS files from "c:\testqb\SorceDir"
' to "c:\testqb\DestnDir", so I....
Source$ = "c:\testqb\SorceDir\*.BAS"
Destination$ = "c:\testqb\DestnDir\"
CALL FileCopy(Source$, Destination$)
IF ErrorCode <> 0 THEN
PRINT "Error code: "; HEX$(ErrorCode)
PRINT "Tap a key..."
DO WHILE INKEY$ = ""
LOOP
END IF
RestoreVideo
'================ VARIOUS SUBS AND FUNCTIONS FOLLOW ===================
REM $STATIC
FUNCTION AccessType$ (Acc)
SELECT CASE Acc
CASE ReadAccess
AccessType$ = "READ"
CASE WriteAccess
AccessType$ = "WRITE"
END SELECT
END FUNCTION
'======================================================================
FUNCTION CloseFile (FileHandle)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3E00
InRegs.BX = FileHandle
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
PRINT "Error closing file #"; FileHandle
ErrorCode = OutRegs.AX
END IF
END FUNCTION
'======================================================================
FUNCTION CreateFile (FileSpec$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
' MyFile$ contains the name of the file we want to create.
MyFile$ = FileSpec$ + CHR$(0)
InRegs.AX = &H3C00
InRegs.CX = &H20
InRegs.DS = VARSEG(MyFile$)
InRegs.DX = SADD(MyFile$)
' Create an empty file
CALL InterruptX(&H21, InRegs, OutRegs)
' Function returns the file handle, unless there was an error
IF OutRegs.flags AND 1 THEN
PRINT "Error creating "; FileSpec$
ErrorCode = OutRegs.AX
ELSE
CreateFile = OutRegs.AX
END IF
END FUNCTION
'======================================================================
FUNCTION Dir$ (FileSpec$, Attrib)
' This function works a little like VB's Dir$:
' The first call to Dir$("*.BAS",0) returns the first directory
' listing for a BAS file and subsequent calls return the remaining BAS files.
' We know that we have retrieved the last file when Dir$ returns a NUL string.
' The difference with VB's Dir$ is that VB doesn't require you to pass arguments
' after the first call.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
STATIC OldSpec$
IF OldSpec$ <> FileSpec$ THEN
' This is the first search for "FileSpec"
' so call DOS "First Matching File"
OldSpec$ = FileSpec$
GetDTAaddress
NameFile$ = FileSpec$ + CHR$(0)
InRegs.DS = VARSEG(NameFile$)
InRegs.DX = SADD(NameFile$)
InRegs.CX = Attrib
InRegs.AX = &H4E00
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
Dir$ = ""
EXIT FUNCTION
END IF
Dir$ = ParsedFileName$(FileSpec$)
ELSE
' Call DOS "Next Matching File"
GetDTAaddress
InRegs.AX = &H4F00
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
FirstFile = 0
Dir$ = ""
EXIT FUNCTION
END IF
Dir$ = ParsedFileName$(FileSpec$)
END IF
END FUNCTION
'======================================================================
SUB FileCopy (Source$, Destination$)
' I've set up this file copy routine to expect a directory
' name as the destination for the copy.
DestDir$ = ParsedDirName$(Destination$)
' Check to see if the destination is a directory.
IF NOT IsDirectory(DestDir$) THEN
PRINT Destination$; " is not a directory."
EXIT SUB
END IF
SourceDir$ = ParsedDirName$(Source$)
IF NOT IsDirectory(DestDir$) THEN
PRINT SourceDir$; " is not a directory."
EXIT SUB
END IF
' Get the first file that matches the Source$ file spec
Fi$ = Dir$(Source$, 0)
IF Fi$ = "" THEN
PRINT Source$; " does not exist."
EXIT SUB
ELSE
' Process the first file
' and then get the rest of them.
DO WHILE Fi$ <> ""
RemainingBytes& = FileSize&
PRINT Fi$; RemainingBytes&; " bytes"
SourceFile$ = SourceDir$ + "\" + Fi$
SourceHandle = OpenFile(SourceFile$, ReadAccess)
IF SourceHandle = 0 THEN EXIT SUB
DestinationFile$ = DestDir$ + "\" + Fi$
DestHandle = CreateFile(DestinationFile$)
IF ErrorCode <> 0 THEN
Dummy = CloseFile(SourceHandle)
EXIT SUB
END IF
'
'Here's where the error occurs. The sub copies thirteen files flawlessly....
'Then when it tries to open the fourteenth file for write-access (this is a file
'that it just created with the CreateFile function) it bombs out with error number &H4,
'which my copy of The Big Book of Miscellaneous Disk Operating System Errors
'refers to as "Internal (system software bug)". Whatever THAT means.
'
DestHandle = OpenFile(DestinationFile$, WriteAccess)
IF ErrorCode <> 0 THEN
Dummy = CloseFile(SourceHandle)
EXIT SUB
END IF
DO WHILE RemainingBytes& > 0
' &H7000 (28672) bytes will be the largest chunk of display
' memory we'll use (the last seven pages) for a file buffer.
IF RemainingBytes& > &H7000 THEN
ThisChunk = &H7000
ELSE
ThisChunk = RemainingBytes&
END IF
RemainingBytes& = RemainingBytes& - ThisChunk
GETfile SourceHandle, &HB800, &H1000, ThisChunk
PUTfile DestHandle, &HB800, &H1000, ThisChunk
LOOP
' Close both the original and copied files
Dummy = CloseFile(SourceHandle)
IF ErrorCode <> 0 THEN EXIT SUB
Dummy = CloseFile(DestHandle)
IF ErrorCode <> 0 THEN EXIT SUB
' Get another Source File,
' until all have been copied.
Fi$ = Dir$(Source$, 0)
LOOP
END IF
END SUB
'======================================================================
FUNCTION FileSize&
' This is only set up to work for the file
' currently populating the Disk Transfer Area
DEF SEG = SegDTA
T1& = (PEEK(OffDTA + 26))
T2& = (PEEK(OffDTA + 27)) * &H100
T3& = (PEEK(OffDTA + 28)) * &H10000
T4& = (PEEK(OffDTA + 29)) * &H1000
DEF SEG
FileSize& = T1& + T2& + T3& + T4&
END FUNCTION
'======================================================================
SUB GetDTAaddress
' Get the current segment and offset
' of the Disk Transfer Area
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H2F00
CALL InterruptX(&H21, InRegs, OutRegs)
SegDTA = OutRegs.ES
OffDTA = OutRegs.BX
END SUB
'======================================================================
SUB GETfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
' This just reads the specified number of bytes from
' the current position of an open file and places them
' in memory at the specified segment and offset.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3F00
InRegs.BX = FileHandle
InRegs.CX = BufferLen
InRegs.DS = BufferSeg
InRegs.DX = BufferOffset
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
ErrorCode = OutRegs.AX
END IF
' Bytes actually read are returned in OutRegs.AX
' unless there is an error.
END SUB
'======================================================================
FUNCTION IsDirectory (FileSpec$)
' This function checks the DTA to see if the
' entry for FileSpec$ has an attribute of &H10,
' marking it as a directory. We do this because
' FirstMatchingFile and NextMatchingFile return ALL
' files (not just directories) when you pass the
' directory attribute as a parameter.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
GetDTAaddress
NameFile$ = FileSpec$ + CHR$(0)
InRegs.DS = VARSEG(NameFile$)
InRegs.DX = SADD(NameFile$)
InRegs.CX = &H10
InRegs.AX = &H4E00
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
' FileSpec$ not found,
' therefore NOT directory
IsDirectory = 0
EXIT FUNCTION
END IF
DEF SEG = SegDTA
FlAttrib = PEEK(OffDTA + 21)
DEF SEG
IF FlAttrib = &H10 THEN
IsDirectory = -1
ELSE
IsDirectory = 0
END IF
END FUNCTION
'======================================================================
FUNCTION OpenFile (FileSpec$, AccessType)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
MyFile$ = FileSpec$ + CHR$(0)
InRegs.AX = &H3D00 + AccessType
InRegs.DS = VARSEG(MyFile$)
InRegs.DX = SADD(MyFile$)
CALL InterruptX(&H21, InRegs, OutRegs)
' Open the file....
' Function returns the file handle, unless there was an error
IF OutRegs.flags AND 1 THEN
PRINT "Error opening "; FileSpec$; " for "; AccessType$(AccessType)
ErrorCode = OutRegs.AX
ELSE
OpenFile = OutRegs.AX
END IF
END FUNCTION
'======================================================================
FUNCTION ParsedDirName$ (FileSpec$)
IF INSTR(FileSpec$, "\" < 1 THEN EXIT FUNCTION
IF LEN(FileSpec$) < 1 THEN EXIT FUNCTION
FOR Re = LEN(FileSpec$) TO 1 STEP -1
IF Fs > 0 THEN Tmp$ = MID$(FileSpec$, Re, 1) + Tmp$
IF MID$(FileSpec$, Re, 1) = "\" THEN Fs = Fs + 1
NEXT
ParsedDirName$ = Tmp$
END FUNCTION
'======================================================================
FUNCTION ParsedFileName$ (FileSpec$)
DEF SEG = SegDTA
OffMatch = OffDTA + 29
Match$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(OffMatch + I))
IF c$ = CHR$(0) THEN EXIT FOR
Match$ = Match$ + c$
NEXT
DEF SEG
ParsedFileName$ = Match$
END FUNCTION
'======================================================================
SUB PUTfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
' This just takes the memory contents specified by
' "BufferSeg" and "BufferOffset" and writes the specified
' number of bytes to the current position of an open file.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4000
InRegs.BX = FileHandle
InRegs.CX = BufferLen
InRegs.DS = BufferSeg
InRegs.DX = BufferOffset
' Write the bytes to the file
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
ErrorCode = OutRegs.AX
END IF
' Bytes actually written are returned in OutRegs.AX
' unless there is an error.
END SUB
'======================================================================
SUB RestoreVideo
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
' Open the memory image file for READ access
fHandle = OpenFile("SAVEDVID.MEM", ReadAccess)
' Read 32768 bytes from the file and place them in RAM
' starting at Segment &HB800, Offset 0
FOR Address& = 0 TO &H7000 STEP &H1000
GETfile fHandle, &HB800, CINT(Address&), &H1000
NEXT
' Close the file
Dummy = CloseFile(fHandle)
END SUB
'======================================================================
SUB SaveVideo
' Create an empty file
fHandle = CreateFile("SAVEDVID.MEM"
' Open the file for WRITE access
fHandle = OpenFile("SAVEDVID.MEM", WriteAccess)
' Write eight pages of display memory
' starting at Segment &HB800, Offset 0
FOR Address& = 0 TO &H7000 STEP &H1000
PUTfile fHandle, &HB800, CINT(Address&), &H1000
NEXT
' Close the file
Dummy = CloseFile(fHandle)
END SUB
'======================================================================
[/tt]
Do no harm.
My program requires that a number of files are copied from one directory to another. I wanted to keep the headroom low so I decided not to shell to the command interpreter and perform a COPY (please, don't suggest that I try this). I also wanted to avoid wasting valuable program string space by setting up a file buffer and performing the copy with Qbasic GET and PUT statements, so I ended up calling the DOS services with Interrupt &H21 and using the last seven pages of display memory as a file buffer (hey, if it's just sitting there wasting space, why not put it to use?)
The problem is that the FileCopy sub errors out after copying thirteen files (not twelve, not fourteen, exactly thirteen no matter what the files are, how large the files are or where the files are located).... A bit perplexing, to say the least. maybe somebody will have a heart and take a look at the following code. Sorry about the length!
BTW: I'm trying to run this under Windows XP.
' $DYNAMIC
DEFINT A-Z
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
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
DECLARE FUNCTION Dir$ (FileSpec$, Attrib)
DECLARE FUNCTION IsDirectory (FileSpec$)
DECLARE FUNCTION OpenFile (FileSpec$, AccessType)
DECLARE FUNCTION CloseFile (FileHandle)
DECLARE FUNCTION CreateFile (FileSpec$)
DECLARE SUB PUTfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
DECLARE SUB GETfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
DECLARE SUB FileCopy (Source$, Destination$)
DECLARE SUB GetDTAaddress ()
DECLARE FUNCTION ParsedFileName$ (FileSpec$)
DECLARE FUNCTION ParsedDirName$ (FileSpec$)
DECLARE FUNCTION AccessType$ (Acc)
DECLARE FUNCTION FileSize& ()
DECLARE SUB SaveVideo ()
DECLARE SUB RestoreVideo ()
' SegDTA and OffDTA are the
' Disk Transfer Area addresses
' returned by SUB GetDTAaddress
DIM SHARED SegDTA
DIM SHARED OffDTA
CONST ReadAccess = 0
CONST WriteAccess = 1
DIM SHARED ErrorCode
CLS
PRINT "I've written to various display pages and I"
PRINT "don't want to lose the information during the"
PRINT "file copy, so I save all eight pages to a file"
PRINT "so I can restore them right away."
SaveVideo
' I want to copy all BAS files from "c:\testqb\SorceDir"
' to "c:\testqb\DestnDir", so I....
Source$ = "c:\testqb\SorceDir\*.BAS"
Destination$ = "c:\testqb\DestnDir\"
CALL FileCopy(Source$, Destination$)
IF ErrorCode <> 0 THEN
PRINT "Error code: "; HEX$(ErrorCode)
PRINT "Tap a key..."
DO WHILE INKEY$ = ""
LOOP
END IF
RestoreVideo
'================ VARIOUS SUBS AND FUNCTIONS FOLLOW ===================
REM $STATIC
FUNCTION AccessType$ (Acc)
SELECT CASE Acc
CASE ReadAccess
AccessType$ = "READ"
CASE WriteAccess
AccessType$ = "WRITE"
END SELECT
END FUNCTION
'======================================================================
FUNCTION CloseFile (FileHandle)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3E00
InRegs.BX = FileHandle
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
PRINT "Error closing file #"; FileHandle
ErrorCode = OutRegs.AX
END IF
END FUNCTION
'======================================================================
FUNCTION CreateFile (FileSpec$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
' MyFile$ contains the name of the file we want to create.
MyFile$ = FileSpec$ + CHR$(0)
InRegs.AX = &H3C00
InRegs.CX = &H20
InRegs.DS = VARSEG(MyFile$)
InRegs.DX = SADD(MyFile$)
' Create an empty file
CALL InterruptX(&H21, InRegs, OutRegs)
' Function returns the file handle, unless there was an error
IF OutRegs.flags AND 1 THEN
PRINT "Error creating "; FileSpec$
ErrorCode = OutRegs.AX
ELSE
CreateFile = OutRegs.AX
END IF
END FUNCTION
'======================================================================
FUNCTION Dir$ (FileSpec$, Attrib)
' This function works a little like VB's Dir$:
' The first call to Dir$("*.BAS",0) returns the first directory
' listing for a BAS file and subsequent calls return the remaining BAS files.
' We know that we have retrieved the last file when Dir$ returns a NUL string.
' The difference with VB's Dir$ is that VB doesn't require you to pass arguments
' after the first call.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
STATIC OldSpec$
IF OldSpec$ <> FileSpec$ THEN
' This is the first search for "FileSpec"
' so call DOS "First Matching File"
OldSpec$ = FileSpec$
GetDTAaddress
NameFile$ = FileSpec$ + CHR$(0)
InRegs.DS = VARSEG(NameFile$)
InRegs.DX = SADD(NameFile$)
InRegs.CX = Attrib
InRegs.AX = &H4E00
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
Dir$ = ""
EXIT FUNCTION
END IF
Dir$ = ParsedFileName$(FileSpec$)
ELSE
' Call DOS "Next Matching File"
GetDTAaddress
InRegs.AX = &H4F00
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
FirstFile = 0
Dir$ = ""
EXIT FUNCTION
END IF
Dir$ = ParsedFileName$(FileSpec$)
END IF
END FUNCTION
'======================================================================
SUB FileCopy (Source$, Destination$)
' I've set up this file copy routine to expect a directory
' name as the destination for the copy.
DestDir$ = ParsedDirName$(Destination$)
' Check to see if the destination is a directory.
IF NOT IsDirectory(DestDir$) THEN
PRINT Destination$; " is not a directory."
EXIT SUB
END IF
SourceDir$ = ParsedDirName$(Source$)
IF NOT IsDirectory(DestDir$) THEN
PRINT SourceDir$; " is not a directory."
EXIT SUB
END IF
' Get the first file that matches the Source$ file spec
Fi$ = Dir$(Source$, 0)
IF Fi$ = "" THEN
PRINT Source$; " does not exist."
EXIT SUB
ELSE
' Process the first file
' and then get the rest of them.
DO WHILE Fi$ <> ""
RemainingBytes& = FileSize&
PRINT Fi$; RemainingBytes&; " bytes"
SourceFile$ = SourceDir$ + "\" + Fi$
SourceHandle = OpenFile(SourceFile$, ReadAccess)
IF SourceHandle = 0 THEN EXIT SUB
DestinationFile$ = DestDir$ + "\" + Fi$
DestHandle = CreateFile(DestinationFile$)
IF ErrorCode <> 0 THEN
Dummy = CloseFile(SourceHandle)
EXIT SUB
END IF
'
'Here's where the error occurs. The sub copies thirteen files flawlessly....
'Then when it tries to open the fourteenth file for write-access (this is a file
'that it just created with the CreateFile function) it bombs out with error number &H4,
'which my copy of The Big Book of Miscellaneous Disk Operating System Errors
'refers to as "Internal (system software bug)". Whatever THAT means.
'
DestHandle = OpenFile(DestinationFile$, WriteAccess)
IF ErrorCode <> 0 THEN
Dummy = CloseFile(SourceHandle)
EXIT SUB
END IF
DO WHILE RemainingBytes& > 0
' &H7000 (28672) bytes will be the largest chunk of display
' memory we'll use (the last seven pages) for a file buffer.
IF RemainingBytes& > &H7000 THEN
ThisChunk = &H7000
ELSE
ThisChunk = RemainingBytes&
END IF
RemainingBytes& = RemainingBytes& - ThisChunk
GETfile SourceHandle, &HB800, &H1000, ThisChunk
PUTfile DestHandle, &HB800, &H1000, ThisChunk
LOOP
' Close both the original and copied files
Dummy = CloseFile(SourceHandle)
IF ErrorCode <> 0 THEN EXIT SUB
Dummy = CloseFile(DestHandle)
IF ErrorCode <> 0 THEN EXIT SUB
' Get another Source File,
' until all have been copied.
Fi$ = Dir$(Source$, 0)
LOOP
END IF
END SUB
'======================================================================
FUNCTION FileSize&
' This is only set up to work for the file
' currently populating the Disk Transfer Area
DEF SEG = SegDTA
T1& = (PEEK(OffDTA + 26))
T2& = (PEEK(OffDTA + 27)) * &H100
T3& = (PEEK(OffDTA + 28)) * &H10000
T4& = (PEEK(OffDTA + 29)) * &H1000
DEF SEG
FileSize& = T1& + T2& + T3& + T4&
END FUNCTION
'======================================================================
SUB GetDTAaddress
' Get the current segment and offset
' of the Disk Transfer Area
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H2F00
CALL InterruptX(&H21, InRegs, OutRegs)
SegDTA = OutRegs.ES
OffDTA = OutRegs.BX
END SUB
'======================================================================
SUB GETfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
' This just reads the specified number of bytes from
' the current position of an open file and places them
' in memory at the specified segment and offset.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3F00
InRegs.BX = FileHandle
InRegs.CX = BufferLen
InRegs.DS = BufferSeg
InRegs.DX = BufferOffset
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
ErrorCode = OutRegs.AX
END IF
' Bytes actually read are returned in OutRegs.AX
' unless there is an error.
END SUB
'======================================================================
FUNCTION IsDirectory (FileSpec$)
' This function checks the DTA to see if the
' entry for FileSpec$ has an attribute of &H10,
' marking it as a directory. We do this because
' FirstMatchingFile and NextMatchingFile return ALL
' files (not just directories) when you pass the
' directory attribute as a parameter.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
GetDTAaddress
NameFile$ = FileSpec$ + CHR$(0)
InRegs.DS = VARSEG(NameFile$)
InRegs.DX = SADD(NameFile$)
InRegs.CX = &H10
InRegs.AX = &H4E00
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
' FileSpec$ not found,
' therefore NOT directory
IsDirectory = 0
EXIT FUNCTION
END IF
DEF SEG = SegDTA
FlAttrib = PEEK(OffDTA + 21)
DEF SEG
IF FlAttrib = &H10 THEN
IsDirectory = -1
ELSE
IsDirectory = 0
END IF
END FUNCTION
'======================================================================
FUNCTION OpenFile (FileSpec$, AccessType)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
MyFile$ = FileSpec$ + CHR$(0)
InRegs.AX = &H3D00 + AccessType
InRegs.DS = VARSEG(MyFile$)
InRegs.DX = SADD(MyFile$)
CALL InterruptX(&H21, InRegs, OutRegs)
' Open the file....
' Function returns the file handle, unless there was an error
IF OutRegs.flags AND 1 THEN
PRINT "Error opening "; FileSpec$; " for "; AccessType$(AccessType)
ErrorCode = OutRegs.AX
ELSE
OpenFile = OutRegs.AX
END IF
END FUNCTION
'======================================================================
FUNCTION ParsedDirName$ (FileSpec$)
IF INSTR(FileSpec$, "\"
< 1 THEN EXIT FUNCTIONIF LEN(FileSpec$) < 1 THEN EXIT FUNCTION
FOR Re = LEN(FileSpec$) TO 1 STEP -1
IF Fs > 0 THEN Tmp$ = MID$(FileSpec$, Re, 1) + Tmp$
IF MID$(FileSpec$, Re, 1) = "\" THEN Fs = Fs + 1
NEXT
ParsedDirName$ = Tmp$
END FUNCTION
'======================================================================
FUNCTION ParsedFileName$ (FileSpec$)
DEF SEG = SegDTA
OffMatch = OffDTA + 29
Match$ = ""
FOR I = 1 TO 13
c$ = CHR$(PEEK(OffMatch + I))
IF c$ = CHR$(0) THEN EXIT FOR
Match$ = Match$ + c$
NEXT
DEF SEG
ParsedFileName$ = Match$
END FUNCTION
'======================================================================
SUB PUTfile (FileHandle, BufferSeg, BufferOffset, BufferLen)
' This just takes the memory contents specified by
' "BufferSeg" and "BufferOffset" and writes the specified
' number of bytes to the current position of an open file.
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4000
InRegs.BX = FileHandle
InRegs.CX = BufferLen
InRegs.DS = BufferSeg
InRegs.DX = BufferOffset
' Write the bytes to the file
CALL InterruptX(&H21, InRegs, OutRegs)
IF OutRegs.flags AND 1 THEN
ErrorCode = OutRegs.AX
END IF
' Bytes actually written are returned in OutRegs.AX
' unless there is an error.
END SUB
'======================================================================
SUB RestoreVideo
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
' Open the memory image file for READ access
fHandle = OpenFile("SAVEDVID.MEM", ReadAccess)
' Read 32768 bytes from the file and place them in RAM
' starting at Segment &HB800, Offset 0
FOR Address& = 0 TO &H7000 STEP &H1000
GETfile fHandle, &HB800, CINT(Address&), &H1000
NEXT
' Close the file
Dummy = CloseFile(fHandle)
END SUB
'======================================================================
SUB SaveVideo
' Create an empty file
fHandle = CreateFile("SAVEDVID.MEM"
' Open the file for WRITE access
fHandle = OpenFile("SAVEDVID.MEM", WriteAccess)
' Write eight pages of display memory
' starting at Segment &HB800, Offset 0
FOR Address& = 0 TO &H7000 STEP &H1000
PUTfile fHandle, &HB800, CINT(Address&), &H1000
NEXT
' Close the file
Dummy = CloseFile(fHandle)
END SUB
'======================================================================
[/tt]
Do no harm.