Steganos Hacker Tools/SHT151.iso/programme/crack/hackman/_SETUP.1/Lang_upd.pas

Pascal/Delphi Source File | 1999-02-09 | 6.7 KB | 312 lines

program LanguageUpdate;
{$I-}

{
  Version 1.0 - December 28, 1998
  Author      - Zweistein
  Compiler    - Turbo Pascal 7.0 (Borland Pascal)

  This software is not intended to be an example for programming techniques.
  It's more or less a quick hack.
  Because Pascal is able to work with Strings no longer than 255 characters,
  I implemented a class that can break this barrier - LongStr. It's a little
  bit poor but works fine for the problem that had to be solved.
}

uses Crt;




type
  TextFile = file;
  CharBuffer = array [0..32767] of Char;
  pCharBuffer = ^CharBuffer;

  LongStr = object
    Buffer : pCharBuffer;
    CurrLen : Word;
    constructor Init(Size : Word);
    procedure Insert(Str : String);
    function ReadLn(var FromFile : TextFile) : Integer;
    function WriteLn(var ToFile : TextFile) : Integer;
    function FindChar(CharToFind : Char; Len : Integer) : Integer;
    function Equals(OtherString : LongStr) : boolean;
    function ToString : String;
    destructor Done;
  end;

  pLongStr = ^LongStr;

function MemCmp(Buf1 : pCharBuffer;
                Buf2 : pCharBuffer; Size : Integer) : boolean;
var
  Pos : Integer;
begin
  MemCmp := true;
  Pos := 0;
  while (Size > 0) do
    begin
      if (Buf1^[Pos] <> Buf2^[Pos]) then
        begin
          MemCmp := false;
          break;
        end
      else
        begin
          dec(Size);
          inc(Pos);
        end;
    end;
end;


constructor LongStr.Init(Size : Word);
begin
  GetMem(Buffer, Size);
end;


destructor LongStr.Done;
begin
  Dispose(Buffer);
end;


function LongStr.FindChar(CharToFind : Char; Len : Integer) : Integer;
var
  Pos : Integer;
begin
  FindChar := -1;
  Pos := CurrLen;

  while (Len > 0) do
    begin
      if (Buffer^[Pos] = CharToFind) then
        begin
          FindChar := Pos + 1;
          break;
        end;
      inc(Pos);
      dec(Len);
    end;
end;


function LongStr.ReadLn(var FromFile : TextFile) : Integer;
var
  CurrPos : LongInt;
  CharPos : Integer;
  NowRead : Integer;
  Ready   : Boolean;
begin
  CurrPos := FilePos(FromFile);
  CharPos := 0;
  CurrLen := 0;
  Ready := false;

  while not Ready do
    begin
      BlockRead(FromFile, Buffer^[CurrLen], 128, NowRead);

      if (NowRead = 0) then
        begin
          Ready := true;
          CharPos := CurrLen;
        end
      else
        begin
          CharPos := FindChar(#10, NowRead);

          if (CharPos >= 0) then
            break
          else
            CurrLen := CurrLen + NowRead;
        end;
    end;

  CurrLen := CharPos;

  if (CurrLen = 0) then
    ReadLn := 26
  else
    begin
      Seek(FromFile, CurrPos + CharPos);
      ReadLn := IOResult;
    end;
end;


function LongStr.WriteLn(var ToFile : TextFile) : Integer;
begin
  if (CurrLen > 0) then
    begin
      BlockWrite(ToFile, Buffer^, CurrLen);
      WriteLn := IOResult;
    end
  else
    WriteLn := 0;
end;



function LongStr.Equals(OtherString : LongStr) : boolean;
begin
  if (CurrLen <> OtherString.CurrLen) then
    Equals := false
  else
    Equals := MemCmp(Buffer, OtherString.Buffer, CurrLen);
end;

procedure LongStr.Insert(Str : String);
var
  Len : Integer;
begin
  Len := Length(Str);
  Move(Buffer^, Buffer^[Len], CurrLen);
  Move(Str[1], Buffer^, Len);
  CurrLen := CurrLen + Len;
end;

function LongStr.ToString : String;
var
  Len : Integer;
  MyStr : String;
begin
  if (CurrLen > 255) then
    Len := 255
  else
    Len := CurrLen;

  Move(Buffer^, MyStr[1], Len);
  MyStr[0] := Char(Len);
  ToString := MyStr;
end;


var
  EnglishOld : TextFile;
  EnglishNew : TextFile;
  MyLangOld : TextFile;
  MyLangNew : TextFile;


procedure Process;
var
  EngOldLine : pLongStr;
  EngNewLine : pLongStr;
  MyLangOldLine : pLongStr;
  MyLangNewLine : pLongStr;
  Error : Integer;
  Step : Integer;
  LineCnt : Integer;
begin
  Error := 0;
  LineCnt := 0;
  EngOldLine := New(pLongStr, Init(1024));
  EngNewLine := New(pLongStr, Init(1024));
  MyLangOldLine := New(pLongStr, Init(1024));
  MyLangNewLine := New(pLongStr, Init(1024));

  while (Error = 0) and not Eof(EnglishOld) do
    begin
      Step := 1;
      inc(LineCnt);
      GotoXY(1, WhereY);
      Write(LineCnt:5);
      if (LineCnt > 1000) then
        begin
          LineCnt := LineCnt * 1;
        end;
      Error := EngOldLine^.ReadLn(EnglishOld);

      if (Error = 0) then
        begin
          Error := EngNewLine^.ReadLn(EnglishNew);
          inc(Step);
        end;

      if (Error = 0) then
        begin
          Error := MyLangOldLine^.ReadLn(MyLangOld);
          inc(Step);
        end;

      if (Error = 0) then
        begin
          if (EngOldLine^.Equals(EngNewLine^)) then
            Error := MyLangOldLine^.WriteLn(MyLangNew)
          else
            begin
              EngNewLine^.Insert('**');
              Error := EngNewLine^.WriteLn(MyLangNew);
            end;
          inc(Step);
        end;
    end;

  if (Error <> 0) and (Error <> 26) then
    begin
      if (Step > 0) and (Step < 4) then
        WriteLn('Error ',Error, ' reading file "',ParamStr(Step),'"')
      else
       WriteLn('Error ',Error, ' writing file "',ParamStr(4),'"');
    end;
end;

var
  Error : Integer;

function OK(FileName: String; Operation : String) : boolean;
begin
  if (Error <> 0) then
    OK := false
  else
    begin
      Error := IOResult;
      OK := (Error = 0);
    end;
end;

begin
  ClrScr;

  if (ParamCount <> 4) then
    begin
      WriteLn(#13#10'Oh no !');
      WriteLn;
      WriteLn('Synopsis:');
      WriteLn;
      WriteLn(' LANG_UPD EnglishOld  EnglishNew  MyLangOld  MyLangNew <RETURN>');
      WriteLn;
      WriteLn('Example:');
      WriteLn;
      WriteLn(' LANG_UPD English.31  English.32  Greek.31  Greek.32<RETURN>');
      WriteLn;
      WriteLn('Please read README.TXT for details.');
      Halt;
    end;
  Error := 0;
  Assign(EnglishOld, ParamStr(1));
  if (OK(ParamStr(1), 'opening')) then
    Assign(EnglishNew, ParamStr(2));
  if (OK(ParamStr(2), 'opening')) then
    Assign(MyLangOld, ParamStr(3));
  if (OK(ParamStr(3), 'opening')) then
    Assign(MyLangNew, ParamStr(4));
  if (OK(ParamStr(4), 'opening')) then
    Reset(EnglishOld, 1);
  if (OK(ParamStr(1), 'opening')) then
    Reset(EnglishNew, 1);
  if (OK(ParamStr(2), 'opening')) then
    Reset(MyLangOld, 1);
  if (OK(ParamStr(3), 'opening')) then
    Rewrite(MyLangNew, 1);
  if (OK(ParamStr(2), 'opening')) then
    Process;

  Close(EnglishOld); Error := IOResult;
  Close(EnglishNew); Error := IOResult;
  Close(MyLangOld);  Error := IOResult;
  Close(MyLangNew);  Error := IOResult;
end.