CD Actual 15/CDACTUAL15.iso/cdactual/program/c/WT9201.ZIP/DPMI.ZIP/WNETBIOS.PAS

Pascal/Delphi Source File | 1991-12-23 | 8.2 KB | 292 lines

WNETBIOS.PAS - Source to a DLL implementing the NetBIOS routines using DPMI
{*********************************************************}
{*                 WNETBIOS.PAS 1.00                     *}
{*        Copyright (c) TurboPower Software 1991.        *}
{*                 All rights reserved.                  *}
{*********************************************************}
{$C Fixed}
{$S-,R-,I-,V-}

Library WNetBios;

uses
  WinDos, WinProcs, WinTypes, WinDPMI, TNetBIOS;

function AllocateWinNCB(var N : WinNCB) : Boolean; Export;
  {-Allocates memory for an NCB and maintains a real and protected mode ptr}
var
  L : LongInt;
begin
  L := GlobalDosAlloc(SizeOf(NCB));
  AllocateWinNCB := L <> 0;
  with N do begin
     NR := Ptr(DoubleWord(L).HiWord, 0);
     NP := Ptr(DoubleWord(L).LoWord, 0);
  end;
end;

procedure FreeWinNCB(N : WinNCB); Export;
  {-Frees a WinNCB previously allocated with AllocateWinNCB}
begin
  GlobalDosFree(SegOfs(N.NP).Segm);
end;

procedure ClearNCB(var N : NCB);

begin
  FillChar(N,SizeOf(NCB),$00);     {fill the NCB with 0}
end;

procedure NetBIOSRequest(N : NCBPtr);
var
  Regs : DPMIRegisters;
begin
  FillChar(Regs, SizeOf(Regs), 0);
  with Regs do begin
    drES := SegOfs(N).Segm;
    drBX := SegOfs(N).Ofst;
    drFlags := GetCPUFlags;
  end;
  SimulateRealModeInt($5C, 0, Regs);
end;

procedure SendDataGram(var N : WinNCB; SenderNameNum : Byte;
                       ReceiverName : NBNameStr;
                       Wait : Boolean;
                       var PostEvent : WindowsPostType;
                       DGSize : Word;
                       Datagram : Pointer); Export;
{Send a data packet via datagram services}

begin
  ClearNCB(N.NP^);
  {build the NCB}
  with N.NP^ do begin
    Command := $20;
    if not Wait then begin
      Command := Command + NoWait;
      PostRoutine := PostEvent.Callback;           {set the post event routine}
      PostEvent.NCBs := @N;
    end;
    Buffer  := DataGram;          {point Buffer at the data to send}
    BufLen  := DGSize;            {set the size of the data}
    NameNum := SenderNameNum;     {the name number to associate with}
    LanaNum := 0;
    Move(ReceiverName[1],CallName,Length(ReceiverName)); {the receiver}
  end;
  NetBiosRequest(N.NR);              {send it off}
end;

procedure ReceiveDataGram(var N : WinNCB;
                          ReceiverNameNum : Byte;
                          Wait : Boolean;
                          var PostEvent : WindowsPostType;
                          DGSize : Word;
                          Datagram : Pointer); Export;
{receive a data packet via datagram services. If Wait is TRUE, then this
 routine will wait until a datagram is received before returning. Otherwise,
 it waits for the datagram in the background. The CmdCompleted field of the
 NCB reports when the event is complete if Wait is FALSE.
}
begin
  ClearNCB(N.NP^);
  {build the NCB}
  with N.NP^ do begin
    Command := $21;
    if not Wait then begin
      Command := Command + NoWait;  {return immediately-do not wait for msg}
      PostRoutine := PostEvent.Callback;           {set the post event routine}
      PostEvent.NCBs := @N;
    end;
    Buffer  := DataGram;           {point buffer at data receive buffer}
    BufLen  := DGSize;
    NameNum := ReceiverNameNum;
  end;
  NetBiosRequest(N.NR);
end;

function CancelRequest(var N : WinNCB) : Byte; Export;
  {-cancels a pending NetBIOS function request}
var
  CancelNCB        : WinNCB;
begin
  if not AllocateWinNCB(CancelNCB) then begin
    CancelRequest := NBEDPMIError;
    Exit;
  end;
  ClearNCB(CancelNCB.NP^);
  with CancelNCB.NP^ do begin
    Buffer    := N.NR;
    Command   := $35;
    LanaNum   := 0;
  end;

  NetBiosRequest(CancelNCB.NR);

  with CancelNCB.NP^ do
    CancelRequest := RetCode;
  FreeWinNCB(CancelNCB);
end;

function NetBiosAddName(NameToAdd : NBNameStr;
                        var NameNumber : Byte) : Byte; Export;
  {-Adds a NetBIOS unique name to the name table}
var
  NameNCB : WinNCB;
begin
  if not AllocateWinNCB(NameNCB) then begin
    NetBIOSAddName := NBEDPMIError;
    Exit;
  end;
  ClearNCB(NameNCB.NP^);
  {build the NCB}
  with NameNCB.NP^ do begin
    Command := $30;
    Move(NameToAdd[1],Name,Length(NameToAdd));
    LanaNum := 0;
  end;
  NetBiosRequest(NameNCB.NR);
  with NameNCB.NP^ do begin
    NetBiosAddName := RetCode;
    NameNumber := NameNum;
  end;
  FreeWinNCB(NameNCB);
end;

function NetBiosDeleteName(NameToDelete : NBNameStr) : Byte; Export;
  {-deletes a name or group name from the NetBIOS name table}
var
  NameNCB : WinNCB;
begin
  if not AllocateWinNCB(NameNCB) then begin
    NetBIOSDeleteName := NBEDPMIError;
    Exit;
  end;
  ClearNCB(NameNCB.NP^);
  {build the NCB}
  with NameNCB.NP^ do begin
    Command := $31;
    Move(NameToDelete[1],Name,Length(NameToDelete));
    LanaNum := 0;
  end;
  NetBiosRequest(NameNCB.NR);
  with NameNCB.NP^ do
    NetBiosDeleteName := RetCode;
  FreeWinNCB(NameNCB);
end;

function NetBIOSIntVecInstalled : Boolean;
{Determine whether an int 5Ch vector is installed (that does not point to
 the BIOS).
}
var
  Vec              : Pointer;
  S                : Word;
begin
  GetRealModeIntVector(NetBiosInt5C,Vec);  {get the int 5Ch vector}
  S := SegOfs(Vec).Segm;                   {isolate the segment portion}
  if (S = $0000) or (S = $F000) then
    NetBIOSIntVecInstalled := FALSE
  else
    NetBIOSIntVecInstalled := TRUE; {pointed somewhere other than NIL or BIOS}
end;

function DoBogusNetBIOSCall : Boolean;
{issues an invalid NetBIOS call.   If such a call is made, and the installed
 int 5Ch handler returns the NetBIOS invalid command error code, then NetBIOS
 or a NetBIOS emulator is installed.
}
const
  ErrorInvalidCommand = $03;
  NBInvalidCommand    = $7F;
  NBEInvalidCommand   = $03;
var
  PresenceNCB      : WinNCB;
begin
  if not AllocateWinNCB(PresenceNCB) then begin
    DoBogusNetBIOSCall := False;
    Exit;
  end;
  ClearNCB(PresenceNCB.NP^);
  PresenceNCB.NP^.Command := NBInvalidCommand;    {make an impossible request}
  NetBiosRequest(PresenceNCB.NR);
  DoBogusNetBIOSCall := PresenceNCB.NP^.RetCode = NBEInvalidCommand;
  FreeWinNCB(PresenceNCB);
end;

function NetBIOSInstalled : Boolean; Export;
{returns true if NetBIOS (or a NetBIOS emulator) is installed}

begin
  if NetBIOSIntVecInstalled then
    NetBIOSInstalled := DoBogusNetBIOSCall
  else
    NetBIOSInstalled := FALSE;             {no vector, no NetBIOS}
end;


procedure CallbackShell; Near; Assembler;
asm
  push    ax
  push    bx
  push    cx
  push    dx
  push    si
  push    di
  push    es
  push    ds
  push    bp
  mov     ax,[si]
  mov     dx,[si+2]
  mov     es:[di].WindowsPostType.Regs.drIP,ax
  mov     es:[di].WindowsPostType.Regs.drCS,dx
  push    word ptr es:[di].WindowsPostType.Regs.drAX
  push    word ptr es:[di].WindowsPostType.NCBs+2
  push    word ptr es:[di].WindowsPostType.NCBs
  mov     ax,es:[di].WindowsPostType.DataSegm
  mov     ds,ax
  call    dword ptr es:[di].WindowsPostType.Post
  pop     bp
  pop     ds
  pop     es
  pop     di
  pop     si
  pop     dx
  pop     cx
  pop     bx
  pop     ax
  iret
end;

function GetWindowsPostRoutine(ProtectedProc : NetBiosPostRoutine;
                               DataSegment : Word;
                               var WinPost : WindowsPostType) : Boolean; Export;
begin
  with WinPost do begin
    Post := ProtectedProc;
    DataSegm := DataSegment;
    AllocateRealModeCallBackAddr(@CallbackShell, DPMIRegisters(Regs), Callback);
    GetWindowsPostRoutine := LongInt(Callback) <> 0;
  end;
end;

procedure FreeWindowsPostRoutine(var WinPost : WindowsPostType); Export;
begin
  FreeRealModeCallbackAddr(WinPost.Callback);
end;

exports
  GetWindowsPostRoutine   index 1,
  FreeWindowsPostRoutine  index 2,
  SendDataGram            index 3,
  ReceiveDataGram         index 4,
  NetBIOSInstalled        index 5,
  CancelRequest           index 6,
  NetBiosAddName          index 7,
  NetBiosDeleteName       index 8,
  AllocateWinNCB          index 9,
  FreeWinNCB              index 10;

begin
end.