Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TCONFIG.ZIP/CONFIGUR.PAS

Pascal/Delphi Source File | 1987-09-07 | 13.5 KB | 305 lines

(******************************************************************************

                   CONFIG.PAS
                  Version 1.0
                  July 8, 1986
                   by Randy Forgaard
                  CompuServe 70307,521

Requires PC-DOS/MS-DOS Turbo Pascal 3.0 or higher.  This file provides routines
for  "configuring"  a program, by changing certain typed constant values within
the program after it has been compiled.  CONFIG.PAS  differs  from  some  other
cloning  methods  in that the configuration program need not have been compiled
with the same version of Turbo Pascal as the target program.  Also,  CONFIG.PAS
allows one to configure Turbo EXTENDER ".EXE" type programs, Turbo chain files,
and  Turbo  overlay  files.  The CONFIG.PAS method may be used to have programs
configure themselves or  other  programs.   If  desired,  CONFIG.PAS  can  also
configure  files  that are not programs at all (the latter use of CONFIG.PAS is
not addressed here).

The  method used by CONFIG.PAS requires that the target program contain what we
will call a Configuration Block.  A Configuration Block is  a  group  of  typed
constants that have the following form:

  const
    head: string[32] = 'A SAMPLE CONFIGURATION ID STRING';

    ...various typed constant declarations: the Configuration Parameters...

    tail: Byte = 0;  {Configuration Tail}

The  names  of  the  "head"  and  "tail"  variables  above are irrelevant.  The
Configuration ID String may be any string that does  not  appear  elsewhere  in
your program.  (For safety's sake, it is good to pick a fairly long string like
the  one  above,  to reduce the possibility that you might accidentally include
another identical string elsewhere in your program.)  The  declared  length  of
the  Configuration ID String (32 in the above example) MUST be the exact length
of the string  itself,  not  a  larger  value.   The  "various  typed  constant
declarations"  above  are the Configuration Parameters that you would like your
configuration program to be able to change.  The  Configuration  Tail  variable
("tail,"  in  the above example) can be any type, need not have the value zero,
and in fact can be used for other purposes if desired, but it must be  a  typed
constant, and it must appear immediately after the Configuration Parameters.

A  Configuration  Block may be among the "global" typed constants of a program,
or it may be located within a procedure or function.   There  may  be  multiple
Configuration  Blocks  in  a  single program, if one wishes to modify different
Configuration Parameters under different circumstances.  For each Configuration
Block in  the  target  program,  there  must  be  an  identical  copy  of  that
Configuration  Block  in the configuration program.  (Although all of the typed
constant types in the two Configuration  Blocks  must  be  identical,  and  the
Configuration   ID  Strings  must  be  the  same,  the  actual  values  of  the
Configuration Parameters typed constants need not  match.)   If  a  program  is
going  to  be  configuring  itself,  then  the latter condition will already be
automatically satisfied.

The  routine  CfgReplace,  below,  is the one that actually performs the act of
replacing the Configuration Parameters in the target program.   CfgClone  is  a
special routine (which uses CfgReplace) that allows a program to "clone" a copy
of  itself.   CfgAbort  is  the procedure that gets invoked by CfgReplace if an
error is encountered.  It is purposely simple-minded; you will probably want to
replace it with a routine that performs cleanup and  error  reporting  that  is
suitable  for  your  particular  program.  BlockPos is a general-purpose speedy
Inline routine that searches a large buffer (up to 64K) to look for  a  string.
It  is  used  by CfgReplace, but also feel free to use it for other purposes in
your own programs if you wish.

At  the  bottom  of  this file is a sample program that demonstrates the use of
CfgReplace and CfgClone.  Enjoy!

******************************************************************************)


type
  FileName = string[66];
  TextLine = string[80];
  Str255 = string[255];


{Simple-minded error-reporting routine, used by CfgReplace.  Should probably be
 replaced with one that is tailored to your particular program.}

procedure CfgAbort (msg: TextLine);
begin
  writeln;
  writeln('Abort -- ', msg);
  Halt
end {CfgAbort};


{Returns the offset, within "buffer," of the first occurrence of the characters
 comprising "s," where the first byte of "buffer" is considered to be offset 1.
 The  "size" is the size, in bytes, of "buffer" (an unsigned value in the range
 0..65535).  If there are no occurrences of "s" within "buffer," or if "size" <
 Length(s), or if "s" is empty, returns zero.  This is similar to Turbo's "Pos"
 routine, except that a buffer up to 64K bytes in size may be searched.   NOTE:
 This  is  only  for use on the 8088/86 family, under DOS (probably works under
 CP/M-86, too).}

function BlockPos (var buffer; size: Integer; s: Str255): Integer;
begin
  Inline(
         {Load   "buffer"   address   into  ES:DI,  "buffer"  offset  into  BX,
          Length(s)-1 into DX, contents of "s[1]" into  AL,  offset  of  "s[2]"
          into  SI,  and "size"-Length(s)+1 into CX.  If "size" < Length(s), or
          if Length(s) = 0, return zero.}
         $1E/               {        PUSH    DS           }
         $16/               {        PUSH    SS           }
         $1F/               {        POP     DS           }
         $C4/$BE/>buffer/   {        LES     DI,buffer[BP]}
         $89/$FB/           {        MOV     BX,DI        }
         $8B/$8E/>size/     {        MOV     CX,size[bp]  }
         $8D/$76/<s+2/      {        LEA     SI,s+2[bp]   }
         $8A/$46/<s+1/      {        MOV     AL,s+1[bp]   }
         $8A/$56/<s/        {        MOV     DL,s[bp]     }
         $84/$D2/           {        TEST    DL,DL        }
         $74/$23/           {        JZ      ERROR        }
         $FE/$CA/           {        DEC     DL           }
         $30/$F6/           {        XOR     DH,DH        }
         $29/$D1/           {        SUB     CX,DX        }
         $76/$1B/           {        JBE     ERROR        }

         {Scan  the  ES:DI  buffer, looking for the first occurrence of "s[1]."
          If not found prior to reaching Length(s) characters before the end of
          the buffer, return zero.  If Length(s) = 1,  the  entire  string  has
          been found, so report success.}
         $FC/               {        CLD                  }
         $F2/               {NEXT:   REPNE                }
         $AE/               {        SCASB                }
         $75/$16/           {        JNE     ERROR        }
         $85/$D2/           {        TEST    DX,DX        }
         $74/$0C/           {        JZ      FOUND        }

         {Compare  "s" (which is at SS:SI) with the ES:DI buffer, in both cases
          starting with the first byte just past the length byte of the string.
          If "s" does not match what is at the DI position of the buffer, reset
          the registers to the values they had just prior  to  the  comparison,
          and look again for the next occurrence of the length byte.}
         $51/               {        PUSH    CX           }
         $57/               {        PUSH    DI           }
         $56/               {        PUSH    SI           }
         $89/$D1/           {        MOV     CX,DX        }
         $F3/               {        REPE                 }
         $A6/               {        CMPSB                }
         $5E/               {        POP     SI           }
         $5F/               {        POP     DI           }
         $59/               {        POP     CX           }
         $75/$EC/           {        JNE     NEXT         }

         {String  found in buffer.  Set AX to the offset, within buffer, of the
          first byte of the string (the length byte), assuming that  the  first
          byte of the buffer is at offset 1.}
         $89/$F8/           {FOUND:  MOV     AX,DI        }
         $29/$D8/           {        SUB     AX,BX        }
         $EB/$02/           {        JMP     SHORT RETURN }

         {An "error" condition.  Return zero.}
         $31/$C0/           {ERROR:  XOR     AX,AX        }
         $1F/               {RETURN: POP     DS           }
         $8B/$E5/           {        MOV     SP,BP        }
         $5D/               {        POP     BP           }
         $C2/$08/$01)       {        RET     108H         }
end {BlockPos};


{Configures  the  file  "fn"  by  replacing  Configuration  Parameters  that it
 contains.  The "head" parameter should be the Configuration  ID  String  typed
 constant  at  the beginning of a Configuration Block, and "tail" should be the
 Configuration Tail typed constant at the end of the Configuration Block.  This
 routine looks for the corresponding Configuration Block in "fn," and  replaces
 the  Configuration  Parameters  in  that file with the ones between "head" and
 "tail" in this program.  Uses temporary heap space on the heap (which it  then
 releases  before  exiting).   Aborts if there are fewer than 255 bytes of heap
 space available, file "fn" cannot be opened, the Configuration Block  in  "fn"
 cannot  be found, or "fn" cannot be modified due to I/O errors (e.g., the disk
 is write protected).}

procedure CfgReplace (fn: FileName; var head, tail);
type
  buffer = array[1..$7FFF] of Byte;
var
  data: array[0..256] of Byte absolute head;
  source: string[255] absolute head;
  bufPtr: ^buffer;
  len, searchLen: Byte;
  bufLen, inBuf, i, actual, amount, result: Integer;
  pos: Real;
  f: File;
begin
  len := Length(source);
  searchLen := Pred(len);
  bufLen := MaxAvail;
  if (bufLen < 0) or (bufLen > (SizeOf(buffer) shr 4)) then
    bufLen := SizeOf(buffer)
  else bufLen := bufLen shl 4;
  if bufLen < len then
    CfgAbort('CfgReplace: Not enough available heap space');
  GetMem(bufPtr, bufLen);
  Assign(f, fn);
  {$I-} Reset(f, 1); {$I+}
  if IOresult <> 0 then CfgAbort('CfgReplace: Unable to open "' + fn + '"');
  BlockRead(f, bufPtr^, bufLen, actual);
  pos := actual;
  i := BlockPos(bufPtr^, actual, source);
  while (i = 0) and (actual >= len) do
    begin
      Move(bufPtr^[Succ(actual - searchLen)], bufPtr^[1], searchLen);
      BlockRead(f, bufPtr^[len], bufLen - searchLen, actual);
      pos := pos + actual;
      actual := actual + searchLen;
      i := BlockPos(bufPtr^, actual, source)
    end;
  FreeMem(bufPtr, bufLen);
  if i <> 0 then LongSeek(f, pos + i + searchLen - actual)
  else CfgAbort('CfgReplace: Cannot find header string in file');
  amount := Ofs(tail) - Ofs(data[Succ(len)]);
  writeln('Writing ', amount, ' bytes');
  BlockWrite(f, data[Succ(len)], amount, result);
  if result <> amount then CfgAbort('CfgReplace: Unable to write data');
  Close(f)
end {CfgReplace};


{Performs  the  same  operation  as  CfgReplace,  using  the  file  name of the
 currently running program.  I.e., this routine allows a program to  "clone"  a
 new  copy  of  itself  with  different Configuration Parameters.  This routine
 finds the name of the currently-running program by looking at the end  of  the
 environment  block  in  the  PSP  of this program.  Since this feature is only
 available in DOS 3.0 and higher, this routine will only work with DOS 3.0  and
 up.  Returns "true" iff DOS 3.0 or higher is running.  If "false" is returned,
 the  cloning  was  unsuccessful because an earlier DOS is being used.  In this
 case, use other means to obtain the name of the current program, and then  use
 CfgReplace  instead  of  this  one,  passing  the  name  of  this  program  to
 CfgReplace.}

function CfgClone (var head, tail): Boolean;
type
  environment = array[0..$7FFF] of Char;
var
  envPtr: ^environment;
  regPack: record
             case Integer of
               1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Integer);
               2: (AL, AH, BL, BH, CL, CH, DL, DH: Byte)
           end;
  i, j: Integer;
  fn: FileName;
begin
  CfgClone := false;
  regPack.AH := $30; {Get DOS Version Number}
  MsDos(regPack);
  if regPack.AL < 3 then exit;
  regPack.AH := $62; {Get PSP Address}
  MsDos(regPack);
  envPtr := Ptr(MemW[regPack.BX:$002C], 0);
  i := 0;
  while (envPtr^[i] <> #0) or (envPtr^[Succ(i)] <> #0) do i := Succ(i);
  i := i + 4;
  j := 0;
  while envPtr^[i] <> #0 do
    begin
      j := Succ(j);
      fn[j] := envPtr^[i];
      i := Succ(i)
    end;
  fn[0] := Chr(j);
  CfgReplace(fn, head, tail);
  CfgClone := true
end {CfgClone};


{ Example program -- remove next line to enable (a Bela Lubkin trick) }
(*

{Sample Configuration Block}
const
  head: string[38] = 'SAMPLE CONFIGURATION PARAMETERS FOLLOW';

  {Configuration constants to be modified:}
  cfgInt: Integer =     0;
  cfgReal: Real =     0.0;
  cfgStr: string[60] = '';

  tail: Byte = 0;


var
  fn: FileName;
begin
  writeln('To see the effects of running this program, try running it again.');
  write('Integer:   old = ', cfgInt, ';       new = ');
  readln(cfgInt);
  write('Real:      old = ', cfgReal:0:5, '; new = ');
  readln(cfgReal);
  writeln('String:    old = "', cfgStr, '";');
  write('           new =  ');
  readln(cfgStr);
  if not CfgClone(head, tail) then
    begin
      write('Please type the name of this executable program: ');
      readln(fn);
      CfgReplace(fn, head, tail)
    end
end.
*)