home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / intelrmx86 / get.p86 < prev    next >
Text File  |  2020-01-01  |  3KB  |  175 lines
  1. /* GET: routine to get a file from a remote kermit in server mode
  2.     also includes BYE and FINISH cmds. */
  3. $compact
  4. $optimize(3)
  5.  
  6. get$module:
  7. do;
  8.  
  9. $include(:INC:LTKSEL.LIT)
  10.  
  11. declare true literally '0FFH';
  12. declare false literally '00H';
  13.  
  14. declare null literally '00';
  15. declare cr literally '0DH';
  16. declare lf literally '0AH';
  17. declare crlf literally 'cr,lf,null';
  18. declare myquote literally '023H';
  19. declare chrmsk literally '07FH';
  20.  
  21. declare state byte;
  22. declare tries byte;
  23. declare msgnum byte;
  24. declare maxtry literally '5';
  25.  
  26. declare eol byte;
  27. declare debug byte external;
  28. declare iobuff(1024) byte external;
  29. declare status word external;
  30.  
  31. declare pksize literally '94';
  32. declare send$packet(pksize) byte external;
  33. declare recv$packet(pksize) byte external;
  34. declare count word;
  35. declare oldtry byte;
  36. declare byte$in dword;
  37.  
  38. declare file$conn token external;
  39. declare filename structure
  40.     (len byte,
  41.      name(80) byte) external;
  42. declare qopen byte external;
  43. declare dummy byte;
  44.  
  45. $include(:INC:USWBF.EXT)
  46. $include(:INC:UGTARG.EXT)
  47.  
  48. check$error: procedure(mode) byte external;
  49.     declare mode byte;
  50. end check$error;
  51.  
  52. file$open: procedure(mode) external;
  53.     declare mode byte;
  54. end file$open;
  55.  
  56. file$close: procedure external;
  57. end file$close;
  58.  
  59. co:    procedure(char)external;
  60.     declare char byte;
  61. end co;
  62.  
  63. print:  procedure(string)external;
  64.     declare string pointer;
  65. end print;
  66.  
  67. nout:     procedure(num)external;
  68.     declare num word;
  69. end nout;
  70.  
  71. noutd:     procedure(num)external;
  72.     declare num dword;
  73. end noutd;
  74.  
  75. newline: procedure external; end newline;
  76.  
  77. ctl:    procedure(char) byte external;
  78.     declare char byte;
  79. end ctl;
  80.  
  81. putc: procedure (c,conn) external;
  82.     declare c byte;
  83.     declare conn token;
  84. end putc;
  85.  
  86. do$put: procedure (conn) external;
  87.     declare conn token;
  88. end do$put;
  89.  
  90. spack:     procedure(type, pknum, length, packet) external;
  91.     declare (type, pknum, length) byte;
  92.     declare packet address;
  93. end spack;
  94.  
  95.  
  96. rpack:     procedure(length, pknum, packet) byte external;
  97.     declare (length, pknum, packet) address;
  98. end rpack;
  99.  
  100.  
  101. spar:    procedure (a) external;
  102.     declare a address;
  103. end spar;
  104.  
  105.  
  106. rpar:    procedure (a) external;
  107.     declare a address;
  108. end rpar;
  109.  
  110. rinit:     procedure byte external;
  111. end rinit;
  112.  
  113. rfile:    procedure byte external;
  114. end rfile;
  115.  
  116. rdata:     procedure byte external;
  117. end rdata;
  118.  
  119. recv$setup: procedure external;
  120. end recv$setup;
  121.  
  122. ginit:    procedure byte;
  123.     call spack('R',msgnum,filename.len,.filename.name);
  124.     state=rinit;
  125.     return state;
  126. end ginit;
  127.  
  128. get:   procedure byte public;
  129.  
  130.     if debug then call print(@('Get a file',crlf));
  131.     state = 'R';
  132.     msgnum = 0;
  133.     call recv$setup;
  134.     do while true;
  135.       if state = 'D' then state = rdata;
  136.       else
  137.          if state = 'F' then state = rfile;
  138.          else
  139.             if state = 'R' then state = ginit;
  140.         else
  141.                 if state = 'C' then return true;
  142.             else return false;
  143.     end;
  144. end get;
  145.  
  146. bye: procedure byte public;
  147.     declare (num,length,retc) byte;
  148.     tries=0;
  149.     retc='N';
  150.     msgnum=0;
  151.     do while (retc<>'Y');
  152.         if tries>maxtry then return false;
  153.         call spack('G',msgnum,1,.('L'));
  154.         retc = rpack(.length, .num, .recv$packet);
  155.         tries=tries+1;
  156.     end;
  157.     return true;
  158. end bye;
  159.  
  160. finish: procedure byte public;
  161.     declare (num,length,retc) byte;
  162.     tries=0;
  163.     retc='N';
  164.     msgnum=0;
  165.     do while (retc<>'Y');
  166.         if tries>maxtry then return false;
  167.         call spack('G',msgnum,1,.('F'));
  168.         retc = rpack(.length, .num, .recv$packet);
  169.         tries=tries+1;
  170.     end;
  171.     return true;
  172. end finish;
  173.  
  174. end get$module;
  175.