home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / ITPFEB90.ZIP / REVISE2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-06  |  3.3 KB  |  127 lines
  1. { Turbo Pascal Revise2 Demonstration }
  2.  
  3. USES Dos, Crt;
  4.  
  5. TYPE
  6.   DataBlock = ARRAY[1..256] OF Byte;
  7.   DataArray = ARRAY[1..10] OF Byte;
  8.  
  9. CONST
  10.   DataAddress = $1B12;
  11.      { address of FlagArray within .EXE file }
  12.   FlagArray : DataArray =
  13.       ( $5B, $48, $45, $52, $45, $49,
  14.         $54, $49, $53, $5D );
  15.  
  16. VAR
  17.   CurrPath : PathStr;
  18.   Year, Month, Day, DOW: Word;
  19.  
  20. FUNCTION HexStr( Value : Byte ): STRING;
  21.  
  22.   VAR
  23.      i : Integer;      TempStr : STRING[2];
  24.  
  25.   BEGIN
  26.     TempStr[0] := Chr(2);
  27.     IF Value SHR 4 < 10
  28.       THEN TempStr[1] :=
  29.                Chr( ( Value SHR 4 ) + $30 )
  30.       ELSE TempStr[1] :=
  31.                Chr( ( Value SHR 4 ) + $37 );
  32.     IF Value AND $0F < 10
  33.       THEN TempStr[2] :=
  34.                Chr( ( Value AND $0F ) + $30 )
  35.       ELSE TempStr[2] :=
  36.                Chr( ( Value AND $0F ) + $37 );
  37.     HexStr := TempStr;
  38.   END;
  39.  
  40.  
  41. PROCEDURE ReplaceData( CurrPath : PathStr;
  42.                        DataAddress : Word;
  43.                        NewArray : DataArray );
  44.  
  45.   VAR
  46.     i, j, BlkCount, OffSet, Result : Integer;
  47.      Dir : DirStr;       InF, OutF : FILE;
  48.      Name : NameStr;        OutPath : PathStr;
  49.      Ext : ExtStr;       FileBlock : DataBlock;
  50.  
  51.   BEGIN
  52.      Assign( InF, CurrPath );
  53.      {$I-} Reset( InF, 1 ); {$I+}
  54.  
  55.      IF IOResult = 0 THEN
  56.      BEGIN
  57.        BlkCount := 0;         j := 1;
  58.        FSplit( CurrPath, Dir, Name, Ext );
  59.        OutPath := Dir + Name + '.NEW';
  60.        Assign( OutF, OutPath );
  61.        Rewrite( OutF, 1 );
  62.        Write( 'Read Data = ' );
  63.  
  64.        REPEAT
  65.          BlockRead( InF, FileBlock,
  66.                SizeOf( FileBlock ), Result );
  67.          OffSet := DataAddress - BlkCount *
  68.                SizeOf( FileBlock );
  69.          IF( OffSet <= SizeOf( FileBlock ) )
  70.              AND ( j <= SizeOf( NewArray ) ) THEN
  71.  
  72.          REPEAT
  73.            Write( HexStr( FileBlock[j+OffSet] ),
  74.                   ' ' );
  75.            FileBlock[ j + OffSet ] :=
  76.                   NewArray[ j ];
  77.            Inc( j );
  78.          UNTIL ( j > SizeOf( NewArray ) )
  79.            OR ( j + OffSet >
  80.                SizeOf( FileBlock ) );
  81.  
  82.          BlockWrite( OutF, FileBlock,
  83.                      Result, Result );
  84.          Inc( BlkCount );
  85.        UNTIL Eof( InF );
  86.  
  87.        WriteLn;
  88.        Close( OutF );
  89.        Close( InF );
  90.        erase( InF );
  91.        rename( OutF, Name+'.EXE' );
  92.      END ELSE WriteLn( CurrPath,
  93.                        ' invalid file name!' );
  94.   END;
  95.  
  96. VAR
  97.   NewArray : DataArray;       i : Integer;
  98.  
  99. BEGIN
  100.   CurrPath := FExpand( 'REVISE2.EXE' );
  101.   FOR i := 1 TO 10 DO
  102.     NewArray[i] := FlagArray[i];
  103.   WriteLn( 'CurrPath = ', CurrPath );
  104.   Write( 'DataArray = ' );
  105.   FOR i := 1 TO 10 DO
  106.     Write( HexStr( FlagArray[i] ), ' ' );
  107.   WriteLn;
  108.   GetDate(Year,Month,Day,DOW);
  109.   NewArray[1] := Lo(Year-1900);
  110.   NewArray[2] := Lo(Month);
  111.   NewArray[3] := Lo(Day);
  112.   If FlagArray[6] <> 0 then
  113.     NewArray[4] := 1 {Initial # of executions}
  114.   else
  115.     NewArray[4] := FlagArray[4] + 1;
  116.   FOR i := 5 TO 10 DO NewArray[i] := 0;
  117.   ReplaceData( CurrPath, DataAddress, NewArray );
  118.   Write( ' New data = ' );
  119.   FOR i := 1 TO 10 DO
  120.     Write( HexStr( NewArray[i] ), ' ' );
  121.   WriteLn;
  122.   GotoXY( 1, 25 );   ClrEol;
  123.   Write( 'Press any key to continue: ');
  124.   WHILE NOT KeyPressed DO;
  125.   WriteLn;   WriteLn;
  126. END.
  127.