home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 5
/
ctrom5b.zip
/
ctrom5b
/
PROGRAM
/
PASCAL
/
NWTP06
/
NWINTR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-03-01
|
22KB
|
762 lines
UNIT NWintr;
{ DPMI Protected mode calls: Hubert Plattfaut of 2:2447/203.4
Windows Protected Mode calls:
-Based on EZDPMI by Julian M. Bucknall [1993: 100116.1572@Compuserve.Com]
-Based on the NetCalls and WinDPMI units by Siebrand Dijkstra [1995: 2:512/250.595]
-Corrections by Berend de Boer [1995: berend@beard.nest.nl or 2:281/527.23]
NwTP Version 0.6, 950301, Copyright 1993,1995 R. Spronk
}
INTERFACE
{$B-,F+,O-,R-,S-,X+}
{$DEFINE ProtMode}
{$IFDEF MSDOS}
{$DEFINE RealMode}
{$UNDEF ProtMode}
{$ENDIF}
uses
{$IFDEF RealMode} Dos
{$ENDIF}
{$IFDEF DPMI} Dos,WinApi { we need the GlobalDosAlloc-Function}
{$ENDIF}
{$IFDEF WINDOWS} WinTypes,WinDOS,WinProcs
{$ENDIF};
CONST VLM_ID_UNKNOWN = $0000; { non-VLM application }
VLM_ID_VLM = $0001;
VLM_ID_CONN = $0010;
VLM_ID_TRAN = $0020;
VLM_ID_IPX = $0021;
VLM_ID_TCP = $0022;
VLM_ID_NWP = $0030;
VLM_ID_BIND = $0031;
VLM_ID_NDS = $0032;
VLM_ID_PNW = $0033;
VLM_ID_RSA = $0034;
VLM_ID_REDIR = $0040;
VLM_ID_FIO = $0041;
VLM_ID_PRINT = $0042;
VLM_ID_GENR = $0043;
VLM_ID_NETX = $0050;
VLM_ID_AUTO = $0060;
VLM_ID_SECURITY = $0061;
VLM_ID_NMR = $0100;
VLM_ID_DRVPRN = $09F2;
VLM_ID_SAA = $09F5; { SAA Client API for NetWare }
VLM_ID_IPXMIB = $09F6;
VLM_ID_PNWMIB = $09F7;
VLM_ID_PNTRAP = $09F8;
VLM_ID_MIB2PROT = $09F9;
VLM_ID_MIB2IF = $09FA;
VLM_ID_NVT = $09FB;
VLM_ID_TRAP = $09FC;
VLM_ID_REG = $09FD;
VLM_ID_ASN1 = $09FE;
VLM_ID_SNMP = $09FF;
Type
{$ifdef ProtMode}
TTregisters= Record {This is the data-structure for the}
Case Byte Of {real-mode-interrupts in DPMI-mode}
0: {32 bit registers}
(EDI,ESI,EBP,Reserved,EBX,EDX,
ECX,EAX:LongInt);
1: {16 bit registers}
(DI,DIHigh,SI,SIHigh,
BP,BPHigh,ReservedLow,ReservedHigh,
BX,BXHigh,DX,DXHigh,
CX,CXHigh,AX,AXHigh,
Flags,ES,DS,FS,GS,IP,
CS,SP,SS:Word);
2: {8 bit registers}
(DILowLow,DILowHigh,DIHighLow,DIHighHigh,
SILowLow,SILowHigh,SIHighLow,SIHighHigh,
BPLowLow,BPLowHigh,BPHighLow,BPHighHigh,
ReservedLowLow,ReservedLowHigh,ReservedHighLow,ReservedHighHigh,
BL,BH,BXHighLow,BXHighHigh,
DL,DH,DXHighLow,DXHighHigh,
CL,CH,CXHighLow,CXHighHigh,
AL,AH,AXHighLow,AXHighHigh:Byte)
End;
{$else} {RealMode}
TTregisters= Record
case Integer of
0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
end;
{$endif}
TPtrRec=record Ofs,Seg:word end;
TintrBuffer=array[1..576] of byte;
TPintrBuffer=^TintrBuffer;
TVLMheader=record
unknown1 :array[1..4] of byte;
ptr1ofs,ptr1seg, { pointers to 'procedures' }
ptr2ofs,ptr2seg,
ptr3ofs,ptr3seg,
ptr4ofs,ptr4seg :word;
unknown2 :array[1..4] of byte; { 00 00 00 00 }
HeaderLen :byte; { 1.11-> 4E; 1.20-> 4E}
MultiplexIDstring :array[1..3] of char; { 56 4C 4D 'VLM' }
unknown3 :array[1..4] of byte; { 01 00 80 00 }
TransientSwitchCount :word;
CallCount :word;
ControlBlockOfs :word; { in same segment as this header }
CurrentVLMID :word;
MemoryType :byte; { 04 = XMS }
ModulesLoaded :byte;
BlockId :word;
TransientBlock :word;
GlobalSegment :word;
AsyncQueue :array[1..3] of record { head, tail, s }
pqofs,pqseg:word;
end;
BusyQueue :array[1..3] of record { head, tail, s }
pqofs,pqseg:word;
end;
ReEntranceLevel :word;
FullMapCount :word;
unknown5 :word; { 00 00 }
end;
TVLMcontrolBlockEntry=record
Flag :word;
ID :word;
Func :word;
Maps :word;
TimesCalled :word;
unknown1 :word; { SSeg ? }
TransientSeg,GlobalSeg :word;
AddressLow,AddressHi :word;
TsegSize,GSegSize,SSegSize:word; { in 16 byte paragraphs }
VLMname :array[1..9] of char;
{ null terminated string }
end;
Var GlobalReqBuf,GlobalReplyBuf:TPintrBuffer;
{ real-mode only, DPMI: all flags are set to false }
VLM_EXE_loaded :Boolean;
NETX_VLM_loaded:Boolean; { if true, then VLM_EXE_loaded must also be true. }
NETX_EXE_loaded:Boolean;
Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
Procedure nwMsDos(VAR R:ttregisters);
Function InRealMode:Boolean;
Function MapRealmodeSegment(RSeg:Word):Word;
Function nwPtr(s,o:word):Pointer;
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
{$IFDEF RealMode}
Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
Function GetVLMControlBlock(Entry:Byte;
Var ControlBlock:TVLMControlBlockEntry):Boolean;
{ entry: 0 .. VLMheader.ModulesLoaded }
{$ENDIF}
IMPLEMENTATION {===========================================================}
Var GlobalRegisters:TTregisters; { all Modes ! }
VLMCall:Procedure;
{$IFDEF RealMode}
Var VLMtransientSeg:word;
{ ---------- Real mode procedures ------------------------------------}
{$F+}
Var RequesterProc:Procedure(Var regs:Registers);
{ VLMCall:Procedure; }
Procedure VlmSystemCall(Var regs:registers); assembler;
asm
push ds
{ check if VLMCall known. If not, return error $FF in fake AL }
xor ah,ah
mov al,$FF
les di,VLMCall
mov bx,es
cmp bx,$0000
je @1
{ move fake regs registers to 'real' registers }
{ AX, CX, DX, DS, SI, DI, ES only. }
les di,regs
mov ax,es:[di+16]
push ax { push new es }
mov ax,es:[di+12]
push ax { push new di }
mov ds,es:[di+14]
mov ax,es:[di]
mov cx,es:[di+4]
mov dx,es:[di+6]
mov si,es:[di+10]
pop di
pop es
{ farr call to VLM handler }
push bp
CALL VLMCall
pop bp
@1: { move 'real' registers to fake regs registers }
{push es
push di}
les di,regs
mov es:[di],ax
{mov es:[di+4],cx
mov es:[di+6],dx
mov es:[di+10],si
pop ax ax:= 'di'
mov es:[di+12],ax
pop ax ax:= 'es'
mov es:[di+16],ax }
pop ds
end;
Procedure VLMcheck;
CONST DOS_MULTIPLEX =$2F;
Var regs:registers;
ccode:byte;
Function getBinderyAccessLevel:boolean; { to be replaced by a non-bindery call }
Type Treq=record
len :word;
subF :byte;
end;
Trep=record
accLeveL:byte;
_objId:longInt;
fill:array[1..20] of byte;
end;
TPreq=^Treq;
TPrep=^Trep;
Var result:word;
BEGIN
With TPreq(GlobalReqBuf)^
do begin
subF:=$46;
len:=sizeOf(Treq)-2;
end;
F2SystemCall($17,sizeOf(Treq),sizeOf(Trep),result);
GetBinderyAccessLevel:=(result=0);
end;
Var phdr:^TVLMHeader;
pVLMcbl:^TVLMcontrolBlockEntry;
t:word;
begin
VLM_EXE_Loaded:=false;
Regs.AX:=$7A20;
Regs.BX:=$0000;
Regs.CX:=$0000;
Intr($2F,Regs);
if regs.AX=$0000
then begin
{ OK. AX=0000. All seems well. But is it really the 2F VLM handler? }
phdr:=ptr(regs.es,$0000);
VLM_EXE_Loaded:=(phdr^.MultiplexIdString[1]='V')
and (phdr^.MultiplexIdString[2]='L')
and (phdr^.MultiplexIdString[3]='M');
IF VLM_EXE_Loaded
then begin
NETX_EXE_loaded:=False;
{ Determine whether netx.vlm is loaded }
NETX_VLM_Loaded:=False;
t:=0;
While t<phdr^.ModulesLoaded
do begin
pVLMcbl:=ptr(regs.es,phdr^.ControlBlockOfs+(t*SizeOf(TVLMControlBlockEntry)));
IF pVLMcbl^.ID=VLM_ID_NETX
then begin
t:=$0100; { end of iteration }
NETX_VLM_Loaded:=True;
end;
inc(t);
end;
{ Set requester proc to VLM entry point }
@VLMcall:=Ptr(Regs.es,Regs.bx);
VLMtransientSeg:=regs.es;
{ @requesterProc:=@VLMsystemCall; ---------- ERR ------}
@RequesterProc:=@dos.msdos;
end
end;
if NOT VLM_EXE_Loaded
then begin
NETX_VLM_loaded:=false;
@RequesterProc:=@dos.msdos;
NETX_EXE_loaded:=GetBinderyAccessLevel;
end;
end;
Function RealModeIntr(intNo:byte;Var regs:TTregisters):boolean;
begin
Intr(intNo,registers(regs));
RealModeIntr:=true;
end;
Procedure nwMsDos(VAR R:ttregisters);
begin
msDos(registers(R));
end;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
begin
With GlobalRegisters
do begin
CX := Req_size;
DX := rep_size;
AH := $f2;
AL := subf;
DS := Seg(GlobalReqBuf^); SI := Ofs(GlobalReqBuf^);
ES := Seg(GlobalReplyBuf^);DI := Ofs(GlobalReplyBuf^);
MSDOS(registers(GlobalRegisters));
Result:=al;
end;
end;
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
begin
Sreq := Seg(GlobalReqBuf^);
Oreq := Ofs(GlobalReqBuf^);
Srep := Seg(GlobalReplyBuf^);
Orep := Ofs(GlobalReplyBuf^);
end;
Function GetVLMheader(Var VLMheader:TVLMheader):Boolean;
Var p:^TVLMHeader;
begin
if VLMtransientSeg<>$0000
then begin
p:=ptr(VLMtransientSeg,$0000);
move(p^,VLMheader,SizeOf(TVLMHeader));
end;
GetVLMHeader:=(VLMtransientSeg<>$0000);
end;
Function GetVLMControlBlock(Entry:Byte;
Var ControlBlock:TVLMControlBlockEntry):Boolean;
{ entry: 0 .. VLMheader.ModulesLoaded }
Var ph:^TVLMHeader;
pcb:^TVLMControlBlockEntry;
begin
if VLMtransientSeg<>$0000
then begin
ph:=ptr(VLMtransientSeg,$0000);
pcb:=ptr(VLMtransientSeg,ph^.ControlBlockOfs+entry*SizeOf(TVLMControlBlockEntry));
move(pcb^,ControlBlock,SizeOf(TVLMControlBlockEntry));
end;
GetVLMControlBlock:=(VLMtransientSeg<>$0000);
end;
Function nwPtr(s,o:word):Pointer;
begin
nwPtr:=Ptr(s,o);
end;
Function MapRealmodeSegment(RSeg:Word):Word;
begin
MapRealmodeSegment:=RSeg;
end;
{$ENDIF} {------------- end of real-mode procedures -------------------}
{$IFDEF ProtMode}
Type pRealSegItem=^tRealSegItem;
tRealSegItem=record {structure to store information}
Seg:word; {about allocated selectors}
Sel:Word;
prev,next:pRealSegItem;
end;
{we need to allocate selectors which map real-mode segments.}
{all these selectors are stored in an dynamic list}
{and are cleand up them at then end of the program}
Var GlobalRealReqSeg,
GlobalRealReplySeg:Word;
SelectorList:pRealSegItem;
Function RealModeIntr (IntNo:Byte;VAR Regs:ttregisters):Boolean;Assembler;
{Simulate a call to the spectified real mode interrupt. The registers passed
to the real mode code are held in RealModeRegisters. This structure contains
the register content upon termination of the real mode ISR.
Returns False if there was an error.}
ASM
push di
push es
mov bh,00 {For DOSX to reset the int controller and A20 line. Windows ingores it.}
mov bl,IntNo {Tell DPMI which interrupt to simulate}
xor cx,cx {0 bytes to copy to real mode stack}
les di,Regs {Get the real mode structure}
mov word ptr es:[di+$c],0 {reserved to 0}
mov word ptr es:[di+$c+2],0
mov word ptr es:[di+$26],0 {fs to 0}
mov word ptr es:[di+$28],0 {gs to 0}
mov word ptr es:[di+$2e],0 {sp to 0}
mov word ptr es:[di+$30],0 {ss to 0}
mov ax,$0300 {Function 0300h is simulate real mode interrupt}
int 31h
jc @Error {The carry flag was set, so there was an error}
mov ax,True {Return no error}
jmp @AllDone
@Error:
mov ax,False {Return false indicating an error}
@AllDone:
pop es
pop di
End;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word;Var result:word);
begin
With GlobalRegisters
do begin
CX := Req_size;
DX := rep_size;
AH := $f2;
AL := subf;
DS := GlobalRealReqSeg; {Use then REAL-MODE segments}
ES := GlobalRealReplySeg; {of the global buffers}
DI := 0; {OFFSET always 0 for}
SI := 0; {'GlobalDosAlloc'ated memory}
if not RealModeIntr($21,GlobalRegisters)
then RUNERROR(217);
{DPMI-ERRORS, maybe we should stop the system with the new Errorcode 217}
Result:=al;
end;
end;
Procedure nwMsDos(VAR R:ttregisters);
begin
if not RealModeIntr($21,R)
then RUNERROR(217);
{DPMI-ERRORS, maybe we should stop then system with the new Errorcode 217}
end;
Procedure GetGlobalBufferAddress(VAR Sreq,Oreq,Srep,Orep:Word);
begin
Sreq := GlobalRealReqSeg; {Use the REAL-MODE segments}
Srep := GlobalRealReplySeg; {of the global buffers}
Oreq := 0; {OFFSET always 0 for}
Orep := 0; {'GlobalDosAlloc'ated memory}
end;
{----- Some low-level functions for DPMI -----------}
TYPE os = record
o, s : Word;
end; {for typecasts}
LDTStr = record {Structure of LDT-Elements}
limit : Word;
base : Word;
data : Array[0..1] of Word;
end;
Procedure Halt218; {runError 218: low-level DPMI-Errors}
begin
RunError(218);
end;
{DMPI-Function 0: Allocate LDT Descriptor}
function AllocLDTD(var NEWD : Word) : Word; Assembler;
asm
xor ax,ax
mov cx,1 {only 1 descriptor needed}
int 31h {Call DPMI}
jnc @@ok
Call Halt218 {Error on carry}
@@ok:
les di,NEWD {save descriptor to VAR NEWD}
mov es:[di],ax
xor ax,ax
end;
{DMPI-Function 1: Free LDT Descriptor}
function FreeLDTD(D : Word) : Word; Assembler;
asm
mov ax,0001h
mov bx,D
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 7: Set Segment Base Address}
function SetSBA(S: Word; BA: LongInt) : Word; Assembler;
asm
mov ax,0007h
mov bx,S
mov cx,word ptr BA+2
mov dx,word ptr BA
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 8: Set Segment Limit}
function SetSL(S: Word; L: LongInt) : Word; Assembler;
asm
mov ax,0008h
mov bx,S
mov dx,word ptr L
mov cx,word ptr L+2
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 9: Set Descriptor Access Rights}
function SetDAS(S: Word; R: Word) : Word; Assembler;
asm
mov ax,0009h
mov bx,S
mov cx,R
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{DMPI-Function 11: Get Descriptor}
function GetD(S: Word; var D : LDTStr) : Word; Assembler;
asm
mov ax,000Bh
mov bx,S
les di,D
int 31h
jc @@Ex {carry: return Error in ax}
xor ax,ax
@@Ex:
end;
{Set then Length of the Descriptor-Segment}
function SetLimit(Sele: Word; L: LongInt) : Word;
var St,R: Word;
Des : LDTStr;
begin
St:= GetD(Sele, Des); {get the Descriptor-Entry from LDT}
if St <> 0
then begin
SetLimit:= St; {not in LDT, return Error}
Exit;
end;
with Des
do R := (Data[0] shr 8) or ((Data[1] and $00F0) shl 8);
{form then rights for the DPMI-9-Call, register cl}
if L > $FFFFF
then begin {> 1MB: Page aligned}
if L and $FFF <> $FFF
then begin {Limit=Length-1!}
SetLimit := $8021; {return Error: not page aligned}
Exit;
end;
R:= R or $8000; {set Page granularity}
end
else R:= R and $7FFF; {set Byte granularity}
St := SetSL(Sele, 0); {fist set limit to 0}
if St = 0 then St := SetDAS(Sele, R); {ok, set the new rights}
if St = 0 then St:= SetSL(Sele, L); {ok, set then limit}
SetLimit := St; {return errorcode}
end;
{get a Selector for a part of then real-mode memory}
function RealMemSel(RealP : Pointer; Limit : LongInt; var Sele : Word) : Word;
function NP(P : Pointer) : LongInt;
VAR TC:OS absolute P;
begin
NP := (LongInt(TC.S) shl 4)+LongInt(TC.O);
end;
var St : Word;
begin
St := AllocLDTD(Sele); {get a new Selector}
if St = 0
then begin
St := SetSBA(Sele, NP(RealP)); {set base addresse to the linear}
if St = 0
then begin {address of the Real-Segment}
St := SetLimit(Sele, Limit); {set the selector-limit}
if St <> 0
then if FreeLDTD(Sele)<>0 then; {on error: free selector}
end
else if FreeLDTD(Sele)<>0 then; {on error: free selector}
end;
RealMemSel := St; {return errorcode}
end;
{check if the required selector is already allocated}
Function InSelectorList(S:Word):pRealSegItem;
VAR li:pRealSegItem;
begin
li:=SelectorList;
while li<>NIL
do begin
if li^.Seg=S
then begin
InSelectorList:=Li;
exit;
end;
li:=li^.Next;
end;
InSelectorList:=NIL;
end;
{insert a new SelectorItem at start of the list}
Procedure AddToSelectorlist(Segment,Selector:Word);
VAR li:pRealSegItem;
begin
new(li);
with li^
do begin
Seg:=segment;
Sel:=Selector;
next:=Selectorlist;
prev:=NIL;
end;
Selectorlist^.prev:=li;
Selectorlist:=li;
end;
{clean up}
Procedure FreeSelectorList;
VAR li:pRealSegItem;
begin
while Selectorlist<>NIL
do begin
li:=selectorlist;
selectorlist:=li^.next;
if li^.sel<>0
then FreeLDTD(li^.Sel);
dispose(li);
end;
end;
Function MapRealmodeSegment(RSeg:Word):Word;
VAR sel:Word;
li:pRealSegItem;
begin
li:=InSelectorList(RSeg);
if li=NIL
then begin
if RealMemSel(Ptr(RSeg,0),$ffff,Sel)<>0
then RUNERROR(217); {something's wrong: Errorcode 217}
MapRealModeSegment:=Sel;
AddToSelectorList(Rseg,Sel);
end
else MapRealModeSegment:=li^.Sel;
end;
Function nwPtr(s,o:word):Pointer;
begin
nwPtr:=Ptr(MapRealModeSegment(s),o);
end;
{$ENDIF} {----------------- end of protected mode procedures -------------}
Var OldExitProc:pointer;
Function InRealMode:Boolean;
begin
{$IFDEF Windows}
InRealMode:=(GetWinFlags and wf_PMode)=0;
{$ELSE}
{$IFDEF ProtMode}
InRealMode:=False;
{$ELSE}
InRealMode:=True;
{$ENDIF}
{$ENDIF}
end;
{$F+}
Procedure IntrExit;
begin
ExitProc:=OldExitProc;
{$IFDEF ProtMode}
if GlobalDosFree(Seg(GlobalReqBuf^))<>0 then; {ignore Errors}
if GlobalDosFree(Seg(GlobalReplyBuf^))<>0 then;
FreeSelectorList;
{$ELSE} {RealMode}
FreeMem(GlobalReqBuf,SizeOf(TintrBuffer));
Freemem(GlobalReplyBuf,Sizeof(TintrBuffer));
{$ENDIF}
end;
{$F-}
{$IFDEF ProtMode}
VAR w1:Longint absolute GlobalRegisters;
{ we only need w1 during the initialisation, so we use the static
var GlobalRegisters to save 4 bytes of memory :-) }
{$ENDIF}
begin
VLM_EXE_Loaded:=false;
NETX_EXE_loaded:=false;
NETX_VLM_loaded:=false;
{$IFDEF ProtMode}
new(SelectorList);
fillchar(Selectorlist^,Sizeof(Selectorlist^),0);
w1:=GlobalDosAlloc(Sizeof(tIntrBuffer)); {alloc REQ-Buffer}
if w1=0
then runerror(217); {DPMI-ERROR, no free Memory}
GlobalReqBuf:=Ptr(loWord(w1),0); {buffer-address for protected Mode}
GlobalRealReqSeg:=hiWord(w1); {REAL-Mode-Segment of the buffer-address}
w1:=GlobalDosAlloc(Sizeof(tIntrBuffer)); {alloc REPLY-Buffer}
if w1=0
then runerror(217);
GlobalReplyBuf:=Ptr(loWord(w1),0);
GlobalRealReplySeg:=hiWord(w1);
{$else} {RealMode}
new(GlobalReqBuf);
if GlobalReqBuf=NIL
then RunError(203); {where has all the memory gone?? /Heap-Overflow}
new(GlobalReplyBuf);
if GlobalReplyBuf=NIL
then RunError(203);
VLMtransientSeg:=$0000;
VLMcheck;
{$endif}
OldExitProc:=ExitProc;
ExitProc:=@IntrExit;
end.