ObfPas --only-gui

program PasObf;

{$mode objfpc}{$H+}

uses
  SysUtils, Classes, StrUtils, Math, Windows;

const
  NEVER_TOUCH_PROGRAMS = True;
  ENABLE_POSTPROCESS = False;  // Gate cosmetic rewrite passes
  SKIP_BETTERCONTROLS = True;  // Skip betterControls/* units
  SKIP_DBK32 = True;           // Skip dbk32/* units



type
  TTokenKind = (tkIdent, tkString, tkWhitespace, tkComment, tkSymbol, tkNumber, tkOther);

  TToken = record
    Kind: TTokenKind;
    Text: string;
    InInterface: Boolean;
    InUses: Boolean;
    InConstBlock: Boolean;
  end;

  TTokenArray = array of TToken;
  TStrArray   = array of string;

  TStrSet = class
  private
    S: TStringList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(const v: string);
    function Has(const v: string): Boolean;
    procedure Clear;
  end;

var
  GXorStrFuncName: string;
  GPolymorphicFuncCode: string;
  GHostUnitName: string;
  GHostUnitFileName: string;
  GRoot: string = '';
  GInplace: Boolean = False;
  GOnlyGUI: Boolean = False;
  GSeed: LongInt = 0;
  GSeedGiven: Boolean = False;
  GXorKey: string = '';
  PublicNames : TStrSet = nil;
  DeclaredHere: TStrSet = nil;
  SkipNames   : TStrSet = nil;
  PascalKeywords: TStrArray;

constructor TStrSet.Create;
begin
  S := TStringList.Create;
  S.CaseSensitive := False;
  S.Sorted := True;
  S.Duplicates := dupIgnore;
end;

destructor TStrSet.Destroy;
begin
  S.Free;
  inherited Destroy;
end;

procedure TStrSet.Add(const v: string);
begin
  if v <> '' then S.Add(v);
end;

function TStrSet.Has(const v: string): Boolean;
begin
  Result := (v <> '') and (S.IndexOf(v) >= 0);
end;

procedure TStrSet.Clear;
begin
  S.Clear;
end;

function MakeStrArray(const A: array of string): TStrArray;
var
  i: Integer;
begin
  Result := nil;
  SetLength(Result, Length(A));
  for i := Low(A) to High(A) do
    Result[i] := LowerCase(A[i]);
end;

procedure InitKeywords;
begin
  PascalKeywords := MakeStrArray([
    'and','array','as','asm','begin','case','class','const','constructor',
    'destructor','div','do','downto','else','end','except','exports','file',
    'finalization','finally','for','function','goto','if','implementation',
    'in','inherited','initialization','inline','interface','is','label','library',
    'mod','nil','not','object','of','or','out','packed','procedure','program',
    'property','raise','record','repeat','resourcestring','set','shl','shr',
    'string','then','threadvar','to','try','type','unit','until','uses',
    'var','while','with','xor','specialize','generic','on','helper','result',
    'true','false','default','abstract','overload','override','reintroduce',
    'virtual','cdecl','stdcall','safecall','register','far','near','private',
    'protected','public','published','pchar','forspecificcpu','foreachcpu',
    'input','PBOOL','integer','PDWORD',
    'absolute','external','operator','deprecated','platform','experimental',
    'strict','sealed','final','static','message','pascal','export'
  ]);
end;

function IsKeyword(const S: string): Boolean;
var
  L: string;
  i: Integer;
begin
  L := LowerCase(S);
  for i := Low(PascalKeywords) to High(PascalKeywords) do
    if L = PascalKeywords[i] then
      Exit(True);
  Result := False;
end;

function IsIdentStart(const C: Char): Boolean; inline;
begin
  Result := (C = '_') or (C in ['A'..'Z','a'..'z']);
end;

function IsIdentChar(const C: Char): Boolean; inline;
begin
  Result := IsIdentStart(C) or (C in ['0'..'9']);
end;

procedure SplitExtPasFiles(const Root: string; List: TStrings; Recursive: Boolean = True);
var
  SR: TSearchRec;
  Sub: string;
begin
  if FindFirst(IncludeTrailingPathDelimiter(Root) + '*', faAnyFile, SR) = 0 then
  try
    repeat
      if (SR.Name = '.') or (SR.Name = '..') then Continue;
      if (SR.Attr and faDirectory) <> 0 then
      begin
        if Recursive then
        begin
          Sub := IncludeTrailingPathDelimiter(Root) + SR.Name;
          SplitExtPasFiles(Sub, List, True);
        end;
      end
      else
      begin
        if AnsiEndsText('.pas', SR.Name) or AnsiEndsText('.pp', SR.Name) or AnsiEndsText('.lpr', SR.Name) then
          List.Add(IncludeTrailingPathDelimiter(Root) + SR.Name);
      end;
    until FindNext(SR) <> 0;
  finally
    SysUtils.FindClose(SR);
  end;
end;

procedure AddToken(var Tokens: TTokenArray; var Count: Integer; Kind: TTokenKind;
                   const Text: string; InInterface, InUses, InConstBlock: Boolean);
begin
  if Count >= Length(Tokens) then
    SetLength(Tokens, Length(Tokens) * 2 + 256);
  Tokens[Count].Kind := Kind;
  Tokens[Count].Text := Text;
  Tokens[Count].InInterface := InInterface;
  Tokens[Count].InUses := InUses;
  Tokens[Count].InConstBlock := InConstBlock;
  Inc(Count);
end;

procedure LexFile(const Content: string; out Tokens: TTokenArray; out Count: Integer);
var
  i, n: Integer;
  ch: Char;
  buf: string;
  inInterface, inUses, inConstBlock, inResourceStringBlock: Boolean;
  isConstContext: Boolean;

  function Peek(offset: Integer): Char;
  var idx: Integer;
  begin
    idx := i + offset;
    if (idx >= 1) and (idx <= n) then Result := Content[idx] else Result := #0;
  end;

  procedure FlushBuf(kind: TTokenKind);
  begin
    if buf <> '' then
    begin
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, kind, buf, inInterface, inUses, isConstContext);
      buf := '';
    end;
  end;

  procedure AddSym(const s: string);
  begin
    FlushBuf(tkOther);
    isConstContext := inConstBlock or inResourceStringBlock;
    AddToken(Tokens, Count, tkSymbol, s, inInterface, inUses, isConstContext);
  end;

begin
  Count := 0;
  SetLength(Tokens, 1024);
  i := 1; n := Length(Content);
  buf := '';
  inInterface := False;
  inUses := False;
  inConstBlock := False;
  inResourceStringBlock := False;
  while i <= n do
  begin
    ch := Content[i];
    if ch in [#9, #10, #13, ' '] then
    begin
      FlushBuf(tkOther);
      buf := '';
      repeat
        buf := buf + ch;
        Inc(i);
        if i > n then Break;
        ch := Content[i];
      until not (ch in [#9,#10,#13,' ']);
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkWhitespace, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if (ch = '/') and (Peek(1) = '/') then
    begin
      FlushBuf(tkOther);
      buf := '//';
      Inc(i, 2);
      while (i <= n) and not (Content[i] in [#10, #13]) do
      begin
        buf := buf + Content[i];
        Inc(i);
      end;
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkComment, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if ch = '{' then
    begin
      FlushBuf(tkOther);
      buf := '{';
      Inc(i);
      while (i <= n) and (Content[i] <> '}') do
      begin
        buf := buf + Content[i];
        Inc(i);
      end;
      if (i <= n) and (Content[i] = '}') then
      begin
        buf := buf + '}';
        Inc(i);
      end;
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkComment, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if (ch = '(') and (Peek(1) = '*') then
    begin
      FlushBuf(tkOther);
      buf := '(*';
      Inc(i, 2);
      while (i <= n) and not ((Content[i] = '*') and (Peek(1) = ')')) do
      begin
        buf := buf + Content[i];
        Inc(i);
      end;
      if (i <= n-1) then
      begin
        buf := buf + '*)';
        Inc(i, 2);
      end;
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkComment, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if ch = '''' then
    begin
      FlushBuf(tkOther);
      buf := '''';
      Inc(i);
      while i <= n do
      begin
        ch := Content[i];
        buf := buf + ch;
        Inc(i);
        if ch = '''' then
        begin
          if (i <= n) and (Content[i] = '''') then
          begin
            buf := buf + Content[i];
            Inc(i);
            Continue;
          end
          else
            Break;
        end;
      end;
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkString, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if IsIdentStart(ch) then
    begin
      FlushBuf(tkOther);
      buf := '';
      while (i <= n) and IsIdentChar(Content[i]) do
      begin
        buf := buf + Content[i];
        Inc(i);
      end;
      if AnsiSameText(buf, 'interface') then
      begin
        inInterface := True; inUses := False;
      end
      else if AnsiSameText(buf, 'implementation') then
      begin
        inInterface := False; inUses := False; inConstBlock := False; inResourceStringBlock := False;
      end
      else if AnsiSameText(buf, 'uses') then
        inUses := True
      else if AnsiSameText(buf, 'const') then
        inConstBlock := True
      else if AnsiSameText(buf, 'resourcestring') then
        inResourceStringBlock := True
      else if AnsiSameText(buf, 'var') or AnsiSameText(buf, 'type') or AnsiSameText(buf, 'label') or
              AnsiSameText(buf, 'threadvar') or AnsiSameText(buf, 'class') or
              AnsiSameText(buf, 'procedure') or AnsiSameText(buf, 'function') then
      begin
        inConstBlock := False;
        inResourceStringBlock := False;
      end;
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkIdent, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if (ch in ['0'..'9']) or ((ch = '$') and (Peek(1) in ['0'..'9','A'..'F','a'..'f'])) then
    begin
      FlushBuf(tkOther);
      buf := '';
      if ch = '$' then
      begin
        buf := buf + ch;
        Inc(i);
        while (i <= n) and (Content[i] in ['0'..'9','A'..'F','a'..'f']) do
        begin
          buf := buf + Content[i];
          Inc(i);
        end;
      end else
      begin
        while (i <= n) and (Content[i] in ['0'..'9']) do
        begin
          buf := buf + Content[i];
          Inc(i);
        end;
        if (i <= n) and (Content[i] = '.') and (Peek(1) <> '.') then
        begin
          buf := buf + Content[i];
          Inc(i);
          while (i <= n) and (Content[i] in ['0'..'9']) do
          begin
            buf := buf + Content[i];
            Inc(i);
          end;
        end;
      end;
      isConstContext := inConstBlock or inResourceStringBlock;
      AddToken(Tokens, Count, tkNumber, buf, inInterface, inUses, isConstContext);
      buf := '';
      Continue;
    end;
    if (ch = '.') and (Peek(1) = '.') then begin AddSym('..'); Inc(i,2); Continue; end;
    if (ch = '<') and (Peek(1) = '=') then begin AddSym('<='); Inc(i,2); Continue; end;
    if (ch = '>') and (Peek(1) = '=') then begin AddSym('>='); Inc(i,2); Continue; end;
    if (ch = '<') and (Peek(1) = '>') then begin AddSym('<>'); Inc(i,2); Continue; end;
    if (ch = ':') and (Peek(1) = '=') then begin AddSym(':='); Inc(i,2); Continue; end;
    if ch in [';', ':', '+','-','*','/','(',')','[',']','{','}','^','@',',','.','<','>','='] then
    begin
      AddSym(ch);
      Inc(i);
      Continue;
    end;
    buf := buf + ch;
    Inc(i);
  end;
  FlushBuf(tkOther);
  SetLength(Tokens, Count);
end;

function EncryptStringForPascal(const s: string; const Key: string): string;
var
  i: Integer;
  encryptedByte: Byte;
begin
  if s = '' then Exit('[]');
  if Key = '' then
  begin
    Result := '[';
    for i := 1 to Length(s) do
    begin
      Result := Result + IntToStr(Ord(s[i]));
      if i < Length(s) then Result := Result + ', ';
    end;
    Result := Result + ']';
    Exit;
  end;
  Result := '[';
  for i := 1 to Length(s) do
  begin
    encryptedByte := Ord(s[i]) xor Ord(Key[((i-1) mod Length(Key)) + 1]);
    Result := Result + IntToStr(encryptedByte);
    if i < Length(s) then Result := Result + ', ';
  end;
  Result := Result + ']';
end;

function LookupNewName(const OrigLower: string; MapOrig, MapNew: TStrings; out NewName: string): Boolean;
var
  i: Integer;
begin
  i := MapOrig.IndexOf(OrigLower);
  Result := (i >= 0);
  if Result then NewName := MapNew[i];
end;

function IsCaseLabel(const Tokens: TTokenArray; idx: Integer): Boolean;
var
  j: Integer;
begin
  Result := False;
  if idx >= High(Tokens) then Exit(False);
  j := idx + 1;
  while j <= High(Tokens) do
  begin
    if Tokens[j].Kind in [tkWhitespace, tkComment] then
    begin
      Inc(j);
      continue;
    end;

    if (Tokens[j].Kind = tkSymbol) and (Tokens[j].Text = ':') then
      Result := True;

    break;
  end;
end;

function FixDanglingConcats(const S: string): string;
begin
  Result := S;
  // plus before delimiters -> add empty string
  Result := StringReplace(Result, ' + )', ' + '''' )', [rfReplaceAll]);
  Result := StringReplace(Result, ' + ,', ' + '''' ,', [rfReplaceAll]);
  Result := StringReplace(Result, ' + ;', ' + '''' ;', [rfReplaceAll]);
  Result := StringReplace(Result, ' + ]', ' + '''' ]', [rfReplaceAll]);
  Result := StringReplace(Result, ' + {$endif}', ' + '''' {$endif}', [rfReplaceAll]);
  Result := StringReplace(Result, ' + {$ELSE}', ' + '''' {$ELSE}', [rfReplaceAll]);
  Result := StringReplace(Result, ' + {$else}', ' + '''' {$else}', [rfReplaceAll]);
  Result := StringReplace(Result, ' + {$ENDIF}', ' + '''' {$ENDIF}', [rfReplaceAll]);

  // plus right after opening delimiters or assignment -> inject empty string on left
  Result := StringReplace(Result, '( + ', '( '''' + ', [rfReplaceAll]);
  Result := StringReplace(Result, '[ + ', '[ '''' + ', [rfReplaceAll]);
  Result := StringReplace(Result, ':= + ', ':= '''' + ', [rfReplaceAll]);
  Result := StringReplace(Result, ' = + ', ' = '''' + ', [rfReplaceAll]);

  // collapse any accidental '+  +'
  Result := StringReplace(Result, '+  +', '+', [rfReplaceAll]);
  Result := StringReplace(Result, '+   +', '+', [rfReplaceAll]);
end;


procedure SaveStringToFile(const APath, S: string);
var
  fs: TFileStream;
begin
  fs := TFileStream.Create(APath, fmCreate);
  try
    if Length(S) > 0 then
      fs.WriteBuffer(S[1], Length(S));
  finally
    fs.Free;
  end;
end;

function LoadFileToString(const APath: string): string;
var
  fs: TFileStream;
begin
  Result := '';
  if not FileExists(APath) then Exit;
  fs := TFileStream.Create(APath, fmOpenRead or fmShareDenyNone);
  try
    SetLength(Result, fs.Size);
    if fs.Size > 0 then
      fs.ReadBuffer(Result[1], fs.Size);
  finally
    fs.Free;
  end;
end;

function CastAPICalls(const S: string): string; forward;
function BalanceParensPerStatement(const S: string): string; forward;


function NeedsPCharWrap(const Arg: string): boolean;
var t: string;
begin
  t := Trim(Arg);
  Result := not (
    (Pos('PCHAR(',   UpperCase(t)) = 1) or
    (Pos('PWIDECHAR(', UpperCase(t)) = 1) or
    (Pos('PANSICHAR(', UpperCase(t)) = 1)
  );
end;

function WrapPChar(const Arg, ApiName: string): string;
begin
  // Choose PWideChar for *W APIs, PAnsiChar for *A APIs, else PChar
  if (Length(ApiName) > 0) and (ApiName[Length(ApiName)] in ['W','w']) then
    Result := 'PWideChar(' + Arg + ')'
  else if (Length(ApiName) > 0) and (ApiName[Length(ApiName)] in ['A','a']) then
    Result := 'PAnsiChar(' + Arg + ')'
  else
    Result := 'PChar(' + Arg + ')';
end;


function ForcePCharOnAPILine(const Line: string): string;

  function FindArgSpan(const L: string; openPos: Integer; out closePos: Integer): boolean;
  var j, depth: Integer; inS: Boolean;
  begin
    Result := False;
    depth := 0;
    inS := False;
    j := openPos;
    while j <= Length(L) do
    begin
      if L[j] = '''' then inS := not inS
      else if not inS then
      begin
        if L[j] = '(' then Inc(depth)
        else if L[j] = ')' then
        begin
          Dec(depth);
          if depth = 0 then
          begin
            closePos := j;
            Exit(True);
          end;
        end;
      end;
      Inc(j);
    end;
  end;

  function FixSingleArg(const api, L: string): string;
  var u: string; i, openPos, closePos: Integer;
      before, args, after: string;
  begin
    Result := L;
    u := UpperCase(L);
    i := Pos(UpperCase(api) + '(', u);
    if i = 0 then Exit;
    openPos := i + Length(api);
    if (openPos > Length(L)) or (L[openPos] <> '(') then Exit;
    if not FindArgSpan(L, openPos, closePos) then Exit;
    before := Copy(L, 1, openPos);
    args   := Copy(L, openPos+1, closePos-openPos-1);
    after  := Copy(L, closePos, Length(L)-closePos+1);
    if NeedsPCharWrap(args) then
      Result := before + WrapPChar(Trim(args), api) + after
    else
      Result := L;
  end;

  function FixGetProcAddress(const L: string): string;
  var u: string; i, openPos, closePos: Integer;
      before, args, after, a1, a2: string;
      k, depth: Integer; inS: Boolean; commaPos: Integer;
  begin
    Result := L;
    u := UpperCase(L);
    i := Pos('GETPROCADDRESS(', u);
    if i = 0 then Exit;
    openPos := i + Length('GetProcAddress');
    if (openPos > Length(L)) or (L[openPos] <> '(') then Exit;
    if not FindArgSpan(L, openPos, closePos) then Exit;
    before := Copy(L, 1, openPos);
    args   := Copy(L, openPos+1, closePos-openPos-1);
    after  := Copy(L, closePos, Length(L)-closePos+1);

    // Find top-level comma in args
    commaPos := 0; depth := 0; inS := False;
    for k := 1 to Length(args) do
    begin
      if args[k] = '''' then inS := not inS
      else if not inS then
      begin
        if args[k] = '(' then Inc(depth)
        else if args[k] = ')' then Dec(depth)
        else if (args[k] = ',') and (depth = 0) then
        begin
          commaPos := k; Break;
        end;
      end;
    end;
    if commaPos = 0 then Exit; // malformed, skip

    a1 := Trim(Copy(args, 1, commaPos-1));
    a2 := Trim(Copy(args, commaPos+1, MaxInt));

    if NeedsPCharWrap(a2) then
      args := a1 + ', ' + WrapPChar(a2, 'GetProcAddress')
    else
      args := a1 + ', ' + a2;

    Result := before + args + after;
  end;

var tmp: string;
begin
  tmp := FixGetProcAddress(Line);     if tmp <> Line then Exit(tmp);
  tmp := FixSingleArg('LoadLibrary', Line);     if tmp <> Line then Exit(tmp);
  tmp := FixSingleArg('GetModuleHandle', Line); if tmp <> Line then Exit(tmp);
  tmp := FixSingleArg('OutputDebugString', Line); if tmp <> Line then Exit(tmp);
  Result := Line;
end;

function ForcePCharOnAPI(const S: string): string;
var sl: TStringList;
    k: Integer;
begin
  sl := TStringList.Create;
  try
    sl.Text := S;
    for k := 0 to sl.Count-1 do
      sl[k] := ForcePCharOnAPILine(sl[k]);
    Result := sl.Text;
  finally
    sl.Free;
  end;
end;


function IsProgramOrLibraryFile(const APath: string): Boolean;
var
  s, lower: string;
  i, n: Integer;
begin
  Result := False;
  if (AnsiSameText(ExtractFileExt(APath), '.lpr')) or (AnsiSameText(ExtractFileExt(APath), '.dpr')) then
    Exit(True);

  // Sniff first non-comment token (very lightweight)
  s := LoadFileToString(APath);
  lower := LowerCase(s);
  i := 1;
  while (i <= Length(s)) and (s[i] in [#0..#32]) do Inc(i);
  // skip line/block comments
  while (i <= Length(lower)) and ((Copy(lower,i,2)='//' ) or (Copy(lower,i,2)='(*') or (Copy(lower,i,1)='{')) do
  begin
    if Copy(lower,i,2)='//' then
      while (i<=Length(s)) and not (s[i] in [#10,#13]) do Inc(i)
    else
    begin
      n := Pos('*)', Copy(lower, i, MaxInt));
      if n=0 then Break else i := i + n + 1;
    end;
    while (i <= Length(s)) and (s[i] in [#0..#32]) do Inc(i);
  end;
  if Copy(lower,i,7)='program' then Exit(True);
  if Copy(lower,i,7)='library' then Exit(True);
end;

function PosFrom(const SubStr, S: string; StartIndex: SizeInt): SizeInt;
var
  tmp: SizeInt;
begin
  if StartIndex<=1 then
    Exit(Pos(SubStr, S));
  tmp := Pos(SubStr, Copy(S, StartIndex, MaxInt));
  if tmp>0 then
    Result := StartIndex + tmp - 1
  else
    Result := 0;
end;

function EnsureRuntimeInImplementationUses(const InTxt: string): string;
var
  lower: string;
  implPos, usesPos, semiPos, checkPos: SizeInt;
  needInsert: Boolean;
  addStr: string;
begin
  Result := InTxt;
  // Add only if the unit calls the generated function
  if Pos(GXorStrFuncName + '(', Result) = 0 then Exit;

  addStr := GHostUnitName; // typically 'obf_runtime'

  lower := LowerCase(Result);

  implPos := Pos('implementation', lower);
  if implPos>0 then
  begin
    // find 'uses' after implementation
    usesPos := PosFrom('uses', lower, implPos + Length('implementation'));
    if usesPos>0 then
    begin
      semiPos := PosFrom(';', lower, usesPos);
      if semiPos>0 then
      begin
        // check if addStr already present between usesPos and semiPos
        checkPos := PosFrom(LowerCase(addStr), lower, usesPos);
        needInsert := not ((checkPos>0) and (checkPos<semiPos));
        if needInsert then
        begin
          Insert(', ' + addStr, Result, semiPos);
        end;
        Exit;
      end;
    end;
    // no implementation uses list; create one
    Insert(LineEnding + 'uses ' + addStr + ';' + LineEnding, Result, implPos + Length('implementation'));
    Exit;
  end;

  // Fallback: try top-level uses
  usesPos := Pos('uses', lower);
  if usesPos>0 then
  begin
    semiPos := PosFrom(';', lower, usesPos);
    if semiPos>0 then
    begin
      checkPos := PosFrom(LowerCase(addStr), lower, usesPos);
      if not ((checkPos>0) and (checkPos<semiPos)) then
        Insert(', ' + addStr, Result, semiPos);
    end;
  end
  else
  begin
    // As last resort, add after unit header
    usesPos := Pos('unit', lower);
    if usesPos>0 then
    begin
      semiPos := PosFrom(';', lower, usesPos);
      if semiPos>0 then
        Insert(LineEnding + 'uses ' + addStr + ';' + LineEnding, Result, semiPos+1);
    end;
  end;
end;

function EnsureUnitInUsesList(const InTxt, UnitName: string; StartFrom: SizeInt): string;
var
  lower: string;
  usesPos, semiPos, checkPos: SizeInt;
begin
  Result := InTxt;
  lower := LowerCase(Result);
  usesPos := PosFrom('uses', lower, StartFrom);
  if usesPos>0 then
  begin
    semiPos := PosFrom(';', lower, usesPos);
    if semiPos>0 then
    begin
      checkPos := PosFrom(LowerCase(UnitName), lower, usesPos);
      if not ((checkPos>0) and (checkPos<semiPos)) then
        Insert(', ' + UnitName, Result, semiPos);
    end;
  end;
end;

function InjectRuntimeUsesEverywhere(const InTxt: string): string;
var
  lower: string;
  implPos: SizeInt;
begin
  Result := InTxt;
  lower := LowerCase(Result);
  // 1) Ensure interface-level uses includes runtime (if there is a top-level uses)
  Result := EnsureUnitInUsesList(Result, GHostUnitName, 1);

  // 2) Ensure implementation-level uses includes runtime
  implPos := Pos('implementation', lower);
  if implPos>0 then
    Result := EnsureUnitInUsesList(Result, GHostUnitName, implPos + Length('implementation'));
end;
procedure PostProcessWrittenPas(const APath: string);
var
  txt: string;
begin
  if NEVER_TOUCH_PROGRAMS and IsProgramOrLibraryFile(APath) then Exit;
  if (ExtractFileExt(APath) <> '.pas') then Exit;
  txt := LoadFileToString(APath);
  if txt = '' then Exit;
  txt := FixDanglingConcats(txt);
  txt := CastAPICalls(txt);
  txt := BalanceParensPerStatement(txt);
  txt := ForcePCharOnAPI(txt);
  txt := InjectRuntimeUsesEverywhere(txt);
  SaveStringToFile(APath, txt);
end;

function BalanceParensPerStatement(const S: string): string;
var
  i, L, depth: Integer;
  res: string;
  inStr, inLC, inPC: Boolean; // string, { } comment, (* *) comment
begin
  res := '';
  L := Length(S);
  depth := 0;
  inStr := False;
  inLC := False;
  inPC := False;
  i := 1;
  while i <= L do
  begin
    if not inStr then
    begin
      // line comments //
      if (S[i] = '/') and (i < L) and (S[i+1] = '/') and (not inLC) and (not inPC) then
      begin
        // copy until newline
        while (i <= L) and (S[i] <> #10) do
        begin
          res := res + S[i];
          Inc(i);
        end;
        Continue;
      end;
      // block comment { ... }
      if (S[i] = '{') and (not inPC) then
      begin
        inLC := True;
        res := res + S[i];
        Inc(i);
        Continue;
      end
      else if inLC then
      begin
        res := res + S[i];
        if S[i] = '}' then inLC := False;
        Inc(i);
        Continue;
      end;
      // block comment (* ... *)
      if (S[i] = '(') and (i < L) and (S[i+1] = '*') and (not inLC) then
      begin
        inPC := True;
        res := res + '(*';
        Inc(i,2);
        Continue;
      end
      else if inPC then
      begin
        res := res + S[i];
        if (S[i] = '*') and (i < L) and (S[i+1] = ')') then
        begin
          res := res + ')';
          Inc(i,2);
          inPC := False;
          Continue;
        end
        else
        begin
          Inc(i);
          Continue;
        end;
      end;

      if S[i] = '''' then
      begin
        inStr := True;
        res := res + S[i];
        Inc(i);
        Continue;
      end;

      if S[i] = '(' then
      begin
        Inc(depth);
        res := res + S[i];
        Inc(i);
        Continue;
      end
      else if S[i] = ')' then
      begin
        if depth > 0 then Dec(depth);
        res := res + S[i];
        Inc(i);
        Continue;
      end
      else if (S[i] = ';') and (depth > 0) then
      begin
        // close any unbalanced '(' before the end of statement
        res := res + StringOfChar(')', depth) + ';';
        depth := 0;
        Inc(i);
        Continue;
      end;
    end
    else // inStr
    begin
      res := res + S[i];
      if S[i] = '''' then
      begin
        if (i < L) and (S[i+1] = '''') then
        begin
          res := res + S[i+1];
          Inc(i,2);
          Continue;
        end
        else
          inStr := False;
      end;
      Inc(i);
      Continue;
    end;

    res := res + S[i];
    Inc(i);
  end;
  Result := res;
end;


function CastAPICalls(const S: string): string;
var
  i, L, depth, argStart, argEnd: Integer;
  res: string;
  inStr, inLC, inPC: Boolean;
  function AheadMatches(const kw: string): Boolean;
  var j: Integer;
  begin
    if i+Length(kw)-1 > L then exit(False);
    for j := 1 to Length(kw) do
      if LowerCase(S[i+j-1])<>LowerCase(kw[j]) then exit(False);
    Result := True;
  end;
  function IsIdentChar(c: Char): Boolean;
  begin
    Result := (c in ['A'..'Z','a'..'z','0'..'9','_']);
  end;
  procedure AppendChar(ch: Char);
  begin
    res := res + ch;
  end;
  procedure AppendStr(const str: string);
  begin
    res := res + str;
  end;
  // Find matching ')' at same call depth
  function FindMatchingParen(startPos: Integer): Integer;
  var d: Integer;
      k: Integer;
      sInStr, sInLC, sInPC: Boolean;
  begin
    d := 0;
    Result := -1;
    sInStr := False; sInLC := False; sInPC := False;
    k := startPos;
    while k <= L do
    begin
      if not sInStr then
      begin
        if (k<L) and (S[k]='/') and (S[k+1]='/') and (not sInLC) and (not sInPC) then
        begin
          while (k<=L) and (S[k]<>#10) do Inc(k);
          Continue;
        end;
        if (S[k]='{') and (not sInPC) then
        begin
          sInLC := True; Inc(k); Continue;
        end
        else if sInLC then
        begin
          if S[k]='}' then sInLC := False;
          Inc(k); Continue;
        end;
        if (k<L) and (S[k]='(') and (S[k+1]='*') and (not sInLC) then
        begin
          sInPC := True; Inc(k,2); Continue;
        end
        else if sInPC then
        begin
          if (S[k]='*') and (k<L) and (S[k+1]=')') then
          begin Inc(k,2); sInPC := False; Continue; end
          else begin Inc(k); Continue; end;
        end;
        if S[k]='''' then begin sInStr := True; Inc(k); Continue; end;
        if S[k]='(' then Inc(d)
        else if S[k]=')' then
        begin
          if d=0 then begin Result := k; exit; end;
          Dec(d);
        end;
      end
      else
      begin
        if S[k]='''' then
        begin
          if (k<L) and (S[k+1]='''') then Inc(k,2) else begin sInStr:=False; Inc(k); end;
          Continue;
        end;
      end;
      Inc(k);
    end;
  end;
  // Find start and end (exclusive) of second arg inside call at '('
  procedure SecondArgBounds(openParenPos: Integer; out aStart, aEnd: Integer);
  var d,k: Integer; comma1Pos: Integer;
      sInStr, sInLC, sInPC: Boolean;
  begin
    aStart := -1; aEnd := -1;
    d := 0; comma1Pos := -1;
    k := openParenPos+1;
    sInStr := False; sInLC := False; sInPC := False;
    while k <= L do
    begin
      if not sInStr then
      begin
        if (k<L) and (S[k]='/') and (S[k+1]='/') and (not sInLC) and (not sInPC) then
        begin while (k<=L) and (S[k]<>#10) do Inc(k); Continue; end;
        if (S[k]='{') and (not sInPC) then begin sInLC := True; Inc(k); Continue; end
        else if sInLC then begin if S[k]='}' then sInLC := False; Inc(k); Continue; end;
        if (k<L) and (S[k]='(') and (S[k+1]='*') and (not sInLC) then begin sInPC := True; Inc(k,2); Continue; end
        else if sInPC then begin if (S[k]='*') and (k<L) and (S[k+1]=')') then begin Inc(k,2); sInPC := False; Continue; end else begin Inc(k); Continue; end; end;

        if S[k]='''' then begin sInStr := True; Inc(k); Continue; end;

        if S[k]='(' then Inc(d)
        else if S[k]=')' then
        begin
          if d=0 then
          begin
            if (comma1Pos<>-1) and (aStart<>-1) and (aEnd=-1) then aEnd := k;
            exit;
          end;
          Dec(d);
        end
        else if (S[k]=',') and (d=0) then
        begin
          if comma1Pos=-1 then
          begin
            comma1Pos := k;
            // second arg starts after comma and whitespace
            aStart := k+1;
            while (aStart<=L) and (S[aStart] in [#9,#10,#13,' ']) do Inc(aStart);
          end
          else if (comma1Pos<>-1) and (aEnd=-1) then
          begin
            aEnd := k;
            exit;
          end;
        end;
      end
      else
      begin
        if S[k]='''' then
        begin
          if (k<L) and (S[k+1]='''') then Inc(k,2) else begin sInStr:=False; Inc(k); end;
          Continue;
        end;
      end;
      Inc(k);
    end;
  end;
begin
  res := '';
  L := Length(S);
  i := 1;
  inStr := False; inLC := False; inPC := False;
  depth := 0;
  while i <= L do
  begin
    if not inStr then
    begin
      // line comments
      if (i<L) and (S[i]='/') and (S[i+1]='/') and (not inLC) and (not inPC) then
      begin
        while (i<=L) and (S[i]<>#10) do begin AppendChar(S[i]); Inc(i); end;
        Continue;
      end;
      // { } comments
      if (S[i]='{') and (not inPC) then
      begin
        inLC := True; AppendChar(S[i]); Inc(i); Continue;
      end
      else if inLC then
      begin
        AppendChar(S[i]);
        if S[i]='}' then inLC := False;
        Inc(i); Continue;
      end;
      // (* *) comments
      if (i<L) and (S[i]='(') and (S[i+1]='*') and (not inLC) then
      begin
        inPC := True; AppendStr('(*'); Inc(i,2); Continue;
      end
      else if inPC then
      begin
        AppendChar(S[i]);
        if (S[i]='*') and (i<L) and (S[i+1]=')') then
        begin AppendChar(')'); Inc(i,2); inPC := False; Continue; end
        else begin Inc(i); Continue; end;
      end;

      if S[i]='''' then begin inStr := True; AppendChar(S[i]); Inc(i); Continue; end;

      // Detect LoadLibrary(
      if AheadMatches('LoadLibrary') then
      begin
        // ensure not part of a longer identifier
        if ((i=1) or (not IsIdentChar(S[i-1]))) and ((i+12>L) or (not IsIdentChar(S[i+12]))) then
        begin
          AppendStr(Copy(S, i, 12)); // 'LoadLibrary'
          Inc(i,12);
          // expect '('
          if (i<=L) and (S[i]='(') then
          begin
            AppendChar('(');
            Inc(i);
            // Insert PChar(
            AppendStr('PChar(');
            // copy until matching ')' of the call, but we need to find it
            argEnd := FindMatchingParen(i);
            if argEnd<>-1 then
            begin
              AppendStr(Copy(S, i, argEnd - i)); // the original single arg
              AppendChar(')'); // close PChar(
              AppendChar(')'); // close LoadLibrary(
              i := argEnd + 1;
              Continue;
            end;
          end;
        end;
      end;

      // Detect GetProcAddress(
      if AheadMatches('GetProcAddress') then
      begin
        if ((i=1) or (not IsIdentChar(S[i-1]))) and ((i+14>L) or (not IsIdentChar(S[i+14]))) then
        begin
          AppendStr(Copy(S, i, 14)); // 'GetProcAddress'
          Inc(i,14);
          if (i<=L) and (S[i]='(') then
          begin
            // Copy '('
            AppendChar('(');
            Inc(i);
            // We will copy the whole call then wrap the second arg
            // Find matching ')'
            argEnd := FindMatchingParen(i);
            if argEnd<>-1 then
            begin
              // Within i..argEnd-1, find bounds of second arg
              SecondArgBounds(i-1, argStart, argEnd); // we overloaded argEnd reuse; careful
              // argStart/argEnd are relative to S, not to res
              if (argStart<>-1) and (argEnd<>-1) then
              begin
                // copy first part up to second arg start
                AppendStr(Copy(S, i, argStart - i));
                // If the second arg already starts with PChar(, just copy it
                if AheadMatches('PChar(') and False then ; // keep compiler happy
                if (LowerCase(Copy(S, argStart, 6))='pchar(') then
                begin
                  AppendStr(Copy(S, argStart, argEnd - argStart));
                end
                else
                begin
                  AppendStr('PChar(');
                  AppendStr(Copy(S, argStart, argEnd - argStart));
                  AppendChar(')');
                end;
                // Copy the rest up to the closing ')'
                i := argEnd;
                // Copy any remaining chars inside the call until we hit the original ')'
                // First find the true close again
                depth := 0;
                while (i<=L) and (S[i]<>')') do
                begin
                  AppendChar(S[i]);
                  Inc(i);
                end;
                if (i<=L) and (S[i]=')') then
                begin
                  AppendChar(')'); Inc(i);
                  Continue;
                end;
              end;
            end;
          end;
        end;
      end;
    end
    else
    begin
      AppendChar(S[i]);
      if S[i]='''' then
      begin
        if (i<L) and (S[i+1]='''') then begin AppendChar(S[i+1]); Inc(i,2); Continue; end
        else inStr := False;
      end;
      Inc(i);
      Continue;
    end;


      // Detect OutputDebugString(
      if AheadMatches('OutputDebugString') then
      begin
        if ((i=1) or (not IsIdentChar(S[i-1]))) and ((i+17>L) or (not IsIdentChar(S[i+17]))) then
        begin
          AppendStr(Copy(S, i, 17)); // 'OutputDebugString'
          Inc(i,17);
          if (i<=L) and (S[i]='(') then
          begin
            AppendChar('(');
            Inc(i);
            // Wrap the whole single argument with PChar(...)
            argEnd := FindMatchingParen(i);
            if argEnd<>-1 then
            begin
              AppendStr('PChar(');
              AppendStr(Copy(S, i, argEnd - i));
              AppendChar(')'); // close PChar
              AppendChar(')'); // close OutputDebugString
              i := argEnd + 1;
              Continue;
            end;
          end;
        end;
      end;

    // default copy
    AppendChar(S[i]);
    Inc(i);
  end;
  Result := res;
end;

procedure RewritePasFile(const InPath: string; const OutPath: string;
                         MapOrig, MapNew: TStrings);
var
  Content: string;
  SS: TStringList;
  Tokens: TTokenArray;
  Count, i, j, parenIdx, k, interfaceIdx, programLineEnd, usesPos: Integer;
  outBuf, repl, rawString, actualString, prevIdent, lcText, replacement: string;
  stringWasEncrypted, needsPWideChar, isExternalDecl, isConcatenated: Boolean;
  IsProgramFile: Boolean;
begin
  if GOnlyGUI then
  begin
    // GUI-only mode: do not touch PAS/LPR. Copy input to output.
    if InPath <> OutPath then CopyFile(PChar(InPath), PChar(OutPath), False);
    Exit;
  end;
  outBuf := '';
  if NEVER_TOUCH_PROGRAMS and IsProgramOrLibraryFile(InPath) then
  begin
    if InPath <> OutPath then CopyFile(PChar(InPath), PChar(OutPath), False);
    Exit;
  end;

  // Skip BetterControls component sources entirely (they're compiler-sensitive)
  if (Pos('\bettercontrols\', LowerCase(InPath))>0) or (Pos('/bettercontrols/', LowerCase(InPath))>0) then
  begin
    if InPath <> OutPath then
      CopyFile(PChar(InPath), PChar(OutPath), False);
    Exit;
  end;


  // *** WORKAROUND: Skip cheatengine.lpr to avoid compilation errors ***
  if AnsiSameText(ExtractFileName(InPath), 'cheatengine.lpr') then
  begin
    WriteLn('Skipping cheatengine.lpr...');
    if InPath <> OutPath then
      CopyFile(PChar(InPath), PChar(OutPath), False);
    Exit;
  end;
  // *** END WORKAROUND ***

  if SameText(ExtractFileName(InPath), 'LuaSyntax.pas') then
  begin
    if InPath <> OutPath then
      CopyFile(PChar(InPath), PChar(OutPath), False);
    Exit;
  end;

  // Use TStringList to handle file content to better respect original line endings
  SS := TStringList.Create;
  try
    SS.LoadFromFile(InPath);
    Content := SS.Text;
    IsProgramFile := (Pos('unit', LowerCase(Content)) = 0) and (Pos('program', LowerCase(Content)) > 0);

    if SKIP_BETTERCONTROLS then
    begin
      if (Pos('\\bettercontrols\\', LowerCase(InPath))>0) or
         (Pos('/bettercontrols/', LowerCase(InPath))>0) then
      begin
        if InPath <> OutPath then
    // Final cleanup: if this is a program (.lpr), remove any stray 'interface' lines
    if IsProgramFile then
    begin
      outBuf := StringReplace(outBuf, LineEnding + 'interface' + LineEnding, LineEnding, [rfReplaceAll, rfIgnoreCase]);
      // also handle potential Windows vs Unix endings
      outBuf := StringReplace(outBuf, #13#10 + 'interface' + #13#10, #13#10, [rfReplaceAll, rfIgnoreCase]);
      outBuf := StringReplace(outBuf, #10 + 'interface' + #10, #10, [rfReplaceAll, rfIgnoreCase]);
    end;

SS.SaveToFile(OutPath);
        Exit;
      end;
    end;

    if SKIP_DBK32 then
    begin
      if (Pos('\\dbk32\\', LowerCase(InPath))>0) or
         (Pos('/dbk32/', LowerCase(InPath))>0) then
      begin
        if InPath <> OutPath then SS.SaveToFile(OutPath);
        Exit;
      end;
    end;

    if AnsiSameText(ExtractFileName(InPath), 'LuaSyntax.pas') or
       AnsiSameText(ExtractFileName(InPath), 'mikmod.pas') or
       AnsiSameText(ExtractFileName(InPath), 'betterdllsearchpath.pas') then
    begin
      if InPath <> OutPath then SS.SaveToFile(OutPath);
      Exit;
    end;
    if (Pos('unit luasyntax', LowerCase(Content)) > 0) or
       (Pos('unit mikmod', LowerCase(Content)) > 0) or
       (Pos('unit betterdllsearchpath', LowerCase(Content)) > 0) then
    begin
      if InPath <> OutPath then SS.SaveToFile(OutPath);
      Exit;
    end;

    if LowerCase(ExtractFileName(InPath)) = 'luasyntax.pas' then
    begin
      if InPath <> OutPath then SS.SaveToFile(OutPath);
      Exit;
    end;

    if Pos('unit luasyntax', LowerCase(Content)) > 0 then
    begin
      if InPath <> OutPath then SS.SaveToFile(OutPath);
      Exit;
    end;

    LexFile(Content, Tokens, Count);
    stringWasEncrypted := False;
    for i := 0 to Count - 1 do
    begin
      if IsProgramFile and (Tokens[i].Kind = tkIdent) and (LowerCase(Tokens[i].Text) = 'interface') then begin Continue; end;
      if Tokens[i].Kind = tkString then
      begin
        rawString := Tokens[i].Text;
        if (Length(rawString) > 2) and (rawString[1] = '''') and (not Tokens[i].InConstBlock) then
        begin
          actualString := StringReplace(Copy(rawString, 2, Length(rawString) - 2), '''''', '''', [rfReplaceAll]);
          if (Length(actualString) > 1) and not ((Length(actualString) > 2) and (actualString[1] = '{') and (actualString[Length(actualString)] = '}')) then
          begin
            stringWasEncrypted := True;
            break;
          end;
        end;
      end;
    end;

    if not stringWasEncrypted then
    begin
      if InPath <> OutPath then SS.SaveToFile(OutPath);
      Exit;
    end;

    // Check if our host unit is already used in this file
    if Pos(LowerCase(GHostUnitName), LowerCase(Content)) = 0 then
    begin
      // It's a PROGRAM file (.lpr)
      if IsProgramFile then
      begin
        usesPos := Pos('uses', LowerCase(Content));
        // Found an existing 'uses' clause
        if usesPos > 0 then
        begin
          Insert(' ' + GHostUnitName + ', ', Content, usesPos + Length('uses'));
        end
        // No 'uses' clause, so create one after 'program ...;'
        else
        begin
          programLineEnd := Pos(';', LowerCase(Content));
          if programLineEnd > 0 then
            Insert(#13#10 + 'uses ' + GHostUnitName + ';' + #13#10, Content, programLineEnd + 1);
        end;
      end
      // It's a UNIT file (.pas)
      else
      begin
        interfaceIdx := Pos('interface', LowerCase(Content));
        if interfaceIdx > 0 then
        begin
          usesPos := Pos('uses', Copy(LowerCase(Content), interfaceIdx, MaxInt));
          // Found 'uses' in the interface section
          if (usesPos > 0) and (Pos('implementation', Copy(LowerCase(Content), interfaceIdx, MaxInt)) > usesPos) then
          begin
            Insert(' ' + GHostUnitName + ', ', Content, interfaceIdx + usesPos - 1 + Length('uses'));
          end
          // No 'uses' in interface section, so add it
          else
          begin
            Insert(#13#10 + 'uses ' + GHostUnitName + ';' + #13#10, Content, interfaceIdx + Length('interface'));
          end;
        end
        // This part is for units that might not have an interface section, less common
        else
        begin
          usesPos := Pos('uses', LowerCase(Content));
          if usesPos > 0 then
          begin
            Insert(' ' + GHostUnitName + ', ', Content, usesPos + Length('uses'));
          end
          else
          begin
            programLineEnd := Pos(';', LowerCase(Content));
            if programLineEnd > 0 then
              Insert(#13#10 + 'uses ' + GHostUnitName + ';' + #13#10, Content, programLineEnd + 1);
          end;
        end;
      end;
    end;

    LexFile(Content, Tokens, Count);

    outBuf := '';
    for i := 0 to Count - 1 do
    begin
      if IsProgramFile and (Tokens[i].Kind = tkIdent) and (LowerCase(Tokens[i].Text) = 'interface') then begin Continue; end;
      case Tokens[i].Kind of
        tkIdent:
        begin
          repl := Tokens[i].Text;
          if LookupNewName(LowerCase(Tokens[i].Text), MapOrig, MapNew, repl) then
            outBuf := outBuf + repl
          else
            outBuf := outBuf + Tokens[i].Text;
        end;
        tkString:
        begin
          rawString := Tokens[i].Text;
          if rawString = '''%%XOR_KEY%%''' then
          begin
            outBuf := outBuf + '''' + StringReplace(GXorKey, '''', '''''', [rfReplaceAll]) + '''';
          end
          else if (Length(rawString) > 2) and (rawString[1] = '''') and (not Tokens[i].InConstBlock) then
          begin
            actualString := StringReplace(Copy(rawString, 2, Length(rawString) - 2), '''''', '''', [rfReplaceAll]);

            isExternalDecl := False;
            j := i - 1;
            while j >= 0 do
            begin
              if Tokens[j].Kind in [tkWhitespace, tkComment] then
              begin
                Dec(j);
                continue;
              end;
              if Tokens[j].Kind = tkIdent then
              begin
                lcText := LowerCase(Tokens[j].Text);
                if (lcText = 'external') or (lcText = 'name') then
                  isExternalDecl := True;
              end;
              break;
            end;

            if (Length(actualString) > 1) and not isExternalDecl and not IsCaseLabel(Tokens, i)
              and not ((Length(actualString) > 2) and (actualString[1] = '{') and (actualString[Length(actualString)] = '}')) then
            begin
              replacement := GXorStrFuncName + '(' + EncryptStringForPascal(actualString, GXorKey) + ')';

              isConcatenated := False;
              k := i - 1;
              while (k >= 0) and (Tokens[k].Kind in [tkWhitespace, tkComment]) do Dec(k);
              if (k >= 0) and (Tokens[k].Kind = tkSymbol) and (Tokens[k].Text = '+') then
                isConcatenated := True;

              if not isConcatenated then
              begin
                k := i + 1;
                while (k < Count) and (Tokens[k].Kind in [tkWhitespace, tkComment]) do Inc(k);
                if (k < Count) and (Tokens[k].Kind = tkSymbol) and (Tokens[k].Text = '+') then
                  isConcatenated := True;
              end;

              if not isConcatenated then
              begin
                parenIdx := -1;
                prevIdent := '';
                for j := i - 1 downto 0 do
                begin
                  if Tokens[j].Kind = tkSymbol then
                  begin
                    if Tokens[j].Text = '(' then
                    begin
                      parenIdx := j;
                      break;
                    end;
                    if (Tokens[j].Text = ';') or (Tokens[j].Text = ':=') or (Tokens[j].Text = '=') then break;
                  end;
                end;

                if parenIdx > 0 then
                begin
                  for j := parenIdx - 1 downto 0 do
                  begin
                    if Tokens[j].Kind in [tkWhitespace, tkComment] then continue;
                    if Tokens[j].Kind = tkIdent then
                      prevIdent := LowerCase(Tokens[j].Text);
                    break;
                  end;

                  needsPWideChar := (Length(prevIdent) > 0) and (LowerCase(prevIdent[Length(prevIdent)]) = 'w');
                  if needsPWideChar then
                    replacement := 'PWideChar(' + replacement + ')'
                  else
                    replacement := 'PAnsiChar(' + replacement + ')';
                end;
              end;

              outBuf := outBuf + replacement;
            end
            else
              outBuf := outBuf + Tokens[i].Text;
          end else
            outBuf := outBuf + Tokens[i].Text;
        end;
      else
        outBuf := outBuf + Tokens[i].Text;
      end;
    end;

    SS.Text := outBuf;
    SS.SaveToFile(OutPath);

  finally
    SS.Free;
  end;

  if ENABLE_POSTPROCESS then
    PostProcessWrittenPas(OutPath);
end;

function GenName(Len: Integer): string;
var
  i: Integer;
begin
  if Len < 1 then Len := 8;
  Result := Chr(Ord('a') + Random(26));
  for i := 2 to Len do
    Result := Result + Chr(Ord('a') + Random(26));
end;

function GenRandomColor: string;
begin
  Result := '$' + IntToHex(Random($FFFFFF), 8);
end;

procedure RewriteLfmFile(const InLfmPath, OutLfmPath: string; MapOrig, MapNew: TStrings);
var
  Lfm, OutLfm: TStringList;
  i: Integer;
  line, trimmedLine, key, value, newName, origName, newCaption: string;
  inIconData: Boolean;
begin
  if not FileExists(InLfmPath) then Exit;

  Lfm := TStringList.Create;
  OutLfm := TStringList.Create;
  try
    Lfm.LoadFromFile(InLfmPath);

    inIconData := False;
    for i := 0 to Lfm.Count - 1 do
    begin
      line := Lfm[i];
      trimmedLine := Trim(line);

      if StartsText('Icon.Data', trimmedLine) then
      begin
        inIconData := True;
        Continue;
      end;
      if inIconData then
      begin
        if StartsText('}', trimmedLine) then
          inIconData := False;
        Continue;
      end;

      if StartsText('object ', LowerCase(trimmedLine)) then
      begin
        key := copy(trimmedLine, 8, Length(trimmedLine));
        if Pos(':', key) > 0 then
        begin
            origName := Copy(key, 1, Pos(':', key) - 1);
            if LookupNewName(LowerCase(origName), MapOrig, MapNew, newName) then
                line := StringReplace(line, origName + ':', newName + ':', [rfIgnoreCase]);
        end;
      end
      else
      begin
        if StartsText('Caption =', trimmedLine) then
        begin
          value := Trim(Copy(trimmedLine, Pos('=', trimmedLine) + 1, MaxInt));
          if (Length(value) > 2) and (value[1] = '''') and (value[Length(value)] = '''') then
          begin
            newCaption := GenName(Random(6) + 3);
            line := Copy(line, 1, Pos('=', line)) + ' ''' + newCaption + '''';
          end;
        end
        else if StartsText('Color =', trimmedLine) then
        begin
          line := Copy(line, 1, Pos('=', line)) + ' ' + GenRandomColor;
        end
        else if StartsText('Font.Color =', trimmedLine) then
        begin
          line := Copy(line, 1, Pos('=', line)) + ' ' + GenRandomColor;
        end
        else if StartsText('Font.Size =', trimmedLine) then
        begin
          line := Copy(line, 1, Pos('=', line)) + ' ' + IntToStr(Random(6) + 8);
        end;
      end;
      OutLfm.Add(line);
    end;

    OutLfm.SaveToFile(OutLfmPath);
  finally
    Lfm.Free;
    OutLfm.Free;
  end;
end;

procedure CreateHostUnit(const AFileName: string);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    sl.Add('unit ' + GHostUnitName + ';');
    sl.Add('');
    sl.Add('{$mode objfpc}{$H+}');
    sl.Add('');
    sl.Add('interface');
    sl.Add('');
    sl.Add('function ' + GXorStrFuncName + '(const s: array of Byte): string;');
    sl.Add('');
    sl.Add('implementation');
    sl.Add('');
    sl.Add(GPolymorphicFuncCode);
    sl.Add('');
    sl.Add('end.');
    sl.SaveToFile(AFileName);
  finally
    sl.Free;
  end;
end;

procedure AddUnitToProject(const AProjectFile, AUnitPath: string);
var
  LPI, NewLPI: TStringList;
  i: integer;
  UnitFileName, RelativeUnitPath: string;
  ClosingTagLine: integer;
begin
  if not FileExists(AProjectFile) then
  begin
    WriteLn('WARNING: Could not find project file to update: ', AProjectFile);
    Exit;
  end;

  LPI := TStringList.Create;
  NewLPI := TStringList.Create;
  try
    LPI.LoadFromFile(AProjectFile);
    UnitFileName := ExtractFileName(AUnitPath);

    for i := 0 to LPI.Count - 1 do
    begin
      if (Pos(UnitFileName, LPI[i]) > 0) and (Pos('<Filename Value="', LPI[i]) > 0) then
      begin
        WriteLn('INFO: Host unit is already part of the project file.');
        Exit;
      end;
    end;

    RelativeUnitPath := ExtractRelativePath(ExtractFilePath(AProjectFile), AUnitPath);

    ClosingTagLine := -1;
    for i := LPI.Count - 1 downto 0 do
    begin
      if Pos('</ProjectUnits>', Trim(LPI[i])) > 0 then
      begin
        ClosingTagLine := i;
        break;
      end;
    end;

    if ClosingTagLine = -1 then
    begin
      WriteLn('WARNING: Could not find </ProjectUnits> tag in ', AProjectFile);
      Exit;
    end;

    for i := 0 to ClosingTagLine - 1 do
      NewLPI.Add(LPI[i]);

    NewLPI.Add('    <Unit>' +
      '<Filename Value="' + RelativeUnitPath + '"/>' +
      '<IsPartOfProject Value="True"/>' +
    '</Unit>');

    for i := ClosingTagLine to LPI.Count - 1 do
      NewLPI.Add(LPI[i]);

    NewLPI.SaveToFile(AProjectFile);
    WriteLn('SUCCESS: Added ', UnitFileName, ' to ', ExtractFileName(AProjectFile));

  finally
    LPI.Free;
    NewLPI.Free;
  end;
end;

procedure RewriteAll(const Files: TStrings; Inplace: Boolean; MapOrig, MapNew: TStrings);
var
  f: Integer;
  pasPath, pasOutPath, lfmPath, lfmOutPath, pasBakPath, lfmBakPath, LpiPath: string;
begin
  if Files.Count = 0 then Exit;

  if not GOnlyGUI then
  begin
    if not GOnlyGUI then
  begin
    GHostUnitName := 'obf_runtime';
    GHostUnitFileName := IncludeTrailingPathDelimiter(GRoot) + GHostUnitName + '.pas';
    WriteLn('Creating dedicated host unit: ', GHostUnitFileName);
    CreateHostUnit(GHostUnitFileName);

    LpiPath := ChangeFileExt(GRoot, '.lpi');
    if not FileExists(LpiPath) then
      LpiPath := IncludeTrailingPathDelimiter(GRoot) + 'cheatengine.lpi';

    AddUnitToProject(LpiPath, GHostUnitFileName);
  end;
end;
for f := 0 to Files.Count - 1 do
  begin
    pasPath := Files[f];
    if AnsiSameText(ExtractFileName(pasPath), ExtractFileName(GHostUnitFileName)) then
      Continue;

    lfmPath := ChangeFileExt(pasPath, '.lfm');
    if Inplace then
    begin
      pasOutPath := pasPath;
      lfmOutPath := lfmPath;
      pasBakPath := pasPath + '.bak';
      lfmBakPath := lfmPath + '.bak';
      if not GOnlyGUI then begin if FileExists(pasBakPath) then SysUtils.DeleteFile(pasBakPath); end;
      if not GOnlyGUI then begin if not SysUtils.RenameFile(pasPath, pasBakPath) then raise Exception.Create('Failed to backup ' + pasPath); end;
      if FileExists(lfmPath) then
      begin
        if FileExists(lfmBakPath) then SysUtils.DeleteFile(lfmBakPath);
        if not SysUtils.RenameFile(lfmPath, lfmBakPath) then
        begin
          SysUtils.RenameFile(pasBakPath, pasPath);
          raise Exception.Create('Failed to backup ' + lfmPath);
        end;
      end;
      try
        if FileExists(lfmBakPath) then
        begin
          WriteLn('Rewriting LFM: ', ExtractFileName(lfmPath));
          RewriteLfmFile(lfmBakPath, lfmOutPath, MapOrig, MapNew);
        end;
        if not GOnlyGUI then WriteLn('Rewriting PAS: ', ExtractFileName(pasPath));
        if not GOnlyGUI then RewritePasFile(pasBakPath, pasOutPath, MapOrig, MapNew);
        SysUtils.DeleteFile(pasBakPath);
        if FileExists(lfmBakPath) then SysUtils.DeleteFile(lfmBakPath);
      except
        on E: Exception do
        begin
          WriteLn('ERROR rewriting ', ExtractFileName(pasPath), ': ', E.Message);
          if (not GOnlyGUI) and FileExists(pasBakPath) then
          begin
            if FileExists(pasPath) then SysUtils.DeleteFile(pasPath);
            SysUtils.RenameFile(pasBakPath, pasPath);
          end;
          if FileExists(lfmBakPath) then
          begin
            if FileExists(lfmPath) then SysUtils.DeleteFile(lfmPath);
            SysUtils.RenameFile(lfmBakPath, lfmPath);
          end;
          raise;
        end;
      end;
    end
    else
    begin
      pasOutPath := ChangeFileExt(pasPath, '.obf' + ExtractFileExt(pasPath));
      lfmOutPath := ChangeFileExt(pasOutPath, '.lfm');
      if FileExists(lfmPath) then
      begin
          WriteLn('Rewriting LFM: ', ExtractFileName(lfmPath));
          RewriteLfmFile(lfmPath, lfmOutPath, MapOrig, MapNew);
      end;
      if not GOnlyGUI then WriteLn('Rewriting ', ExtractFileName(pasPath), ' to ', ExtractFileName(pasOutPath));
      if not GOnlyGUI then RewritePasFile(pasPath, pasOutPath, MapOrig, MapNew);
    end;
  end;
end;

procedure ParseArgs;
var
  i: Integer;
  a, v: string;
begin
  for i := 1 to ParamCount do
  begin
    a := ParamStr(i);
    if AnsiStartsText('--root=', a) then
      GRoot := Copy(a, 8, MaxInt)
    else if AnsiSameText(a, '--inplace') then
      GInplace := True
    else if AnsiSameText(a, '--only-gui') then
      GOnlyGUI := True
    else if AnsiStartsText('--seed=', a) then
    begin
      v := Copy(a, 8, MaxInt);
      try
        GSeed := StrToInt(v);
        GSeedGiven := True;
      except
        on E: Exception do
        begin
          WriteLn('Invalid --seed value: ', v);
          Halt(1);
        end;
      end;
    end
    else if (a='-h') or (a='--help') then
    begin
      WriteLn('PasObf - Pascal Obfuscator');
      WriteLn('  --root=PATH');
      WriteLn('  --inplace');
      WriteLn('  --seed=N');
      Halt(0);
    end;
  end;
  if GRoot = '' then
  begin
    WriteLn('Usage: PasObf --root=PATH [options]');
    Halt(1);
  end;
end;

function GeneratePolymorphicXorStr: string;
var
  funcName, keyVar, loopVar, junkVar: string;
  junkCode: string;
  sl: TStringList;
begin
  funcName := 'fn_obfstr';
  GXorStrFuncName := funcName;
  keyVar    := 'k_' + GenName(6);
  loopVar   := 'i_' + GenName(6);
  junkVar   := 'j_' + GenName(6);
  case Random(3) of
    0: junkCode := '      ' + junkVar + ' := ' + junkVar + ' + ' + loopVar + ' and $FF;';
    1: junkCode := '      ' + junkVar + ' := (' + junkVar + ' * 3) xor ' + loopVar + ';';
    2: junkCode := '      ' + junkVar + ' := ' + junkVar + ' - ' + loopVar + ';';
  end;
  sl := TStringList.Create;
  try
    sl.Add('function ' + funcName + '(const s: array of Byte): string;');
    sl.Add('const');
    sl.Add('  ' + keyVar + ' = ''%%XOR_KEY%%'';');
    sl.Add('var');
    sl.Add('  ' + loopVar + ', ' + junkVar + ': Integer;');
    sl.Add('begin');
    sl.Add('  ' + junkVar + ' := 0;');
    sl.Add('  SetLength(Result, Length(s));');
    sl.Add('  if Length(' + keyVar + ') = 0 then');
    sl.Add('  begin');
    sl.Add('    for ' + loopVar + ' := 0 to High(s) do Result[' + loopVar + '+1] := Chr(s['+ loopVar +']);');
    sl.Add('  end');
    sl.Add('  else');
    sl.Add('  begin');
    sl.Add('    for ' + loopVar + ' := 0 to High(s) do');
    sl.Add('    begin');
    sl.Add('      Result[' + loopVar + '+1] := Chr(s[' + loopVar + '] xor Ord(' + keyVar + '[(' + loopVar + ' mod Length(' + keyVar + ')) + 1]));');
    sl.Add(junkCode);
    sl.Add('    end;');
    sl.Add('  end;');
    sl.Add('end;');
    Result := sl.Text;
  finally
    sl.Free;
  end;
end;

procedure Main;
var
  Files: TStringList;
  MapOrig, MapNew: TStringList;
  Response: string;
  i: Integer;
begin
  InitKeywords;
  ParseArgs;
  if GSeedGiven then RandSeed := GSeed else Randomize;
  SetLength(GXorKey, 16);
  for i := 1 to Length(GXorKey) do
    GXorKey[i] := Chr(Random(94) + 33);
  GPolymorphicFuncCode := GeneratePolymorphicXorStr;
  if GInplace then
  begin
    WriteLn('WARNING: The --inplace flag will overwrite your files in place.');
    Write('Proceed? [y/N]: ');
    ReadLn(Response);
    if not (AnsiSameText(Response, 'y') or AnsiSameText(Response, 'yes')) then Halt(0);
  end;
  PublicNames  := TStrSet.Create;
  DeclaredHere := TStrSet.Create;
  SkipNames    := TStrSet.Create;
  Files := TStringList.Create;
  MapOrig := TStringList.Create;
  MapNew := TStringList.Create;
  try
    SplitExtPasFiles(GRoot, Files, True);
    if Files.Count = 0 then
    begin
      WriteLn('No .pas/.pp files found under ', GRoot);
      Halt(2);
    end;
    RewriteAll(Files, GInplace, MapOrig, MapNew);
    WriteLn('Done.');
    WriteLn('String literals were encrypted with key: ', GXorKey);
  finally
    PublicNames.Free;
    DeclaredHere.Free;
    SkipNames.Free;
    Files.Free;
    MapOrig.Free;
    MapNew.Free;
  end;
end;

begin
  Main;
end.