home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 July & August / PCWorld_2002-07-08_cd.bin / Software / Topware / hackman / _SETUP.1 / Lang_upd.pas < prev    next >
Pascal/Delphi Source File  |  1999-02-09  |  7KB  |  312 lines
  1. program LanguageUpdate;
  2. {$I-}
  3.  
  4. {
  5.   Version 1.0 - December 28, 1998
  6.   Author      - Zweistein
  7.   Compiler    - Turbo Pascal 7.0 (Borland Pascal)
  8.  
  9.   This software is not intended to be an example for programming techniques.
  10.   It's more or less a quick hack.
  11.   Because Pascal is able to work with Strings no longer than 255 characters,
  12.   I implemented a class that can break this barrier - LongStr. It's a little
  13.   bit poor but works fine for the problem that had to be solved.
  14. }
  15.  
  16. uses Crt;
  17.  
  18.  
  19.  
  20.  
  21. type
  22.   TextFile = file;
  23.   CharBuffer = array [0..32767] of Char;
  24.   pCharBuffer = ^CharBuffer;
  25.  
  26.   LongStr = object
  27.     Buffer : pCharBuffer;
  28.     CurrLen : Word;
  29.     constructor Init(Size : Word);
  30.     procedure Insert(Str : String);
  31.     function ReadLn(var FromFile : TextFile) : Integer;
  32.     function WriteLn(var ToFile : TextFile) : Integer;
  33.     function FindChar(CharToFind : Char; Len : Integer) : Integer;
  34.     function Equals(OtherString : LongStr) : boolean;
  35.     function ToString : String;
  36.     destructor Done;
  37.   end;
  38.  
  39.   pLongStr = ^LongStr;
  40.  
  41. function MemCmp(Buf1 : pCharBuffer;
  42.                 Buf2 : pCharBuffer; Size : Integer) : boolean;
  43. var
  44.   Pos : Integer;
  45. begin
  46.   MemCmp := true;
  47.   Pos := 0;
  48.   while (Size > 0) do
  49.     begin
  50.       if (Buf1^[Pos] <> Buf2^[Pos]) then
  51.         begin
  52.           MemCmp := false;
  53.           break;
  54.         end
  55.       else
  56.         begin
  57.           dec(Size);
  58.           inc(Pos);
  59.         end;
  60.     end;
  61. end;
  62.  
  63.  
  64. constructor LongStr.Init(Size : Word);
  65. begin
  66.   GetMem(Buffer, Size);
  67. end;
  68.  
  69.  
  70. destructor LongStr.Done;
  71. begin
  72.   Dispose(Buffer);
  73. end;
  74.  
  75.  
  76. function LongStr.FindChar(CharToFind : Char; Len : Integer) : Integer;
  77. var
  78.   Pos : Integer;
  79. begin
  80.   FindChar := -1;
  81.   Pos := CurrLen;
  82.  
  83.   while (Len > 0) do
  84.     begin
  85.       if (Buffer^[Pos] = CharToFind) then
  86.         begin
  87.           FindChar := Pos + 1;
  88.           break;
  89.         end;
  90.       inc(Pos);
  91.       dec(Len);
  92.     end;
  93. end;
  94.  
  95.  
  96. function LongStr.ReadLn(var FromFile : TextFile) : Integer;
  97. var
  98.   CurrPos : LongInt;
  99.   CharPos : Integer;
  100.   NowRead : Integer;
  101.   Ready   : Boolean;
  102. begin
  103.   CurrPos := FilePos(FromFile);
  104.   CharPos := 0;
  105.   CurrLen := 0;
  106.   Ready := false;
  107.  
  108.   while not Ready do
  109.     begin
  110.       BlockRead(FromFile, Buffer^[CurrLen], 128, NowRead);
  111.  
  112.       if (NowRead = 0) then
  113.         begin
  114.           Ready := true;
  115.           CharPos := CurrLen;
  116.         end
  117.       else
  118.         begin
  119.           CharPos := FindChar(#10, NowRead);
  120.  
  121.           if (CharPos >= 0) then
  122.             break
  123.           else
  124.             CurrLen := CurrLen + NowRead;
  125.         end;
  126.     end;
  127.  
  128.   CurrLen := CharPos;
  129.  
  130.   if (CurrLen = 0) then
  131.     ReadLn := 26
  132.   else
  133.     begin
  134.       Seek(FromFile, CurrPos + CharPos);
  135.       ReadLn := IOResult;
  136.     end;
  137. end;
  138.  
  139.  
  140. function LongStr.WriteLn(var ToFile : TextFile) : Integer;
  141. begin
  142.   if (CurrLen > 0) then
  143.     begin
  144.       BlockWrite(ToFile, Buffer^, CurrLen);
  145.       WriteLn := IOResult;
  146.     end
  147.   else
  148.     WriteLn := 0;
  149. end;
  150.  
  151.  
  152.  
  153. function LongStr.Equals(OtherString : LongStr) : boolean;
  154. begin
  155.   if (CurrLen <> OtherString.CurrLen) then
  156.     Equals := false
  157.   else
  158.     Equals := MemCmp(Buffer, OtherString.Buffer, CurrLen);
  159. end;
  160.  
  161. procedure LongStr.Insert(Str : String);
  162. var
  163.   Len : Integer;
  164. begin
  165.   Len := Length(Str);
  166.   Move(Buffer^, Buffer^[Len], CurrLen);
  167.   Move(Str[1], Buffer^, Len);
  168.   CurrLen := CurrLen + Len;
  169. end;
  170.  
  171. function LongStr.ToString : String;
  172. var
  173.   Len : Integer;
  174.   MyStr : String;
  175. begin
  176.   if (CurrLen > 255) then
  177.     Len := 255
  178.   else
  179.     Len := CurrLen;
  180.  
  181.   Move(Buffer^, MyStr[1], Len);
  182.   MyStr[0] := Char(Len);
  183.   ToString := MyStr;
  184. end;
  185.  
  186.  
  187. var
  188.   EnglishOld : TextFile;
  189.   EnglishNew : TextFile;
  190.   MyLangOld : TextFile;
  191.   MyLangNew : TextFile;
  192.  
  193.  
  194. procedure Process;
  195. var
  196.   EngOldLine : pLongStr;
  197.   EngNewLine : pLongStr;
  198.   MyLangOldLine : pLongStr;
  199.   MyLangNewLine : pLongStr;
  200.   Error : Integer;
  201.   Step : Integer;
  202.   LineCnt : Integer;
  203. begin
  204.   Error := 0;
  205.   LineCnt := 0;
  206.   EngOldLine := New(pLongStr, Init(1024));
  207.   EngNewLine := New(pLongStr, Init(1024));
  208.   MyLangOldLine := New(pLongStr, Init(1024));
  209.   MyLangNewLine := New(pLongStr, Init(1024));
  210.  
  211.   while (Error = 0) and not Eof(EnglishOld) do
  212.     begin
  213.       Step := 1;
  214.       inc(LineCnt);
  215.       GotoXY(1, WhereY);
  216.       Write(LineCnt:5);
  217.       if (LineCnt > 1000) then
  218.         begin
  219.           LineCnt := LineCnt * 1;
  220.         end;
  221.       Error := EngOldLine^.ReadLn(EnglishOld);
  222.  
  223.       if (Error = 0) then
  224.         begin
  225.           Error := EngNewLine^.ReadLn(EnglishNew);
  226.           inc(Step);
  227.         end;
  228.  
  229.       if (Error = 0) then
  230.         begin
  231.           Error := MyLangOldLine^.ReadLn(MyLangOld);
  232.           inc(Step);
  233.         end;
  234.  
  235.       if (Error = 0) then
  236.         begin
  237.           if (EngOldLine^.Equals(EngNewLine^)) then
  238.             Error := MyLangOldLine^.WriteLn(MyLangNew)
  239.           else
  240.             begin
  241.               EngNewLine^.Insert('**');
  242.               Error := EngNewLine^.WriteLn(MyLangNew);
  243.             end;
  244.           inc(Step);
  245.         end;
  246.     end;
  247.  
  248.   if (Error <> 0) and (Error <> 26) then
  249.     begin
  250.       if (Step > 0) and (Step < 4) then
  251.         WriteLn('Error ',Error, ' reading file "',ParamStr(Step),'"')
  252.       else
  253.        WriteLn('Error ',Error, ' writing file "',ParamStr(4),'"');
  254.     end;
  255. end;
  256.  
  257. var
  258.   Error : Integer;
  259.  
  260. function OK(FileName: String; Operation : String) : boolean;
  261. begin
  262.   if (Error <> 0) then
  263.     OK := false
  264.   else
  265.     begin
  266.       Error := IOResult;
  267.       OK := (Error = 0);
  268.     end;
  269. end;
  270.  
  271. begin
  272.   ClrScr;
  273.  
  274.   if (ParamCount <> 4) then
  275.     begin
  276.       WriteLn(#13#10'Oh no !');
  277.       WriteLn;
  278.       WriteLn('Synopsis:');
  279.       WriteLn;
  280.       WriteLn(' LANG_UPD EnglishOld  EnglishNew  MyLangOld  MyLangNew <RETURN>');
  281.       WriteLn;
  282.       WriteLn('Example:');
  283.       WriteLn;
  284.       WriteLn(' LANG_UPD English.31  English.32  Greek.31  Greek.32<RETURN>');
  285.       WriteLn;
  286.       WriteLn('Please read README.TXT for details.');
  287.       Halt;
  288.     end;
  289.   Error := 0;
  290.   Assign(EnglishOld, ParamStr(1));
  291.   if (OK(ParamStr(1), 'opening')) then
  292.     Assign(EnglishNew, ParamStr(2));
  293.   if (OK(ParamStr(2), 'opening')) then
  294.     Assign(MyLangOld, ParamStr(3));
  295.   if (OK(ParamStr(3), 'opening')) then
  296.     Assign(MyLangNew, ParamStr(4));
  297.   if (OK(ParamStr(4), 'opening')) then
  298.     Reset(EnglishOld, 1);
  299.   if (OK(ParamStr(1), 'opening')) then
  300.     Reset(EnglishNew, 1);
  301.   if (OK(ParamStr(2), 'opening')) then
  302.     Reset(MyLangOld, 1);
  303.   if (OK(ParamStr(3), 'opening')) then
  304.     Rewrite(MyLangNew, 1);
  305.   if (OK(ParamStr(2), 'opening')) then
  306.     Process;
  307.  
  308.   Close(EnglishOld); Error := IOResult;
  309.   Close(EnglishNew); Error := IOResult;
  310.   Close(MyLangOld);  Error := IOResult;
  311.   Close(MyLangNew);  Error := IOResult;
  312. end.