ctdaux.pas

Citadel v.1.6 Full Sources

unit ctdAux;

interface

{$INCLUDE ctdDefs.inc}

uses Windows, Classes, SysUtils;

const
  {$ifdef CtdDoTrial}
  CtdMajorVersionPos =  8;
  CtdMinorVersionPos = 10;
  {$else}
  {$ifndef CtdNoPack}
  CtdMajorVersionPos =  8;
  CtdMinorVersionPos = 10;
  {$else}
  CtdMajorVersionPos = 11;
  CtdMinorVersionPos = 13;
  {$endif CtdNoPack}
  {$endif CtdDoTrial}

  MaxPasSize = 1024 * 1024; // 1 MB max .pas size

type
  TCtdLogMode = (
    lmLogOnly,    // Only for log
    lmMain,       // Log to main
    lmSecondary); // Log to secondary
  TCtdLogModes = set of TCtdLogMode;

  {$ifndef CTD_NOHLP}
  TCtdConfig = record
    RmvReloc,
    Encrypt,
    Compress,
    Pack: Boolean;
    Password: AnsiString;
  end;
  {$endif CTD_NOHLP}

  {$ifndef CTD_NOHLP}
  procedure CtdReadConfig(Stream: TStream; var Config: TCtdConfig; Binary: Boolean);
  procedure CtdWriteConfig(Stream: TStream; Config: TCtdConfig);
  function  CtdReadSignature(const Signature: PAnsiChar;
    var IsPacked, IsCompressed, IsEncrypted: Boolean): Boolean;
  function  CtdWriteSignature(const Pack, Compress, Encrypt: Boolean): DWord;
  function  TrimSpaces(const Text: String; MaxSize: Integer): String;
  procedure ReadResConfig(const FileName, ResName: String; var Config: TCtdConfig);
  {$endif CTD_NOHLP}
  function CtdVersion: String;

implementation

procedure CtdReadConfig(Stream: TStream; var Config: TCtdConfig; Binary: Boolean);
var
  L,
  Dummy: Byte;
  SByte: array[0..1] of AnsiChar;
  HexByte: AnsiString;
  i: Integer;
begin
  if Binary
  then
  begin
    Stream.ReadBuffer(Dummy             , 1); // Major version
    Stream.ReadBuffer(Dummy             , 1); // Minor version
    Stream.ReadBuffer(Config.RmvReloc   , 1);
    Stream.ReadBuffer(Config.Encrypt    , 1);
    Stream.ReadBuffer(Config.Compress   , 1);
    Stream.ReadBuffer(Config.Pack       , 1);
    Stream.ReadBuffer(L                 , 1);
    SetLength(Config.Password, L);
    Stream.ReadBuffer(Config.Password[1], L);
  end
  else
  begin
    Stream.ReadBuffer(SByte, 2); // Major version
    Stream.ReadBuffer(SByte, 2); // Minor version
    Stream.ReadBuffer(SByte, 2);
    Config.RmvReloc := SByte = '01';
    Stream.ReadBuffer(SByte, 2);
    Config.Encrypt  := SByte = '01';
    Stream.ReadBuffer(SByte, 2);
    Config.Compress := SByte = '01';
    Stream.ReadBuffer(SByte, 2);
    Config.Pack     := SByte = '01';
    Stream.ReadBuffer(SByte, 2);
    HexByte := '$' + SByte;
    L := StrToInt(String(HexByte));
    SetLength(Config.Password, L);
    for i:=1 to L do
    begin
      Stream.ReadBuffer(SByte, 2);
      HexByte := '$' + SByte;
      Config.Password[i] := AnsiChar(StrToInt(String(HexByte)));
    end;
  end;
end;

procedure CtdWriteConfig(Stream: TStream; Config: TCtdConfig);
var
  L,
  aux: Byte;
begin
  aux := Ord(CtdVersion[CtdMajorVersionPos]);
  Stream.WriteBuffer(aux               , 1); // Major version
  aux := Ord(CtdVersion[CtdMinorVersionPos]);
  Stream.WriteBuffer(aux               , 1); // Minor version
  Stream.WriteBuffer(Config.RmvReloc   , 1);
  Stream.WriteBuffer(Config.Encrypt    , 1);
  Stream.WriteBuffer(Config.Compress   , 1);
  Stream.WriteBuffer(Config.Pack       , 1);
  L := Length(Config.Password);
  Stream.WriteBuffer(L                 , 1);
  Stream.WriteBuffer(Config.Password[1], L);
end;

function CtdReadSignature(const Signature: PAnsiChar;
  var IsPacked, IsCompressed, IsEncrypted: Boolean): Boolean;
begin
  Result :=
    (Signature[0] = 'T') and (Signature[1] = 'P') and (Signature[2] = 'F') and
    {$ifdef D12UP}CharInSet(Signature[3],{$else}(Signature[3] in{$endif D12UP}['0'..'9']);
  if Result
  then
  begin
    IsPacked     := {$ifdef D12UP}CharInSet(Signature[3],{$else}(Signature[3] in{$endif D12UP}['1', '3', '5', '7']);
    IsCompressed := {$ifdef D12UP}CharInSet(Signature[3],{$else}(Signature[3] in{$endif D12UP}['2', '3', '6', '7']);
    IsEncrypted  := {$ifdef D12UP}CharInSet(Signature[3],{$else}(Signature[3] in{$endif D12UP}['4', '5', '6', '7']);
  end
  else
  begin
    IsPacked     := False;
    IsCompressed := False;
    IsEncrypted  := False;
  end;
end;

function CtdWriteSignature(const Pack, Compress, Encrypt: Boolean): DWord;
var
  aux: array[0..3] of AnsiChar;
begin
  aux[0] := 'T';
  aux[1] := 'P';
  aux[2] := 'F';
  aux[3] := '0';
  if Pack then
    aux[3] := AnsiChar(Chr(Ord(aux[3]) + 1));
  if Compress then
    aux[3] := AnsiChar(Chr(Ord(aux[3]) + 2));
  if Encrypt then
    aux[3] := AnsiChar(Chr(Ord(aux[3]) + 4));
  Result := Dword(aux);
end;

function TrimSpaces(const Text: String; MaxSize: Integer): String;
var
  i,
  j: Integer;
begin
  j := 1;
  SetLength(Result, MaxSize);
  for i := 1 to Length(Text) do
  begin
    if not({$ifdef D12UP}CharInSet(Text[i],{$else}(Text[i] in{$endif D12UP}[' ', #9])) then
    begin
      Result[j] := Text[i];
      Inc(j);
      if j > MaxSize then
        break;
    end;
  end;
  SetLength(Result, j-1);
end;

procedure ReadResConfig(const FileName, ResName: String; var Config: TCtdConfig);
var
  WasPacked,
  WasCompressed,
  WasEncrypted: Boolean;
  StreamRes: TResourceStream;
  StrStream: TStringStream;
  Where: Integer;
  hExe: THandle;
  Data: String;
begin
  hExe := LoadLibraryEx(PChar(FileName), 0,
            DONT_RESOLVE_DLL_REFERENCES or LOAD_LIBRARY_AS_DATAFILE);
  if hExe = 0 then
    {$ifdef D6UP}RaiseLastOSError;{$else}RaiseLastWin32Error;{$endif D6UP}
  try
    StreamRes := TResourceStream.Create(hExe, ResName, RT_RCDATA);
    try
      if not CtdReadSignature(StreamRes.Memory, WasPacked, WasCompressed, WasEncrypted) then
        raise Exception.Create('Resource type unknown');
      if WasPacked or WasCompressed or WasEncrypted then
        raise Exception.Create('Can''t process the same executable again. Please compile it.');
//        SetString(Data, PChar(StreamRes.Memory), StreamRes.Size);
      StrStream := TStringStream.Create('');
      try
        ObjectBinaryToText(StreamRes, StrStream);
//        StrStream.CopyFrom(StreamRes, StreamRes.Size);
        Where := Pos('TCtdEngine', StrStream.DataString);
        if Where <> 0 then
        begin
          Data  := Copy(StrStream.DataString, Where, Length(StrStream.DataString)-Where+1);
          Where := Pos('CtdConfig', Data) + Where - 2;
        end;
        if Where = 0 then
          raise Exception.Create('Form ' + ResName + ' doesn''t contain a ''TCtdEngine'' component');

        StrStream.Position := Where + Length('CtdConfig') + 4;
        CtdReadConfig(StrStream, Config, False);
      finally
        StrStream.Free;
      end;
    finally
      StreamRes.Free;
    end;
  finally
    FreeLibrary(hExe);
  end;
end;

function CtdVersion: String;
begin
  Result := 'v1.6';
  {$ifdef CtdDoTrial}
  Result := 'Trial '    + Result;
  {$else}
  {$ifndef CtdNoCrypt}
  Result := 'Crypt '    + Result;
  {$else}
  Result := 'Compress ' + Result;
  {$endif CtdNoCrypt}
  {$endif CtdDoTrial}
end;

end.