home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TS_CONFG.ZIP / TS_CONFG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-03-31  |  1.8 KB  |  64 lines
  1. {$V-,I-}
  2.  
  3. UNIT TS_Confg; { Copyright (C) 1989 Shenandoah Valley Software }
  4.  
  5. INTERFACE
  6.  
  7. USES crt,dos;
  8.  
  9. PROCEDURE TS_Config ( TS_FileName    : string   ;
  10.                       TS_Seg, TS_Ofs : word     ;
  11.                       TS_Type        : pointer  ;
  12.                       TS_Size        : longint  ;
  13.                   VAR TS_Error       : integer );
  14.  
  15. IMPLEMENTATION
  16.  
  17. PROCEDURE TS_Config ( TS_FileName    : string   ;
  18.                       TS_Seg, TS_Ofs : word     ;
  19.                       TS_Type        : pointer  ;
  20.                       TS_Size        : longint  ;
  21.                   VAR TS_Error       : integer );
  22.  
  23.   VAR TS_Path  : PathStr ;                         TS_Dir   : DirStr  ;
  24.       TS_Name  : NameStr ;                         TS_Ext   : ExtStr  ;
  25.       TS_File  : file    ;                         TS_Head  : word    ;
  26.       TS_Block : longint ;                         TS_Ver   : boolean ;
  27.       TS_Str   : array[1..5000] of char;
  28.  
  29.   BEGIN
  30.  
  31.     GetVerify  ( TS_Ver );
  32.     SetVerify  ( true );
  33.     FSplit     ( TS_FileName, TS_Dir, TS_Name, TS_Ext );
  34.  
  35.     TS_Path  := TS_Name + '.EXE';
  36.     TS_Path  := FSearch ( TS_Path, GetEnv ( 'PATH' ));
  37.  
  38.     if TS_Path = '' then BEGIN
  39.       TS_Error := 15;
  40.       Exit;
  41.     END else TS_Path := FExpand ( TS_Path );
  42.  
  43.     Assign     ( TS_File, TS_Path );
  44.     Reset      ( TS_File, 1 );
  45.  
  46.     TS_Error := IOResult;
  47.     if TS_Error <> 0 then Exit;
  48.  
  49.     Seek       ( TS_File, 8 );
  50.     BlockRead  ( TS_File, TS_Head, SizeOf ( TS_Head ));
  51.  
  52.     TS_Block := 16 *( longint ( TS_Seg ) -PrefixSeg +TS_Head ) +TS_Ofs -256;
  53.         
  54.     Seek       ( TS_File, TS_Block );
  55.     Move       ( TS_Type^, TS_Str, TS_Size );
  56.     BlockWrite ( TS_File, TS_Str, TS_Size );
  57.     Close      ( TS_File );
  58.     SetVerify  ( TS_Ver );
  59.  
  60.   END;
  61.  
  62. BEGIN
  63. END.
  64.