home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECO_EXE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  6.1 KB  |  165 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCIII by EUROCON PANATIONAL CORPORATION   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. unit eco_exe;
  23. interface
  24. uses
  25.   dos
  26.  
  27.   ;
  28.  
  29.  
  30. type
  31.   combuffer = record                 { exec communications buffer       }
  32.     ident     : array[1..8] of char; { identification       }
  33.     comvector : word;                { address stored here  }
  34.     common    : pointer;             { common data address  }
  35.     comsize   : word;                { common data size     }
  36.     progpath  : string[67];          { next program         }
  37.     cmdline   : string[127];         { next command line    }
  38.     default   : string[67];          { default program      }
  39.     comspec   : string[67];          { command full path    }
  40.     lasterror : word;                { last dos 4b error    }
  41.   end;
  42.   combufptr = ^combuffer;
  43.  
  44.  
  45.   function getptr(vector : byte) : combufptr;
  46.   function cseg_t(var comseg,compars : word; vector : byte) : word;
  47.   function chain_t(prog,cmd : string; vector : byte) : word;
  48.   function default_t(prog : string; vector : byte) : word;
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55. implementation
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.   {
  64.     getptr return a pointer to the exec communication buffer.
  65.     if exec is not installed, then the nil pointer is returned.        
  66.   }
  67.   function getptr(vector : byte) : combufptr;
  68.   var
  69.     intvec   : byte;
  70.     reg      : registers;
  71.     chainptr : combufptr;
  72.     execid   : string[7];
  73.   
  74.   begin
  75.     if (vector = 0) then intvec := $60 else intvec := vector;
  76.     with reg do begin
  77.       ah := $35; al := intvec; intr($21,reg); chainptr := ptr(es,bx)
  78.     end;
  79.     if (chainptr^.ident<>'DISPATCH') then getptr := nil else getptr := chainptr
  80.   end;
  81.   
  82.  
  83.  
  84.   { chain_t  
  85.   {  place the program path and command line into the exec       }
  86.   {  communication buffer.  if the special paths 'exit' or 'dos' }
  87.   {  are used, they must be in upper case.  to invoke a          }
  88.   {  secondary copy of command, specify the path dos and pass    }
  89.   {  the command line ' /c doscommand'.  for example, to invoke  }
  90.   {  the batch file foobar.bat, the call sequence is:            }
  91.   {                                                              }
  92.   {  errcode := chain_t('dos',' /c foobar');                     }
  93.   {                                                              }
  94.   {  to return to command and terminate any further chaining,    }
  95.   {  use the special path 'exit' and the program path.  the      }
  96.   {  program path is placed in the communications buffer as a    }
  97.   {  nul terminated string (no leading length byte - an asciiz   }
  98.   {  string in the parlance of dos).  the command line also has  }
  99.   {  a special format.  it does have a leading length byte, but  }
  100.   {  also has a trailing carriage return (#13) and nul byte,     }
  101.   {  neither of which are included in the length.                }
  102.   {                                                              }
  103.   {  if the buffer is successfully altered, 0 is returned as     }
  104.   {  the functional value; otherwise 1 is returned.              }
  105.  
  106.   function chain_t(prog,cmd : string; vector : byte) : word;
  107.   var
  108.     chainptr : combufptr;
  109.     command  : string;
  110.   
  111.   begin
  112.     chainptr := getptr(vector);
  113.     if (chainptr <> nil) then with chainptr^ do begin
  114.       fillchar(progpath,sizeof(progpath),#0);
  115.       fillchar(cmdline,sizeof(cmdline),#0);
  116.       move(prog[1],progpath,length(prog));
  117.       command := cmd + #13 + #0;
  118.       move(command,cmdline,length(command));
  119.       cmdline[0] := chr(length(command) - 2);
  120.       chain_t    := 0
  121.     end else chain_t := 1
  122.   end;
  123.   
  124.   
  125.  
  126.   { cseg_t 
  127.   {  return the segment address of command data area.  if the    }
  128.   {  communication buffer cannot be found, the address returned  }
  129.   {  address is $ffff (65535), and if no common area has been    }
  130.   {  allocated, 0 is returned.  the size of the common data area }
  131.   {  in paragraphs is also returned.  like chain_t, 0 is         }
  132.   {  returned as the function value if the buffer is success-    }
  133.   {  fully accessed, and 1 is returned otherwise.                }
  134.  
  135.   function cseg_t(var comseg,compars : word; vector : byte) : word;
  136.   var chainptr : combufptr;
  137.   begin
  138.     chainptr := getptr(vector);
  139.     if (chainptr = nil) then begin
  140.       comseg  := $ffff; compars := 0; cseg_t  := 1
  141.     end else with chainptr^ do begin
  142.       comseg := seg(common^); compars := comsize; cseg_t := 0
  143.     end
  144.   end;
  145.   
  146.  
  147.  
  148.   function default_t(prog : string; vector : byte) : word;
  149.   var
  150.     chainptr : combufptr;
  151.   
  152.   begin
  153.     chainptr := getptr(vector);
  154.     if (chainptr <> nil) then with chainptr^ do begin
  155.       fillchar(default,sizeof(default),#0);
  156.       move(prog[1],default,length(prog));
  157.       default_t := 0
  158.     end else default_t := 1
  159.   end;
  160.   
  161.   
  162.  
  163.   
  164. end.
  165.