home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / ddjmag / ddj8910.zip / COSTAS.LST < prev    next >
File List  |  1989-07-28  |  15KB  |  464 lines
  1. [LISTING ONE]
  2.  
  3.  
  4. program xnet;
  5. {
  6.   Program to demonstrate file transfer between PCs
  7.   using the NETBIOS device driver.  This program should work with
  8.   any hardware and software that support the NETBIOS interface.
  9.   Network software other than the NETBIOS is not required.
  10.   Program was tested with the PC260 Arcnet boards from SMC. The
  11.   CONFIG.SYS had the following line to install the NETBIOS:
  12.      device=smcarc.sys /p2e0 /i2 /me000
  13.   Program author: Costas Menico
  14. }
  15.  
  16. {$I-,R-}
  17. uses dos, crt;
  18.  
  19. const
  20.   { Maximum # of bytes to transfer in a single send }
  21.   buffsize = 64*1024-1;
  22.   lancard=0;    { Default network card }
  23.   nowait = $80; { Return immediately from command.
  24.                   Call the POST routine when done. (NOT USED)}
  25.   wait=$0;      { Wait until command is done. }
  26.  
  27.   { NETBIOS Commands used in this program }
  28.   msg_reset=$32;    { Reset the node }
  29.   msg_status=$33;   { Determine the current state of the node }
  30.   msg_add_name=$30; { Add a 16 char unique node name to NETBIOS }
  31.   msg_listen=$11;   { Listen for a node to establish session }
  32.   msg_call=$10;     { Call another node to establish a session }
  33.   msg_hang_up=$12;  { Hangup the session with a node }
  34.   msg_send=$14;     { Send a block of data to a node }
  35.   msg_receive=$15;  { Receive a block of data from a node }
  36.  
  37. type
  38.   buffer=array[1..buffsize] of byte;   { Buffer type declaration }
  39.   buffp=^buffer;                       { Pointer type to the buffer }
  40.   arrname=array[1..16] of char;        { Array for names type }
  41.  
  42.   { Message control block record }
  43.   mcb=record
  44.     mcb_command: byte;       { Command to execute }
  45.     mcb_retcode: byte;       { Return code value }
  46.     mcb_lsn: byte;           { Local session # }
  47.     mcb_num: byte;           { Number of name added }
  48.     mcb_buffer: pointer;     { Data buffer address }
  49.     mcb_length: word;        { Buffer length in bytes }
  50.     mcb_callname: arrname;   { Name on remote node }
  51.     mcb_name: arrname;       { Name of local node }
  52.     mcb_rto: byte;           { Receive timeout (NOT USED) }
  53.     mcb_sto: byte;           { Send timeout (NOT USED) }
  54.     mcb_post: pointer;       { Post routine address (NOT USED) }
  55.     mcb_lana_num: byte;      { Adapter card to use. 0 is first }
  56.     mcb_cmd_cpl: byte;       { Command status if NOWAIT is used }
  57.     mcb_reserve: array[1..14] of byte; { Other detailed info }
  58.   end;
  59.  
  60. { Memory declarations }
  61. var
  62.    b: buffp;                 { Data buffer block }
  63.    m: mcb;                   { Message control block }
  64.    r: registers;             { Registers used in INT $5C }
  65.  
  66.    localname, callname: arrname; { Local and remote name variables }
  67.  
  68.    netaddr: pointer;          { NETBIOS $5C Interrupt address }
  69.  
  70.    fi: file;                  { File handle for reading or writing }
  71.    filename: string[64];      { Filename path string }
  72.  
  73.    mode: char;                { Sending or receiving }
  74.    nodenum: word;             { Our card's node number, 1-255 }
  75.  
  76.    remotenode,
  77.    localnode: string[3];      { Remotes and local node numbers }
  78.  
  79.    lsn: byte;                 { Tracks our session number }
  80.  
  81.    fsize, bytecount: longint; { File size and bytes sent/received }
  82.    count: word;               { Number of bytes to send/receive }
  83.  
  84.    noerr: boolean;            { General use error flag }
  85.    ans: char;                 { Readkey variable }
  86. {-------------------------------------------------------------------}
  87. procedure init_mcb(var m:mcb);
  88. { Initialize a message control block to blanks and nulls }
  89. begin
  90.   m.mcb_command:=0;
  91.   m.mcb_retcode:=$ff;      { Must be set to $FF }
  92.   m.mcb_lsn:=0;
  93.   m.mcb_num:=0;
  94.   m.mcb_buffer:=nil;
  95.   m.mcb_length:=0;
  96.   fillchar(m.mcb_callname,16,' ');
  97.   fillchar(m.mcb_name,16,' ');
  98.   m.mcb_rto:=0;
  99.   m.mcb_sto:=0;
  100.   m.mcb_post:=nil;
  101.   m.mcb_lana_num:=lancard;
  102.   m.mcb_cmd_cpl:=0;
  103.   fillchar(m.mcb_reserve,14,0);
  104. end;
  105. {-------------------------------------------------------------------}
  106. procedure net_reset(var m:mcb);
  107. { Reset the node card }
  108. begin
  109.   init_mcb(m);
  110.   m.mcb_command:=msg_reset;
  111.   netaddr:=ptr(memw[0:$5c*4], memw[0:$5c*4+2]);
  112.   if netaddr<>nil then
  113.   begin
  114.     r.es:=seg(m);
  115.     r.bx:=ofs(m);
  116.     intr($5c,r);
  117.   end;
  118. end;
  119. {-------------------------------------------------------------------}
  120. procedure terminate;
  121. { Terminate XNET }
  122. begin
  123.   close(fi);           { Close open file }
  124.   if ioresult<>0 then ;{ Clear the error flag just in case }
  125.   net_reset(m);        { Reset the adapter. Deletes all activity }
  126.   freemem(b,buffsize); { Free heap memory (Out of Habit) }
  127.   halt;                { Go have coffee and think about enhancements}
  128. end;
  129. {-------------------------------------------------------------------}
  130. procedure net_error(var m: mcb);
  131. { Print a NETBIOS error and prompt user }
  132. var ans: char;
  133.   function hex(h:byte):string;
  134.   { Convert a byte to hex notation }
  135.   var i:byte;
  136.       hexc:string[2];
  137.   const
  138.       hs:string[16]='0123456789ABCDEF';
  139.   begin
  140.     i:=(h shr 4);
  141.     hexc:=hs[i+1];
  142.     i:=(h and $0f);
  143.     hexc:=hexc+hs[i+1];
  144.     hex:=hexc;
  145.   end;
  146. begin
  147.   if m.mcb_retcode=0 then exit;
  148.   writeln('NETBIOS error code $',hex(m.mcb_retcode),
  149.           ' in command code $',hex(m.mcb_command));
  150.   ans:=readkey;
  151.   terminate;
  152. end;
  153. {-------------------------------------------------------------------}
  154. procedure net_status(var m:mcb; waitbit:byte; mcb_buffer:buffp;
  155.                      mcb_length:word; mcb_callname:arrname;
  156.                      mcb_post: pointer);
  157. { Get the current NETBIOS status }
  158. begin
  159.   init_mcb(m);
  160.   m.mcb_command:=waitbit+msg_status;
  161.   m.mcb_buffer:=mcb_buffer;
  162.   m.mcb_length:=mcb_length;
  163.   m.mcb_post:=mcb_post;
  164.   move(mcb_callname,m.mcb_callname,16);
  165.   netaddr:=ptr(memw[0:$5c*4], memw[0:$5c*4+2]);
  166.   if netaddr<>nil then
  167.   begin
  168.     r.es:=seg(m);
  169.     r.bx:=ofs(m);
  170.     intr($5c,r);
  171.   end;
  172. end;
  173. {-------------------------------------------------------------------}
  174. procedure net_receive(var m:mcb; waitbit:byte; mcb_buffer:buffp;
  175.                       mcb_length:word; mcb_lsn:byte;
  176.                       mcb_post: pointer);
  177. { Wait to receive a data block from the node we are in session with }
  178. begin
  179.   init_mcb(m);
  180.   m.mcb_command:=waitbit+msg_receive;
  181.   m.mcb_buffer:=mcb_buffer;
  182.   m.mcb_length:=mcb_length;
  183.   m.mcb_lsn:=mcb_lsn;
  184.   m.mcb_post:=mcb_post;
  185.   r.es:=seg(m);
  186.   r.bx:=ofs(m);
  187.   intr($5c,r);
  188. end;
  189. {-------------------------------------------------------------------}
  190. procedure net_hang_up(var m:mcb; waitbit:byte; mcb_lsn:byte;
  191.                       mcb_post: pointer);
  192. { Hang up on the other guy. Not polite but who's perfect. }
  193. begin
  194.   init_mcb(m);
  195.   m.mcb_command:=waitbit+msg_hang_up;
  196.   m.mcb_lsn:=mcb_lsn;
  197.   m.mcb_post:=mcb_post;
  198.   r.es:=seg(m);
  199.   r.bx:=ofs(m);
  200.   intr($5c,r);
  201. end;
  202. {-------------------------------------------------------------------}
  203. procedure net_send(var m:mcb; waitbit:byte; mcb_buffer:buffp;
  204.                    mcb_length:word; mcb_lsn:byte; mcb_post: pointer);
  205. { Send a block of data to the node we are in session with. }
  206. begin
  207.   init_mcb(m);
  208.   m.mcb_command:=waitbit+msg_send;
  209.   m.mcb_buffer:=mcb_buffer;
  210.   m.mcb_length:=mcb_length;
  211.   m.mcb_lsn:=mcb_lsn;
  212.   m.mcb_post:=mcb_post;
  213.   r.es:=seg(m);
  214.   r.bx:=ofs(m);
  215.   intr($5c,r);
  216. end;
  217. {-------------------------------------------------------------------}
  218. procedure net_add_name(var m:mcb; waitbit:byte; mcb_name:arrname;
  219.                        mcb_post: pointer);
  220. { Tell NETBIOS our name. Must be unique anywhere in the network }
  221. begin
  222.   init_mcb(m);
  223.   m.mcb_command:=waitbit+msg_add_name;
  224.   move(mcb_name,m.mcb_name,16);
  225.   m.mcb_post:=mcb_post;
  226.   r.es:=seg(m);
  227.   r.bx:=ofs(m);
  228.   intr($5c,r);
  229. end;
  230. {-------------------------------------------------------------------}
  231. procedure net_call(var m:mcb; waitbit:byte; mcb_callname,
  232.                    mcb_name:arrname; mcb_post: pointer);
  233. { Call callname, and let him know we are ready }
  234. begin
  235.   init_mcb(m);
  236.   m.mcb_command:=waitbit+msg_call;
  237.   move(mcb_name,m.mcb_name,16);
  238.   move(mcb_callname,m.mcb_callname,16);
  239.   m.mcb_post:=mcb_post;
  240.   r.es:=seg(m);
  241.   r.bx:=ofs(m);
  242.   intr($5c,r);
  243. end;
  244. {-------------------------------------------------------------------}
  245. procedure net_listen(var m:mcb; waitbit:byte; mcb_callname,
  246.                      mcb_name:arrname; mcb_post: pointer);
  247. { Listen if callname is calling us }
  248. begin
  249.   init_mcb(m);
  250.   m.mcb_command:=waitbit+msg_listen;
  251.   move(mcb_name,m.mcb_name,16);
  252.   move(mcb_callname,m.mcb_callname,16);
  253.   m.mcb_post:=mcb_post;
  254.   r.es:=seg(m);
  255.   r.bx:=ofs(m);
  256.   intr($5c,r);
  257. end;
  258. {-------------------------------------------------------------------}
  259. procedure copytoarr(s: string; var name: arrname);
  260. { Copy a string to a 16 byte array. Blank fill to end. }
  261. begin
  262.   fillchar(name,16,' ');
  263.   move(s[1], name, length(s));
  264. end;
  265. {-------------------------------------------------------------------}
  266. procedure send_the_file;
  267. {
  268.   Start sending file. First send the file size (2 words).
  269.   Then send the rest in block of 64K with the remainder
  270.   as the last block.
  271. }
  272. begin
  273.   { Get file size and display }
  274.   fsize:=filesize(fi);
  275.   gotoxy(1,23); write('File size ',fsize);
  276.  
  277.   { Send the length of the file. Must be in 2 words }
  278.   move(fsize, b^, 4);
  279.   net_send(m, wait, b, 4, lsn, nil);
  280.   net_error(m);
  281.  
  282.   bytecount:=0;
  283.   noerr:=true;
  284.  
  285.   { Loop until the file is sent. }
  286.   while (bytecount<fsize) and (noerr) do
  287.   begin
  288.     { Read a block and if no error then send }
  289.     blockread(fi, b^, buffsize, count);
  290.     if ioresult<>0 then
  291.       noerr:=false
  292.     else
  293.     begin
  294.       net_send(m, wait, b, count, lsn, nil);
  295.       net_error(m);
  296.       bytecount:=bytecount+count;
  297.       gotoxy(1,24); write('File size sent ',bytecount,'      ');
  298.     end;
  299.   end;
  300. end;
  301. {-------------------------------------------------------------------}
  302. procedure receive_the_file;
  303. {
  304.   Start receiving file and save to disk. First get the file size.
  305.   Then receive in blocks of 64K with the remainder as the last block
  306. }
  307. begin
  308.   { Get the file size. Block sent must be in 2 words }
  309.   net_receive(m, wait, b, buffsize, lsn, nil);
  310.   move(b^,fsize,4);
  311.   { Display it }
  312.   gotoxy(1,23); write('File size ',fsize);
  313.   bytecount:=0;    { File size sent counter }
  314.   noerr:=true;
  315.   { Loop, receiving block in 64K increments }
  316.   while (bytecount<fsize) and (noerr) do
  317.   begin
  318.     { Receive }
  319.     net_receive(m, wait, b, buffsize, lsn, nil);
  320.     net_error(m);
  321.     { Save to file }
  322.     blockwrite(fi, b^, m.mcb_length);
  323.     { If an error abort else show file size sent so far. }
  324.     if ioresult<>0 then
  325.     begin
  326.       noerr:=false;
  327.       writeln('Disk full error');
  328.       net_hang_up(m, wait, lsn, nil);
  329.       terminate;
  330.     end else
  331.     begin
  332.       bytecount:=bytecount+m.mcb_length;
  333.       gotoxy(1,24); write('File size received ',bytecount,'      ');
  334.     end;
  335.   end;
  336. end;
  337. {-------------------------------------------------------------------}
  338. procedure setup_call_send;
  339. { Ask for file name to send and call the remote station. Hopefully
  340.   the remote is listening }
  341. begin
  342.   noerr:=true;
  343.   { Get the file name to send }
  344.   while noerr do
  345.   begin
  346.     write('Pathname of file to send (blank to exit)? ');
  347.     readln(filename);
  348.     if filename='' then terminate;
  349.     assign(fi,filename);
  350.     reset(fi,1);
  351.     if ioresult<>0 then
  352.       writeln('File does not exist.')
  353.     else
  354.       noerr:=false;
  355.   end;
  356.   { Get the local node and the remote node into arrays}
  357.   copytoarr(localnode,localname);
  358.   copytoarr(remotenode,callname);
  359.   { Call 'callname' using our 'localname'. He should be
  360.     expecting our call }
  361.   noerr:=false;
  362.   while not noerr do
  363.   begin
  364.     net_call(m, wait, callname, localname, nil);
  365.     { Was the remote node available to listen? }
  366.     if m.mcb_retcode<>0 then
  367.     begin
  368.       writeln('Remote Node, ',remotenode,' not ready. Retry/Abort?');
  369.       ans:=readkey;
  370.       if upcase(ans)='A' then net_error(m);
  371.     end else
  372.       noerr:=true;
  373.   end;
  374.   lsn:=m.mcb_lsn;  { Save the session number NETBIOS blessed us with}
  375.  
  376.   send_the_file;
  377.   close(fi);
  378. end;
  379. {-------------------------------------------------------------------}
  380. procedure setup_listen_receive;
  381. { Ask for file name to receive into and listen for the remote
  382.   node's call }
  383. begin
  384.   noerr := true;
  385.   { Get filename to save in to. If file exists verify and overwrite. }
  386.   while noerr do
  387.   begin
  388.     write('Pathname of where to save received file (blank to exit)? ');
  389.     readln(filename);
  390.     if filename='' then terminate;
  391.     assign(fi,filename);
  392.     reset(fi);
  393.     if ioresult=0 then
  394.     begin
  395.       writeln('File EXISTS. Do you wish to overwrite (Y/N)? ');
  396.       ans:=readkey;
  397.       if upcase(ans)='Y' then noerr:=false;
  398.       close(fi);
  399.     end else
  400.       noerr:=false;
  401.   end;
  402.   rewrite(fi,1);
  403.   { Get the local and remote nodes into array strings }
  404.   copytoarr(localnode,localname);
  405.   copytoarr(remotenode,callname);
  406.   { Listen for the remote node to call up any moment }
  407.   net_listen(m, wait, callname, localname, nil);
  408.   lsn:=m.mcb_lsn;  { Save the session number NETBIOS blessed us with}
  409.   net_error(m);
  410.  
  411.   receive_the_file;
  412.   close(fi);
  413. end;
  414. {-------------------------------------------------------------------}
  415. { XNET Main program start                                           }
  416. {-------------------------------------------------------------------}
  417. begin
  418.  
  419.   clrscr;
  420.   { Get a data buffer from the heap }
  421.   getmem(b, buffsize);
  422.   { Initialize fi to something }
  423.   assign(fi,'NUL');   
  424.   { Are we supposed to reset? }
  425.   net_reset(m);
  426.   net_error(m);
  427.   { Check our status }
  428.   copytoarr('*', localname);  { Create our localname }
  429.   { Check our node's NETBIOS status and
  430.     in to the first get the node number (address) }
  431.   net_status(m, wait, b, buffsize, localname, nil);
  432.   net_error(m);
  433.   { Get our node number and add it as a node name
  434.     The node number is set by "net_status" and is
  435.     in the first byte of the data buffer "b^"}
  436.   nodenum:=mem[seg(b^):ofs(b^)];
  437.   writeln('Your Station Number is: ',nodenum); writeln;
  438.  
  439.   str(nodenum,localnode);          { Convert to string array }
  440.   copytoarr(localnode,localname);
  441.   net_add_name(m, wait, localname, nil);  { Add to NETBIOS }
  442.   net_error(m);
  443.   { At this point the NETBIOS is aware of our presence }
  444.   { Ask the user for the remote's node number.
  445.     This is the node we wish to communicate with.
  446.     It may not have the same number as our node }
  447.   remotenode:=localnode;
  448.   while (remotenode=localnode) do
  449.   begin
  450.     write('Enter remotes station #: ');
  451.     readln(remotenode);
  452.   end;
  453.   { Ask for user's intentions. Send/Receive/Exit }
  454.   writeln('[S]end-file, [R]eceive-file or [E]xit');
  455.   mode:=readkey;
  456.  
  457.   case upcase(mode) of
  458.     'S': setup_call_send;       { Send the file. }
  459.     'R': setup_listen_receive;  { Receive the file. }
  460.   end;
  461.   terminate;
  462. end.
  463.  
  464.