Write Settings to Resources - RcDataHelper by testest

posted 4 Nov 2010, 17:17 by Delphi Basics   [ updated 4 Nov 2010, 17:21 ]
This delphi unit, written by testest, allows you to easily write and settings to and from the selected portable executable's resource section. Encryption is optional. 

unit RcDataHelper;
//Author: testest
interface

uses Windows;

{$DEFINE ENCRYPT}

type
  TRCWriter = class(TObject)
  private
    FBuffer: Pointer;
    FSize: Cardinal;
  public
    constructor Create;
    procedure WriteBuffer(const Source; const Count: Cardinal);
    procedure WriteInteger(const Value: Integer);
    procedure WriteCardinal(const Value: Cardinal);
    procedure WriteByte(const Value: Byte);
    procedure WriteChar(const Value: Char);
    procedure WriteBoolean(const Value: Boolean);
    procedure WriteString(const Value: String);
  {$IFDEF ENCRYPT}
    function SaveToFile(const FileName: String; Name: PChar; LangID: Word; PwdLen: Cardinal): Boolean;
  {$ELSE}
    function SaveToFile(const FileName: String; Name: PChar; LangID: Word): Boolean;
  {$ENDIF}
    destructor Destroy; override;
  end;

type
  TRCReader = class(TObject)
  private
    FBuffer: Pointer;
    FPos: Pointer;
    FSize: Cardinal;
    function GetPosition: Cardinal;
    procedure SetPosition(Pos: Cardinal);
    property Position: Cardinal read GetPosition write SetPosition;
  public
    constructor Create;
    function Load(Name: PChar; LangID: WORD): Boolean; overload;
    function Load(FileName: String; Name: PChar; LangID: WORD): Boolean; overload;
    function Load(Handle: THandle; Name: PChar; LangID: WORD): Boolean; overload;
    function ReadBuffer(var Dest; const Count: Cardinal): Cardinal;
    function ReadInteger: Integer;
    function ReadCardinal: Cardinal;
    function ReadByte: Byte;
    function ReadChar: Char;
    function ReadBoolean: Boolean;
    function ReadString: String;
    destructor Destroy; override;
  end;

implementation
{$IFDEF ENCRYPT}
{$ENDIF}

constructor TRCWriter.Create;
begin
  inherited;
  FBuffer := nil;
  FSize := 0;
end;

procedure TRCWriter.WriteBuffer(const Source; const Count: Cardinal);
var Size: Cardinal;
begin
  Size := FSize + Count;
  ReallocMem(FBuffer, Size);
  Move(Source, Pointer(Cardinal(FBuffer) + FSize)^, Count);
  FSize := Size;
end;

procedure TRCWriter.WriteInteger(const Value: Integer);
begin
  WriteBuffer(Value, SizeOf(Integer));
end;

procedure TRCWriter.WriteCardinal(const Value: Cardinal);
begin
  WriteBuffer(Value, SizeOf(Cardinal));
end;

procedure TRCWriter.WriteByte(const Value: Byte);
begin
  WriteBuffer(Value, 1);
end;

procedure TRCWriter.WriteChar(const Value: Char);
begin
  WriteByte(Ord(Value));
end;

procedure TRCWriter.WriteBoolean(const Value: Boolean);
begin
  WriteByte(Byte(Value));
end;

procedure TRCWriter.WriteString(const Value: String);
var Size: Cardinal;
begin
  Size := Length(Value);
  WriteCardinal(Size);
  WriteBuffer(Value[1], Size);
end;

{$IFDEF ENCRYPT}
function TRCWriter.SaveToFile(const FileName: String; Name: PChar;
                              LangID: Word; PwdLen: Cardinal): Boolean;
{$ELSE}
function TRCWriter.SaveToFile(const FileName: String; Name: PChar;
                              LangID: Word): Boolean;
{$ENDIF}
var
  H: THandle;
  Update: Boolean;
{$IFDEF ENCRYPT}
  Buffer: Pointer;
  Size: Cardinal;
{$ENDIF}
begin
  Result := False;
  H := BeginUpdateResource(PChar(FileName), False);
  if H <> 0 then
  begin
  {$IFDEF ENCRYPT}
    Size := Encrypt(FBuffer, Buffer, FSize, RandomPassword(PwdLen), ciXOR);
    Update := UpdateResource(H, RT_RCDATA, Name, LangID, Buffer, Size);
    FreeMem(Buffer, Size);
  {$ELSE}
    Update := UpdateResource(H, RT_RCDATA, Name, LangID, FBuffer, FSize);
  {$ENDIF}
    Result := Update and EndUpdateResource(H, not Update);
  end;
end;

destructor TRCWriter.Destroy;
begin
  FreeMem(FBuffer, FSize);
end;


constructor TRCReader.Create;
begin
  inherited;
  FBuffer := nil;
  FPos := nil;
  FSize := 0;
end;

function TRCReader.Load(Handle: THandle; Name: PChar; LangID: WORD): Boolean;
var
  HI: HRSRC;
  HD: HGLOBAL;
  P: Pointer;
  Size: Cardinal;
begin
  Result := False;
  FBuffer := nil;
  FPos := nil;
  FSize := 0;
  HI := FindResourceEx(Handle, RT_RCDATA, Name, LangID);
  if HI <> 0 then
  begin
    Size := SizeofResource(Handle, HI);
    HD := LoadResource(Handle, HI);
    if (Size > 0) and (HD <> 0) then
    begin
      P := LockResource(HD);
      if P <> nil then
      begin
      {$IFDEF ENCRYPT}
        FSize := Decrypt(P, FBuffer, Size);
      {$ELSE}
        GetMem(FBuffer, Size);
        Move(P^, FBuffer^, Size);
        FSize := Size;
      {$ENDIF}
        UnlockResource(HD);
        FreeResource(HD);
        FPos := FBuffer;
        Result := True;
      end;
    end;
  end;
end;

function TRCReader.Load(Name: PChar; LangID: WORD): Boolean;
begin
  Result := Load(HInstance, Name, LangID);
end;

function TRCReader.Load(FileName: String; Name: PChar; LangID: WORD): Boolean;
var H: THandle;
begin
  H := LoadLibrary(PChar(FileName));
  if H <> 0 then
  begin
    Result := Load(H, Name, LangID);
    FreeLibrary(H);
  end
  else
    Result := False;
end;

function TRCReader.GetPosition: Cardinal;
begin
  Result := Cardinal(FPos) - Cardinal(FBuffer);
end;

procedure TRCReader.SetPosition(Pos: Cardinal);
begin
  FPos := Pointer(Cardinal(FBuffer) + Pos);
end;

function TRCReader.ReadBuffer(var Dest; const Count: Cardinal): Cardinal;
begin
  if Position + Count > FSize then
    Result := FSize - Position
  else
    Result := Count;
  Move(FPos^, Dest, Result);
  SetPosition(Position + Result);
end;

function TRCReader.ReadInteger: Integer;
begin
  ReadBuffer(Result, SizeOf(Integer));
end;

function TRCReader.ReadCardinal: Cardinal;
begin
  ReadBuffer(Result, SizeOf(Cardinal));
end;

function TRCReader.ReadByte: Byte;
begin
  ReadBuffer(Result, 1);
end;

function TRCReader.ReadChar: Char;
begin
  Result := Chr(ReadByte);
end;

function TRCReader.ReadBoolean: Boolean;
begin
  Result := ReadByte <> 0;
end;

function TRCReader.ReadString: String;
var Size: Cardinal;
begin
  Size := ReadCardinal;
  SetLength(Result, Size);
  Size := ReadBuffer(Result[1], Size);
  SetLength(Result, Size);
end;

destructor TRCReader.Destroy;
begin
  FreeMem(FBuffer, FSize);
end;

end.
Comments