home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
wint1_92
/
dpmi
/
nbchat.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-23
|
6KB
|
221 lines
NBCHAT.PAS - Example Windows/NetBIOS Chat program.
{*********************************************************}
{* NBCHAT.PAS 1.00 *}
{* Copyright (c) TurboPower Software 1991. *}
{* All rights reserved. *}
{*********************************************************}
{$S-,R-,V-}
program NBChat;
{-A simple NetBIOS chat program for Windows}
uses WinProcs, WinCrt, WinDPMI, TNetBIOS, UNetBIOS;
const
Pending : Boolean = False;
Msg : String = '';
NameAdded : Boolean = False;
RealMemAllocated : Boolean = False;
SendMemAllocated : Boolean = False;
RecNCBAllocated : Boolean = False;
SendNCBAllocated : Boolean = False;
PostAllocated : Boolean = False;
Exiting : Boolean = False;
type
StringPtr = ^String;
var
SendNBName : NBNameStr;
RecNBName : NBNameStr;
NBNameNo : Byte;
Ret : Byte;
LSN : Byte;
SR, SP, SendSP, SendSR : StringPtr;
Regs : DPMIRegisters;
RecN, SendN : WinNcb;
Post : WindowsPostType;
SendPost : WindowsPostType;
SaveExitProc : Pointer;
function Num2Str(Num : Byte) : String;
var
S : String;
begin
Str(Num, S);
Num2Str := S;
end;
function Pad(S : String; Num : Byte) : String;
var
Len : Byte;
begin
Len := Length(S);
if Len < Num then
FillChar(S[Succ(Len)], Num-Len, ' ');
S[0] := Chr(Num);
Pad := S;
end;
function GetRealModeMem(Size : LongInt;
var RealPtr : StringPtr;
var ProtectedPtr : StringPtr) : Boolean;
{-Gets real mode addressable memory (paragraph aligned) and returns both a
pointer for real and protected mode. Returns True if successful. Size is
the number of bytes to allocate.}
var
L : LongInt;
begin
L := GlobalDosAlloc(Size);
if L > 0 then begin
RealPtr := Ptr(DoubleWord(L).HiWord, 0);
ProtectedPtr := Ptr(DoubleWord(L).LoWord, 0);
GetRealModeMem := True;
end
else
GetRealModeMem := False;
end;
procedure FreeRealModeMem(ProtectedPtr : StringPtr);
{-Free memory previously allocated with GetRealModeMem.}
begin
GlobalDosFree(SegOfs(ProtectedPtr).Segm);
end;
procedure PostRoutine(LastError : Byte; N : WinNCBPtr); Far;
begin
if Exiting then Exit;
Pending := True;
if LastError = 0 then
Msg := SP^
else
Msg := 'NetBIOS error = ' + Num2Str(LastError);
ReceiveDatagram(N^, NBNameNo, False, Post, SizeOf(String), SR);
end;
procedure GetNames;
begin
Write('Enter name for this station: ');
ReadLn(SendNBName);
if Length(SendNBName) = 0 then
Halt;
SendNBName := Pad(SendNBName, SizeOf(SendNBName) - 1);
Write('Enter name for partner: ');
ReadLn(RecNBName);
if Length(RecNBName) = 0 then
Halt;
RecNBName := Pad(RecNBName, SizeOf(RecNBName) - 1);
end;
procedure ShowIncoming;
begin
WriteLn('<incoming>', Msg);
Pending := False;
end;
procedure SendOutgoing;
begin
Write('Enter outgoing message: ');
ReadLn(SendSP^);
if Length(SendSP^) <> 0 then
SendDatagram(SendN, NBNameNo, RecNBName, False, SendPost, SizeOf(String), SendSR);
end;
procedure MessageLoop;
var
C : Char;
begin
WriteLn('Press space bar to enter message, ESC to quit');
ReceiveDatagram(RecN, NBNameNo, False, Post, SizeOf(String), SR);
repeat
while not KeyPressed do begin
if Pending then
ShowIncoming;
end;
C := ReadKey;
if C <> ^[ then
SendOutgoing;
until C = ^[;
end;
procedure AllocateMemory;
begin
if GetRealModeMem(SizeOf(String), SR, SP) then
RealMemAllocated := True
else begin
WriteLn('Unable to obtain real mode memory for messages');
Halt;
end;
if GetRealModeMem(SizeOf(String), SendSR, SendSP) then
SendMemAllocated := True
else begin
WriteLn('Unable to obtain real mode memory for messages');
Halt;
end;
if AllocateWinNCB(RecN) then
RecNCBAllocated := True
else begin
WriteLn('Unable to allocate NCBs');
Halt;
end;
if AllocateWinNCB(SendN) then
SendNCBAllocated := True
else begin
WriteLn('Unable to allocate NCBs');
Halt;
end;
FillChar(SendPost, SizeOf(SendPost), 0);
if GetWindowsPostRoutine(PostRoutine, DSeg, Post) then
PostAllocated := True
else begin
WriteLn('Unable to obtain real mode callback address');
Exit;
end;
end;
procedure NBExitProc; Far;
var
Ret : Byte;
begin
ExitProc := SaveExitProc;
Exiting := True;
if RecNCBAllocated then begin
Ret := CancelRequest(RecN);
FreeWinNCB(RecN);
end;
if SendNCBAllocated then begin
Ret := CancelRequest(SendN);
FreeWinNCB(SendN);
end;
if NameAdded then
Ret := NetBIOSDeleteName(SendNBName);
if RealMemAllocated then
FreeRealModeMem(SP);
if SendMemAllocated then
FreeRealModeMem(SendSP);
if PostAllocated then
FreeWindowsPostRoutine(Post);
end;
begin
if InRealMode then begin
WriteLn('This program is not compatible with Real Mode.');
Halt;
end;
if not NetBIOSInstalled then begin
WriteLn('NetBIOS not installed');
Halt;
end;
GetNames;
SaveExitProc := ExitProc;
ExitProc := @NBExitProc;
Ret := NetBIOSAddName(SendNBName, NBNameNo);
if Ret = 0 then
NameAdded := True
else begin
WriteLn('Error adding NetBIOS name');
Halt;
end;
AllocateMemory;
MessageLoop;
end.