'Copy anything you want into your own programs. As always, please report any
'bugs. Regards, Michael.
'CLOSE the file before using this method.
'Be extremely careful not to corrupt/destroy important files.
DECLARE FUNCTION SetFileLen% (SFLname$, SFLsize&)
DECLARE SUB iniFileLen ()
' This area written by Michael Calkins (mcalkins0@hotmail.com)
TYPE FileLenType
filen AS STRING * 140 'file path/name+null char
segm AS INTEGER 'segment of filen
offs AS INTEGER 'offset of filen
high AS INTEGER 'high half of new size
low AS INTEGER 'low half of new size
handle AS INTEGER 'file handle
ax AS INTEGER 'AX register
flags AS INTEGER 'FLAGS register
openf AS STRING * 28 'code to open file for read/write
seekf AS STRING * 28 'code to seek to position
writef AS STRING * 33 'code to write 0 bytes to file
closef AS STRING * 18 'code to close file
status AS INTEGER 'guarentees instalation of routines before CALL ABSOLUTE
END TYPE
DIM SHARED FileLen AS FileLenType
iniFileLen
' End of area written by Michael Calkins
'example written by Michael Calkins:
CLS
PeanutWare
test$ = "filelent.txt"
SHELL "echo 0123456789ABCDEF>" + test$
new& = 8
SHELL "dir " + test$
SHELL "type " + test$
COLOR 15
PRINT "Truncating file:"
IF SetFileLen%(test$, new&) THEN PRINT "Fail." ELSE PRINT "Success."
COLOR 7
SHELL "dir " + test$
SHELL "type " + test$
SYSTEM
SUB iniFileLen
' This SUB written by Michael Calkins (mcalkins0@hotmail.com)
'find offsets of variables and store in low byte,high byte order
IFLsegm$ = MKI$(VARPTR(FileLen.segm))
IFLoffs$ = MKI$(VARPTR(FileLen.offs))
IFLhigh$ = MKI$(VARPTR(FileLen.high))
IFLlow$ = MKI$(VARPTR(FileLen.low))
IFLhandle$ = MKI$(VARPTR(FileLen.handle))
IFLflags$ = MKI$(VARPTR(FileLen.flags))
IFLax$ = MKI$(VARPTR(FileLen.ax))
IF LEN(FileLen.closef) <> LEN(IFL$) THEN PRINT "Err", LEN(FileLen.closef); LEN(IFL$): SYSTEM
FileLen.closef = IFL$
FileLen.status = -1 'complete
'Code written by Michael Calkins with a lot of help from:
'"Advanced MS-DOS Programming", by Ray Duncan, published by Microsoft Press.
'"????" denotes variable memory address
'4 machine language subroutines:
'closef:
'8B1E???? MOV BX,[handle] ;file handle
'B43E MOV AH,3E ;"Close file"
'CD21 INT 21 ;MS-DOS
'9C PUSHF ;get FLAGS
'5B POP BX ;store in BX
'891E???? MOV [flags],BX ;record FLAGS
'A3???? MOV [ax],AX ;record AX
'CB RETF ;far return
END SUB
SUB PeanutWare
'This sub originally written by Michael Calkins, Floresville, TX 78114
'email: "mcalkins0@hotmail.com"
COLOR 15, 0
PRINT STRING$(80, 196);
COLOR 15, 6
PRINT "PeanutWare"
COLOR 7, 0
PRINT "Programming for setting arbitrary file lengths is wriiten by Michael Calkins."
PRINT "mcalkins0@hotmail.com."
COLOR 15, 0
PRINT STRING$(80, 196);
COLOR 7, 0
END SUB
FUNCTION SetFileLen% (SFLname$, SFLsize&)
' This FUNTION written by Michael Calkins (mcalkins0@hotmail.com)
' call with file name, new size (00000000 to FFFFFFFF).
' returns 0000 if success, FFFF if failure.
SFLret% = -1
IF FileLen.status THEN
FileLen.filen = SFLname$ + CHR$(0)
SFLseek& = SFLsize&
FileLen.high = (SFLseek& AND &HFFFF0000) \ &H10000
FileLen.low = SFLseek& AND &HFFFF
FileLen.segm = VARSEG(FileLen.filen)
FileLen.offs = VARPTR(FileLen.filen)
DEF SEG = VARSEG(FileLen.openf): CALL ABSOLUTE(VARPTR(FileLen.openf)): DEF SEG
IF FileLen.flags AND 1 THEN 'if error then
PRINT "open failed:"; HEX$(FileLen.handle)
ELSE
DEF SEG = VARSEG(FileLen.seekf): CALL ABSOLUTE(VARPTR(FileLen.seekf)): DEF SEG
IF FileLen.flags AND 1 THEN 'if error then
PRINT "seek failed:"; HEX$(FileLen.ax)
ELSE
DEF SEG = VARSEG(FileLen.writef): CALL ABSOLUTE(VARPTR(FileLen.writef)): DEF SEG
IF FileLen.flags AND 1 THEN 'if error then
PRINT "write failed:"; HEX$(FileLen.ax)
ELSE
SFLret% = 0
END IF
END IF
DEF SEG = VARSEG(FileLen.closef): CALL ABSOLUTE(VARPTR(FileLen.closef)): DEF SEG
IF FileLen.flags AND 1 THEN 'if error then
PRINT "close failed:"; HEX$(FileLen.ax)
SFLret% = -1
END IF
END IF
ELSE
PRINT "Do not call SetFileLen before loading subroutines."
END IF
SetFileLen% = SFLret%
END FUNCTION
This message has been edited by MCalkins on Jul 4, 2005 10:16 PM This message has been edited by MCalkins on May 15, 2005 10:12 PM