home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mega CD-ROM 1
/
megacd_rom_1.zip
/
megacd_rom_1
/
MAGAZINE
/
DDJMAG
/
DDJ8910.ZIP
/
COSTAS.LST
< prev
next >
Wrap
File List
|
1989-07-28
|
15KB
|
464 lines
[LISTING ONE]
program xnet;
{
Program to demonstrate file transfer between PCs
using the NETBIOS device driver. This program should work with
any hardware and software that support the NETBIOS interface.
Network software other than the NETBIOS is not required.
Program was tested with the PC260 Arcnet boards from SMC. The
CONFIG.SYS had the following line to install the NETBIOS:
device=smcarc.sys /p2e0 /i2 /me000
Program author: Costas Menico
}
{$I-,R-}
uses dos, crt;
const
{ Maximum # of bytes to transfer in a single send }
buffsize = 64*1024-1;
lancard=0; { Default network card }
nowait = $80; { Return immediately from command.
Call the POST routine when done. (NOT USED)}
wait=$0; { Wait until command is done. }
{ NETBIOS Commands used in this program }
msg_reset=$32; { Reset the node }
msg_status=$33; { Determine the current state of the node }
msg_add_name=$30; { Add a 16 char unique node name to NETBIOS }
msg_listen=$11; { Listen for a node to establish session }
msg_call=$10; { Call another node to establish a session }
msg_hang_up=$12; { Hangup the session with a node }
msg_send=$14; { Send a block of data to a node }
msg_receive=$15; { Receive a block of data from a node }
type
buffer=array[1..buffsize] of byte; { Buffer type declaration }
buffp=^buffer; { Pointer type to the buffer }
arrname=array[1..16] of char; { Array for names type }
{ Message control block record }
mcb=record
mcb_command: byte; { Command to execute }
mcb_retcode: byte; { Return code value }
mcb_lsn: byte; { Local session # }
mcb_num: byte; { Number of name added }
mcb_buffer: pointer; { Data buffer address }
mcb_length: word; { Buffer length in bytes }
mcb_callname: arrname; { Name on remote node }
mcb_name: arrname; { Name of local node }
mcb_rto: byte; { Receive timeout (NOT USED) }
mcb_sto: byte; { Send timeout (NOT USED) }
mcb_post: pointer; { Post routine address (NOT USED) }
mcb_lana_num: byte; { Adapter card to use. 0 is first }
mcb_cmd_cpl: byte; { Command status if NOWAIT is used }
mcb_reserve: array[1..14] of byte; { Other detailed info }
end;
{ Memory declarations }
var
b: buffp; { Data buffer block }
m: mcb; { Message control block }
r: registers; { Registers used in INT $5C }
localname, callname: arrname; { Local and remote name variables }
netaddr: pointer; { NETBIOS $5C Interrupt address }
fi: file; { File handle for reading or writing }
filename: string[64]; { Filename path string }
mode: char; { Sending or receiving }
nodenum: word; { Our card's node number, 1-255 }
remotenode,
localnode: string[3]; { Remotes and local node numbers }
lsn: byte; { Tracks our session number }
fsize, bytecount: longint; { File size and bytes sent/received }
count: word; { Number of bytes to send/receive }
noerr: boolean; { General use error flag }
ans: char; { Readkey variable }
{-------------------------------------------------------------------}
procedure init_mcb(var m:mcb);
{ Initialize a message control block to blanks and nulls }
begin
m.mcb_command:=0;
m.mcb_retcode:=$ff; { Must be set to $FF }
m.mcb_lsn:=0;
m.mcb_num:=0;
m.mcb_buffer:=nil;
m.mcb_length:=0;
fillchar(m.mcb_callname,16,' ');
fillchar(m.mcb_name,16,' ');
m.mcb_rto:=0;
m.mcb_sto:=0;
m.mcb_post:=nil;
m.mcb_lana_num:=lancard;
m.mcb_cmd_cpl:=0;
fillchar(m.mcb_reserve,14,0);
end;
{-------------------------------------------------------------------}
procedure net_reset(var m:mcb);
{ Reset the node card }
begin
init_mcb(m);
m.mcb_command:=msg_reset;
netaddr:=ptr(memw[0:$5c*4], memw[0:$5c*4+2]);
if netaddr<>nil then
begin
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
end;
{-------------------------------------------------------------------}
procedure terminate;
{ Terminate XNET }
begin
close(fi); { Close open file }
if ioresult<>0 then ;{ Clear the error flag just in case }
net_reset(m); { Reset the adapter. Deletes all activity }
freemem(b,buffsize); { Free heap memory (Out of Habit) }
halt; { Go have coffee and think about enhancements}
end;
{-------------------------------------------------------------------}
procedure net_error(var m: mcb);
{ Print a NETBIOS error and prompt user }
var ans: char;
function hex(h:byte):string;
{ Convert a byte to hex notation }
var i:byte;
hexc:string[2];
const
hs:string[16]='0123456789ABCDEF';
begin
i:=(h shr 4);
hexc:=hs[i+1];
i:=(h and $0f);
hexc:=hexc+hs[i+1];
hex:=hexc;
end;
begin
if m.mcb_retcode=0 then exit;
writeln('NETBIOS error code $',hex(m.mcb_retcode),
' in command code $',hex(m.mcb_command));
ans:=readkey;
terminate;
end;
{-------------------------------------------------------------------}
procedure net_status(var m:mcb; waitbit:byte; mcb_buffer:buffp;
mcb_length:word; mcb_callname:arrname;
mcb_post: pointer);
{ Get the current NETBIOS status }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_status;
m.mcb_buffer:=mcb_buffer;
m.mcb_length:=mcb_length;
m.mcb_post:=mcb_post;
move(mcb_callname,m.mcb_callname,16);
netaddr:=ptr(memw[0:$5c*4], memw[0:$5c*4+2]);
if netaddr<>nil then
begin
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
end;
{-------------------------------------------------------------------}
procedure net_receive(var m:mcb; waitbit:byte; mcb_buffer:buffp;
mcb_length:word; mcb_lsn:byte;
mcb_post: pointer);
{ Wait to receive a data block from the node we are in session with }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_receive;
m.mcb_buffer:=mcb_buffer;
m.mcb_length:=mcb_length;
m.mcb_lsn:=mcb_lsn;
m.mcb_post:=mcb_post;
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
{-------------------------------------------------------------------}
procedure net_hang_up(var m:mcb; waitbit:byte; mcb_lsn:byte;
mcb_post: pointer);
{ Hang up on the other guy. Not polite but who's perfect. }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_hang_up;
m.mcb_lsn:=mcb_lsn;
m.mcb_post:=mcb_post;
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
{-------------------------------------------------------------------}
procedure net_send(var m:mcb; waitbit:byte; mcb_buffer:buffp;
mcb_length:word; mcb_lsn:byte; mcb_post: pointer);
{ Send a block of data to the node we are in session with. }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_send;
m.mcb_buffer:=mcb_buffer;
m.mcb_length:=mcb_length;
m.mcb_lsn:=mcb_lsn;
m.mcb_post:=mcb_post;
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
{-------------------------------------------------------------------}
procedure net_add_name(var m:mcb; waitbit:byte; mcb_name:arrname;
mcb_post: pointer);
{ Tell NETBIOS our name. Must be unique anywhere in the network }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_add_name;
move(mcb_name,m.mcb_name,16);
m.mcb_post:=mcb_post;
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
{-------------------------------------------------------------------}
procedure net_call(var m:mcb; waitbit:byte; mcb_callname,
mcb_name:arrname; mcb_post: pointer);
{ Call callname, and let him know we are ready }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_call;
move(mcb_name,m.mcb_name,16);
move(mcb_callname,m.mcb_callname,16);
m.mcb_post:=mcb_post;
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
{-------------------------------------------------------------------}
procedure net_listen(var m:mcb; waitbit:byte; mcb_callname,
mcb_name:arrname; mcb_post: pointer);
{ Listen if callname is calling us }
begin
init_mcb(m);
m.mcb_command:=waitbit+msg_listen;
move(mcb_name,m.mcb_name,16);
move(mcb_callname,m.mcb_callname,16);
m.mcb_post:=mcb_post;
r.es:=seg(m);
r.bx:=ofs(m);
intr($5c,r);
end;
{-------------------------------------------------------------------}
procedure copytoarr(s: string; var name: arrname);
{ Copy a string to a 16 byte array. Blank fill to end. }
begin
fillchar(name,16,' ');
move(s[1], name, length(s));
end;
{-------------------------------------------------------------------}
procedure send_the_file;
{
Start sending file. First send the file size (2 words).
Then send the rest in block of 64K with the remainder
as the last block.
}
begin
{ Get file size and display }
fsize:=filesize(fi);
gotoxy(1,23); write('File size ',fsize);
{ Send the length of the file. Must be in 2 words }
move(fsize, b^, 4);
net_send(m, wait, b, 4, lsn, nil);
net_error(m);
bytecount:=0;
noerr:=true;
{ Loop until the file is sent. }
while (bytecount<fsize) and (noerr) do
begin
{ Read a block and if no error then send }
blockread(fi, b^, buffsize, count);
if ioresult<>0 then
noerr:=false
else
begin
net_send(m, wait, b, count, lsn, nil);
net_error(m);
bytecount:=bytecount+count;
gotoxy(1,24); write('File size sent ',bytecount,' ');
end;
end;
end;
{-------------------------------------------------------------------}
procedure receive_the_file;
{
Start receiving file and save to disk. First get the file size.
Then receive in blocks of 64K with the remainder as the last block
}
begin
{ Get the file size. Block sent must be in 2 words }
net_receive(m, wait, b, buffsize, lsn, nil);
move(b^,fsize,4);
{ Display it }
gotoxy(1,23); write('File size ',fsize);
bytecount:=0; { File size sent counter }
noerr:=true;
{ Loop, receiving block in 64K increments }
while (bytecount<fsize) and (noerr) do
begin
{ Receive }
net_receive(m, wait, b, buffsize, lsn, nil);
net_error(m);
{ Save to file }
blockwrite(fi, b^, m.mcb_length);
{ If an error abort else show file size sent so far. }
if ioresult<>0 then
begin
noerr:=false;
writeln('Disk full error');
net_hang_up(m, wait, lsn, nil);
terminate;
end else
begin
bytecount:=bytecount+m.mcb_length;
gotoxy(1,24); write('File size received ',bytecount,' ');
end;
end;
end;
{-------------------------------------------------------------------}
procedure setup_call_send;
{ Ask for file name to send and call the remote station. Hopefully
the remote is listening }
begin
noerr:=true;
{ Get the file name to send }
while noerr do
begin
write('Pathname of file to send (blank to exit)? ');
readln(filename);
if filename='' then terminate;
assign(fi,filename);
reset(fi,1);
if ioresult<>0 then
writeln('File does not exist.')
else
noerr:=false;
end;
{ Get the local node and the remote node into arrays}
copytoarr(localnode,localname);
copytoarr(remotenode,callname);
{ Call 'callname' using our 'localname'. He should be
expecting our call }
noerr:=false;
while not noerr do
begin
net_call(m, wait, callname, localname, nil);
{ Was the remote node available to listen? }
if m.mcb_retcode<>0 then
begin
writeln('Remote Node, ',remotenode,' not ready. Retry/Abort?');
ans:=readkey;
if upcase(ans)='A' then net_error(m);
end else
noerr:=true;
end;
lsn:=m.mcb_lsn; { Save the session number NETBIOS blessed us with}
send_the_file;
close(fi);
end;
{-------------------------------------------------------------------}
procedure setup_listen_receive;
{ Ask for file name to receive into and listen for the remote
node's call }
begin
noerr := true;
{ Get filename to save in to. If file exists verify and overwrite. }
while noerr do
begin
write('Pathname of where to save received file (blank to exit)? ');
readln(filename);
if filename='' then terminate;
assign(fi,filename);
reset(fi);
if ioresult=0 then
begin
writeln('File EXISTS. Do you wish to overwrite (Y/N)? ');
ans:=readkey;
if upcase(ans)='Y' then noerr:=false;
close(fi);
end else
noerr:=false;
end;
rewrite(fi,1);
{ Get the local and remote nodes into array strings }
copytoarr(localnode,localname);
copytoarr(remotenode,callname);
{ Listen for the remote node to call up any moment }
net_listen(m, wait, callname, localname, nil);
lsn:=m.mcb_lsn; { Save the session number NETBIOS blessed us with}
net_error(m);
receive_the_file;
close(fi);
end;
{-------------------------------------------------------------------}
{ XNET Main program start }
{-------------------------------------------------------------------}
begin
clrscr;
{ Get a data buffer from the heap }
getmem(b, buffsize);
{ Initialize fi to something }
assign(fi,'NUL');
{ Are we supposed to reset? }
net_reset(m);
net_error(m);
{ Check our status }
copytoarr('*', localname); { Create our localname }
{ Check our node's NETBIOS status and
in to the first get the node number (address) }
net_status(m, wait, b, buffsize, localname, nil);
net_error(m);
{ Get our node number and add it as a node name
The node number is set by "net_status" and is
in the first byte of the data buffer "b^"}
nodenum:=mem[seg(b^):ofs(b^)];
writeln('Your Station Number is: ',nodenum); writeln;
str(nodenum,localnode); { Convert to string array }
copytoarr(localnode,localname);
net_add_name(m, wait, localname, nil); { Add to NETBIOS }
net_error(m);
{ At this point the NETBIOS is aware of our presence }
{ Ask the user for the remote's node number.
This is the node we wish to communicate with.
It may not have the same number as our node }
remotenode:=localnode;
while (remotenode=localnode) do
begin
write('Enter remotes station #: ');
readln(remotenode);
end;
{ Ask for user's intentions. Send/Receive/Exit }
writeln('[S]end-file, [R]eceive-file or [E]xit');
mode:=readkey;
case upcase(mode) of
'S': setup_call_send; { Send the file. }
'R': setup_listen_receive; { Receive the file. }
end;
terminate;
end.