home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sp15-g1.zip / tvsrc.zip / TVSRC / TVPATCH.PAS < prev   
Pascal/Delphi Source File  |  1995-09-09  |  4KB  |  161 lines
  1. program tvpatch;
  2.  
  3. VAR source,dest,patch:TEXT;
  4.     sourcedir,destdir,patchdir,sourcename,destname:STRING;
  5.     patchline,sourceline:WORD;
  6.  
  7. procedure patcherror(msg:string);
  8. begin
  9.      Writeln('Error occured:'+msg);
  10.      Writeln('Patchline:',patchline,'   Sourceline:',SourceLine);
  11.      Writeln('Patch program aborted');
  12.      halt(0);
  13. end;
  14.  
  15. function newpatchline:string;
  16. var s:string;
  17. begin
  18.      IF eof(patch) THEN patcherror('Unexpected end of patch file:'+patchdir+'\tvpatch !');
  19.      {$i-}
  20.      readln(patch,s);
  21.      {$i+}
  22.      IF ioresult<>0 THEN patcherror('Read error from '+patchdir+'\tvpatch !');
  23.      WHILE s[length(s)]=#32 DO dec(s[0]);
  24.      inc(patchline);
  25.      newpatchline:=s;
  26. end;
  27.  
  28. function newsourceline:string;
  29. var s:string;
  30. begin
  31.      IF eof(source) THEN patcherror('Unexpected end of source:'+sourcename+' !');
  32.      {$i-}
  33.      readln(source,s);
  34.      {$i+}
  35.      IF ioresult<>0 THEN patcherror('Read error from '+sourcename+' !');
  36.      WHILE s[length(s)]=#32 DO dec(s[0]);
  37.      inc(SourceLine);
  38.      newsourceline:=s;
  39. end;
  40.  
  41. procedure newdestline(VAR s:STRING);
  42. begin
  43.      {$i-}
  44.      writeln(dest,s);
  45.      {$i+}
  46.      IF ioresult<>0 THEN patcherror('Write error to '+destname+' !');
  47. end;
  48.  
  49. procedure patchfile(VAR LastLine:STRING);
  50. var line,sourceline:string;
  51. LABEL l,l1;
  52. begin
  53.      line:=newpatchline;
  54.      IF line[1]<>'#' THEN patcherror(patchdir+'\tvpatch damaged or invalid !');
  55. l:
  56.      delete(line,1,1);
  57.      sourceline:=NewSourceLine;
  58.      WHILE line<>sourceline DO
  59.      BEGIN
  60.           NewDestLine(SourceLine);
  61.           sourceline:=NewSourceLine;
  62.      END;
  63.      {line found}
  64.      line:=newpatchline;
  65.      IF line[1]='#' THEN {multiple lines}
  66.      BEGIN
  67.           delete(line,1,1);
  68.           sourceline:=NewSourceLine;
  69.           WHILE line<>sourceline DO sourceline:=NewSourceLine;
  70.           {line found}
  71.           line:=newpatchline;
  72.           IF Line[1]<>'>' THEN patcherror(patchdir+'\tvpatch damaged or invalid !');
  73.      END;
  74. l1:
  75.      IF line[1]<>'>' THEN
  76.      BEGIN
  77.           CASE line[1] OF
  78.              '#':goto l;
  79.              '!':
  80.              BEGIN
  81.                   LastLine:=line;
  82.                   exit;
  83.              END;
  84.              ELSE patcherror(patchdir+'\tvpatch damaged or invalid !');
  85.           END;
  86.      END;
  87.      delete(line,1,1);
  88.      NewDestline(line);
  89.      line:=newpatchline;
  90.      goto l1;
  91. end;
  92.  
  93. procedure patchit;
  94. var line:string;
  95. label l;
  96. begin
  97.      line:=newpatchline;
  98. l:
  99.      IF line[1]<>'!' THEN patcherror(patchdir+'\tvpatch damaged or invalid !');
  100.      IF line[2]='!' THEN exit; {end}
  101.      delete(line,1,1);
  102.  
  103.      sourcename:=sourcedir+'\'+line;
  104.      assign(source,sourcename);
  105.      {$i-}
  106.      reset(source);
  107.      {$i+}
  108.      IF ioresult<>0 THEN patcherror('Could not open '+sourcename+' !');
  109.  
  110.      destname:=destdir+'\'+line;
  111.      assign(dest,destname);
  112.      {$i-}
  113.      rewrite(dest);
  114.      {$i+}
  115.      IF ioresult<>0 THEN patcherror('Could not open '+destname+' !');
  116.  
  117.      patchfile(line);
  118.  
  119.      {$i-}
  120.      close(source);
  121.      {$i+}
  122.      IF ioresult<>0 THEN
  123.         IF ioresult<>0 THEN patcherror('Could not close '+sourcename+' !');
  124.      {$i-}
  125.      close(dest);
  126.      {$i+}
  127.      IF ioresult<>0 THEN
  128.         IF ioresult<>0 THEN patcherror('Could not write '+destname+' !');
  129.  
  130.      goto l;
  131. end;
  132.  
  133. begin
  134.      Writeln('Patch utility for Turbo Vision 2.0');
  135.      Writeln('(C) 1995 SpeedSoft');
  136.      Writeln('May not run with Turbo Pascal 7.01');
  137.      Writeln;
  138.  
  139.      sourcedir:='d:\work';
  140.      destdir:='d:\pascpas\tv';
  141.      patchline:=0;
  142.      sourceline:=0;
  143.  
  144.      {getdir(0,patchdir);}
  145.      patchdir:='d:\pascpas';
  146.      IF patchdir[length(patchdir)]='\' THEN dec(patchdir[0]);
  147.  
  148.      assign(patch,patchdir+'\tvpatch.dat');
  149.      {$i-}
  150.      reset(patch);
  151.      {$i+}
  152.      IF ioresult<>0 THEN patcherror('Could not open '+patchdir+'\tvpatch.dat !');
  153.  
  154.      patchit;
  155.  
  156.      {$i-}
  157.      close(patch);
  158.      {$i+}
  159.  
  160.      Writeln('SUCCESS !');
  161. end.