[Back to FILES SWAG index] [Back to Main SWAG index] [Original]
{
From: "CLAUS FISCHER" <WI00227@wipool.wifo.uni-mannheim.de>
I had found the Extend.Pas and PExted.pas on SWAG.
First provides 255 File in DOS, second in protcted mode.
Now I had mixed them together and I wish to give this to
SWAG. Where should I post this?
(*** 3 Files: ***)
255DEMO.PAS (Extend Version with StdErr)
FILEPLUS.PAS (was EXTEND.PAS)
DOSMEM.PAS (was SHRINK.PAS)
{-------------------------------snipp--------------------------------}
program Test255Files;
uses fileplus, { <--- This is the magic line that does
everything }
Dos;
const MaxCount = 255;
type FileArray = array[1..MaxCount] of text;
var Count: integer;
StdErr: Text;
F: ^FileArray;
I: integer;
Num: string[6];
procedure stderror(var f:text);
var
tmpfile:text;
begin
assign(tmpfile,''); (* stdoutput *)
rewrite(tmpfile);
move(tmpfile, f, sizeof(f));
textrec(f).handle:= 2;
close(tmpfile);
end;
begin
write('Hello!! I''m running under ');
{$IFDEF MSDOS}writeln('MsDos REAL-Mode');
{$ELSE} writeln('DPMI Protected Mode');
{$ENDIF}
new(F); { Use heap because of large size of this array }
writeln('Opening files...');
Stderror(StdErr);
writeln( Stderr, '(Handle Stderr) ',TextRec(StdErr).Handle );
writeln( Output, '(Handle Stdout) ',TextRec(Output).Handle );
write( Output, '(Handle:FileNo) ');
I := 0;
repeat
inc(I);
str(I,Num);
assign(F^[I],'junk' + num + '.txt');
{$I-}
rewrite(F^[I]);
write( OutPut, i:4,':',TextRec(f^[i]).Handle );
{$I+}
until ioresult <> 0;
writeln(output);
Count := I - 1;
writeln('Successfully opened ', Count, ' files at the same time.
Writing to each file...');
for I := 1 to Count do
writeln(F^[I], 'This is a test.');
writeln('Closing and erasing each file...');
for I := 1 to Count do
begin
close(F^[I]);
erase(F^[I])
end;
writeln('Done.')
end.
{----------------------snapp----------------------------------------}
{---------------------snipp---------------------------------------}
{$I-,O-,R-}
unit fileplus; {origin name Extend}
{Patch V1.0 94-12 Claus Fischer for}
{REF: MsDos-Real-Mode: Scott Bussinger}
{ DPMI: : Kim Kokkonen, TurboPower Software}
{ catched up on SIMTEL-Archieve and SWAG-List}
{FILEPLUS Patch Claus Fischer}
{ Changes:
Main feater: Use Real-Mode and DPMI-Mode with the same Unit.
I have disabled DOS 2.xx Management because its not necessary for
me.
The SHRINK-Unit is now named as DosMem.Pas.
The futur check of MSDOS-Version is removed, because further MSDOS
vers
will shure support the prefix features. The market use this.
The DPMIExtendHandles-Function was changed to Procedure, so its
equal
to MSDOSExtendHandles (not neccesary, but looks pretty).
Claus Fischer
WI00227@WIPOOL.WIFO.UNI-MANNHEIM.DE
}
{EXTEND Version Scott Bussinger}
{ This unit allows a program to open more than the standard DOS
maximum of 20
open files at one time. You must also be sure to set a FILES=XX
statement
in your CONFIG.SYS file.
(DISABLED: This program installs a special interrupt handler
under DOS 2.x, some semi-documented features under
DOS 3.x prior to DOS 3.3 and the DOS extend files
call under DOS 3.3 or later. C.F.)
This unit USES the DOS unit and should be used BEFOR ANY OTHER UNTIS
other than the DOS unit. This code was based upon earlier work by
Randy Forgaard, Bela Lubkin and Kim Kokkonen. See EXTEND.DOC for
more information.
Scott Bussinger
Professional Practice Systems
110 South 131st Street
Tacoma, WA 98444
(206)531-8944
Compuserve [72247,2671] }
{ ** Revision History **
1 EXTEND.PAS 9-Mar-89,`SCOTT' First version using TLIB -- Based on
3.2
2 EXTEND.PAS 15-Sep-89,`SCOTT'
Added SwapVectorsExtend procedure
Put handle table into DOS memory
Use DOS 3.3 extended handles function when available
3 EXTEND.PAS 2-Oct-89,`SCOTT'
Fixed bug in determining the DOS version
4 EXTEND.PAS 5-Oct-89,`SCOTT'
Yet another bug in the DosVersion detection
5 EXTEND.PAS 19-Nov-90,`SCOTT'
New version of EXTEND that is compatible with Turbo Pascal
6.0
Modified the documentation and version numbers to be less
confusing
** Revision History ** }
{PEXTEND DPMI-Version Kim Kokkonen
------------------------------------------------------------------
This unit provides a single function, DpmiExtendHandles, for
extending the file handle table for DOS protected mode applications
under Borland Pascal 7.0.
The standard DOS call for this purpose (AH = $67) does odd things to
DOS memory when run from a BP7 pmode program. If you Exec from a
program that has extended the handle table, DOS memory will be
fragmented, leaving a stranded block of almost 64K at the top of DOS
memory. The function implemented here avoids this problem.
If you haven't used an ExtendHandles function before, note that you
cannot get more handles than the FILES= statement in CONFIG.SYS
allows. (Other utilities such as FILES.COM provided with QEMM do the
same thing.) However, even if you have FILES=255, any single program
cannot open more than 20 files (and DOS uses up 5 of those) unless
you use a routine like DpmiExtendHandles. This routine allows up to
255 open files as long as the FILES= statement provides for them.
This code works only for DOS 3.0 or later. Since (to my knowledge)
DPMI cannot be used with earlier versions of DOS, the code doesn't
check the DOS version.
Don't call this function more than once in the same program.
Version 1.0,
Written 12/15/92, Kim Kokkonen, TurboPower Software
}
interface
(* delted(0) of Dos 2.11 Version-Managament *)
(* procedure SwapVectorsExtend;
{ Swap interrupt vectors taken over by Extend unit with system
vectors }
*)
(* END of delted(0) *)
implementation
uses Dos,
{$IFDEF MSDOS} DosMem;
{$ELSE} WinApi;
{$ENDIF}
(* deleted(1) DOS 2.11 Ver ... *)
(* var ExitSave: pointer; { Previous exit
procedure }
OldInt21: pointer; { Save old INT 21 }
*)
(* END of delted(1) *)
(* Deleted(2) ... DOS 2.11 Ver *)
(*
{$L EXTEND }
procedure ExtendInit; external; { Initialize
interrupt handler }
procedure ExtendHandler; external; { Replacement INT 21
handler }
*)
(* End of delted(2) *)
(* ... deleted(3) DOS 2.11 Ver.... *)
(*
procedure SwapVectorsExtend;
{ Swap interrupt vectors taken over by Extend unit with system
vectors }
var TempVector: pointer;
begin
if lo(DosVersion) = 2 then
begin
GetIntVec($21,TempVector); { Swap the INT 21
vectors }
SetIntVec($21,OldInt21);
OldInt21 := TempVector
end
end;
*)
(* END of Deleted(3) *)
{$IFDEF MSDOS}
procedure MSDOSExtendHandles;
(* My Patch of MSDOS Scott Bussinger Version *)
{ Install the extended handles interrupt. No files (other than
standard handles) should be open when unit starts up. }
type HandleArray = array[0..254] of byte; { Room for 255
handles }
HandleArrayPtr = ^HandleArray;
var Regs: Registers;
DosMemory: pointer; { Pointer to
memory gained from DOS }
OldHandleTable: HandleArrayPtr; { Pointer to
original table }
OldNumHandles: byte; { Original number
of handles }
begin
if lo(DosVersion) <= 2
then {Patch KISS!} exit;
(* deleted(4) DOS 2.11 ..... *)
(*
begin
GetIntVec($21,OldInt21); { Install interrupt
handler under DOS 2.x }
ExtendInit; { Initialize the
interrupt handler }
SetIntVec($21,@ExtendHandler)
end
else
*)
(* END of deleted(4) *)
(* deleted(5) schnick-schnack: MickySoft will support further *)
(*
if (lo(DosVersion)>=4) or (hi(DosVersion)>=30) { Does this DOS
version support the handles call? }
then
begin
DosDispose(DosMemory); { Free up the DOS memory
block so that the next function will succeed }
with Regs do
begin
AH := $67; { Tell DOS to allow
us 255 handles }
BX := 255; { KEEP THIS NUMBER
ODD TO AVOID BUG IN SOME VERSIONS OF DOS 3.3!! }
MsDos(Regs)
end
end
else begin
*)
(* END of delted(5) *)
DosNewShrink(DosMemory,sizeof(HandleArray));
if DosMemory = nil then exit;
{ There wasn't enough memory for a handle table, so just quit }
begin {else}
{ Initialize new handles as unused *1* }
{ Get old table length *2* }
{ Save address of old table *3* }
{ Set new table length *4* }
{ Point to new handle table *5* }
{ Copy the current handle table to the new handle table *6* }
fillchar(DosMemory^,sizeof(HandleArray),$FF); (*1*)
OldNumHandles := mem[prefixseg:$0032]; (*2*)
OldHandleTable := pointer(ptr(prefixseg,$0034)^); (*3*)
mem[prefixseg:$0032] := sizeof(HandleArray); (*4*)
pointer(meml[prefixseg:$0034]) := DosMemory; (*5*)
move(OldHandleTable^,DosMemory^,OldNumHandles) (*6*)
end
end; (* of MSDOSExtenHandles *)
{$ENDIF} {of IFDEF MSDOS}
{$IFNDEF MSDOS} {.= WINAPI}
procedure DPMIExtendHandles;
const Handles = 255; (* added *)
(* My Patch of MSDOS Kim Kokkonen Version *)
(* Orginal was: function DpmiExtendHandles(Handles : Byte) : Word; *)
type DosMemRec = record
Sele, Segm : Word;
end;
var
OldTable : Pointer;
OldSize : Word;
NewTable : Pointer;
DosMem : DosMemRec;
begin
(* DEL: DpmiExtendHandles := 0; PROCEDURE replaced *)
(* DEL: if Handles <= 20 then Exit; CONST replaced *)
{Allocate new table area in DOS memory}
LongInt(DosMem) := GlobalDosAlloc(Handles);
if LongInt(DosMem) = 0 then
exit; (* add *)
(* DEL: begin DpmiExtendHandles := 8;Exit; end; PROCEDURE
replaced *)
{Initialize new table with closed handles}
NewTable := Ptr(DosMem.Sele, 0);(*1*)
FillChar(NewTable^, Handles, $FF);(*1*)
{Copy old table to new. Assume old table in PrefixSeg}
OldTable := Ptr(PrefixSeg, MemW[PrefixSeg:$34]);
OldSize := Mem[PrefixSeg:$32];
move(OldTable^, NewTable^, OldSize);
{Set new handle table size and pointer}
Mem[PrefixSeg:$32] := Handles;
MemW[PrefixSeg:$34] := 0;
MemW[PrefixSeg:$36] := DosMem.Segm;
end; (* of DPMIExtendHandles *)
{$ENDIF} {of IFNDEF MSDOS}
(* deleted(6) DOS 2.11 Ver ... *)
(*
{$F+}
procedure ExitHandler;
{$F-}
{ Uninstall the extended handles interrupt. All files (other
than standard handles) should be closed before unit exits. }
begin
ExitProc := ExitSave; { Chain to next exit
routine }
SwapVectorsExtend { Restore original
interrupt vectors }
end;
*)
(* END of delted(6) *)
begin (* of Install *)
(* deleted(7) DosVer 2.11 ... *)
(* ExitSave := ExitProc; { Remember the
previous exit routine }
ExitProc := @ExitHandler; { Install our exit routine }
*)
(* END of delted(7) *)
{$IFDEF MSDOS}
MSDOSExtendHandles; { Enable the extra handles }
{$ELSE}
DPMIExtendHandles;
{$ENDIF}
end.
{-------------------------------snapp--------------------------------}
{-------------------------------snipp-------------------------------}
unit DosMem;
{$IFDEF DPMI} *** Only Real-Mode! *** {$ENDIF}
{$IFDEF WINDOWS} *** Only Dos-Real-Mode *** {$ENDIF}
{$IFDEF OS2} *** Only Dos-Real-Mode *** {$ENDIF}
{ This unit allows you to allocate memory from the DOS memory pool
rather than
from the Turbo Pascal heap. It also provides a procedure for
shrinking the
current program to free up DOS memory.
Scott Bussinger
Professional Practice Systems
110 South 131st Street
Tacoma, WA 98444
(206)531-8944
Compuserve [72247,2671] }
{ ** Revision History **
1 SHRINK.PAS 15-Sep-89,`SCOTT' Initial version of SHRINK unit
2 SHRINK.PAS 19-Oct-90,`SCOTT'
Added support for Turbo Pascal 6's new heap manager
** Revision History ** }
interface
procedure DosNew(var P: pointer;
Bytes: word);
{ Get a pointer to a chunk of memory from DOS. Returns NIL if
sufficient DOS memory is not available. }
procedure DosDispose(var P: pointer);
{ Return an allocated chunk of memory to DOS. Only call this
function
with pointers allocated with DosNew or DosNewShrink. }
procedure DosNewShrink(var P: pointer;
Bytes: word);
{ Get a pointer to a chunk of memory from DOS, shrinking current
program
to gain DOS memory if necessary. Returns NIL if sufficient DOS
memory
is not available and there is insufficient free space in the heap
to
allow program to be shrunk to accomodate the request. }
function Linear(P: pointer): longint;
{ Return the pointer as a linear longint value }
implementation
uses Dos;
const DosOverhead = 1; { Extra number of
paragraphs that DOS requires in overhead for MCB chain }
function Linear(P: pointer): longint;
{ Return the pointer as a linear longint value }
begin
Linear := (longint(seg(P^)) shl 4) + ofs(P^)
end;
procedure DosNew(var P: pointer;
Bytes: word);
{ Get a pointer to a chunk of memory from DOS. Returns NIL if
sufficient DOS memory is not available. }
var SegsToAllocate: word;
Regs: Registers;
begin
SegsToAllocate := (Bytes+15) shr 4; { DOS allocates
memory in paragraph sized pieces only }
with Regs do
begin
AH := $48;
BX := SegsToAllocate;
MsDos(Regs);
if odd(Flags)
then
P := nil { No memory
available }
else
P := ptr(AX,$0000) { Return pointer to
memory block }
end
end;
procedure DosDispose(var P: pointer);
{ Return an allocated chunk of memory to DOS. Only call this
function
with pointers allocated with DosNew or DosNewShrink. }
var Regs: Registers;
begin
with Regs do
begin
AH := $49;
ES := seg(P^);
MsDos(Regs)
end
end;
procedure DosNewShrink(var P: pointer;
Bytes: word);
{ Get a pointer to a chunk of memory from DOS, shrinking current
program
to gain DOS memory if necessary. Returns NIL if sufficient DOS
memory
is not available and there is insufficient free space in the heap
to
allow program to be shrunk to accomodate the request. }
var BytesToAllocate: word;
Regs: Registers;
begin
BytesToAllocate := (((Bytes+15) shr 4) + DosOverhead) shl 4;
DosNew(P,Bytes);
{ Try to get memory the easy way first }
{$IFDEF VER60} {$DEFINE NEWHEAP} {$ENDIF}
{$IFDEF VER70} {$DEFINE NEWHEAP} {$ENDIF}
{$IFDEF NEWHEAP}
{ Check for Turbo 6's new heap manager }
if (P=nil) and (Linear(HeapEnd)-Linear(HeapPtr)>=BytesToAllocate)
then
begin
{ The easy method didn't work but there is sufficient space in
the heap }
dec(longint(HeapEnd),longint(BytesToAllocate) shl 12);
{ Move the top of the heap down }
with Regs do
begin
AH := $4A;
BX := seg(HeapEnd^) - prefixseg - (BytesToAllocate shr 4);
ES := prefixseg;
MsDos(Regs)
end;
DosNew(P,Bytes)
{ Try the DOS allocation one more time }
end
{$ELSE}
if (P=nil) and
{ Handle the old free list style heap }
( ( (ofs(FreePtr^)=0)
and (Linear(FreePtr)+$10000-Linear(HeapPtr)>=BytesToAllocate)
) or
(
(ofs(FreePtr^)<>0)
and (Linear(FreePtr)-Linear(HeapPtr)>=BytesToAllocate)
) )
then
begin
{ The easy method didn't work but there is sufficient space in
the heap }
OldFreePtr := FreePtr;
dec(longint(FreePtr),longint(BytesToAllocate) shl 12);
{ Decrement the segment of the pointer to the free list }
if ofs(OldFreePtr^) <> 0 then
{ If free list is empty, then there's nothing to move }
move(OldFreePtr^,FreePtr^,$10000-ofs(OldFreePtr^));
{ Otherwise, move the free list down in memory }
with Regs do
begin
AH := $4A;
BX := seg(OldFreePtr^) + $1000 - prefixseg - (BytesToAllocate
shr 4);
ES := prefixseg;
MsDos(Regs)
end;
DosNew(P,Bytes) { Try the DOS
allocation one more time }
end
{$ENDIF}
{$IFDEF NEWHEAP}{$UNDEF NEWHEAP}{$ENDIF}
end;
end.
[Back to FILES SWAG index] [Back to Main SWAG index] [Original]