unit Resourcer;
{ The component for automatic inclusion of external files (needed
  for the correct program function) to the program exe file as resources. }

interface

uses
  Windows, Messages, SysUtils, TypInfo, Classes, Dialogs, Forms,
  WinUtl, BinHex;
{$DEFINE DEBUG}
type

  TResourcer = class(TComponent)
  private
    { Private declarations }
    FExeName: string;
    FUnitName: string;
    FFileList: TStringList;
    FAutoExtract: boolean;
    FAutoDelete: boolean;
    FActive: boolean;
    function GetFileList: TStringList;
    procedure SetFileList(AList: TStringList);
    procedure SetExeName(const AExeName: string);
    procedure SetUnitName(const AUnitName: string);
    procedure SetActive(OnOff: boolean);
    function Designing: boolean;
  protected
    { Protected declarations }
    { Eventually automatically extracts the files. }
    procedure Loaded; override;
    { Update resourcer.rc file so that it corresponds to
      the current FileList }
    procedure RCUpdate;
    { Calls "brc32 -r resourcer.rc" to create resourcer.res file. }
    procedure ResUpdate;
    { Inserts to the file specified in ExeName property "Resourcer" unit
      name as the first unit in the uses clause. (If ExeName <> '') }
    procedure ExeUpdate;
    { Inserts to the file specified in UnitName property "$R resourcer.res"
      line. }
    procedure UnitUpdate;
    { Calls all xxxUpdate methods }
    procedure Update;
    { Converts a AFileName to the resource name: strips off path part of the
      AFileName, replaces all nonalphanumeric characters with underscore. }
    class function FileNameToResName(const AFileName: string): string;
  public
    { Public declarations }
    destructor Destroy; override;
    { Add file to the list of files to be included into resources.
      The file must exists. }
    procedure FileAdd(const AFileName: string);
    { Delete the file from list of files to be included to the resources. }
    procedure FileDelete(const AFileName: string);
    { Loads the file from the resource and copies it to the (existing) AStream,
      from the AStream's current position. Any eventual path part specified
      in AFileName is ignored. }
    procedure ResToStream(const AFileName: string; AStream: TStream);
    { Extract specified file from the resource - create a file of this
      file's basename and extension in the folder where is the program running.
      Any eventual path part in the AFileName is stripped off and ignored. }
    procedure FileExtract(const AFileName: string);
    { Extract all files specified in the FileList from the programs resources
      to the same directory as is the running exe file. }
    procedure Extract;
    { Delete all the files extracted by Extract procedure (from the exe directory). }
    procedure Delete;
  published
    { Published declarations }
    { Base name of the project (.dpr) file. If specified, than into this file
      to the uses clause the Resource unit will be included as the first unit
      (to eventually extract .dll files that must be present for included
      external function declarations in later units).}
    property ExeName: string read FExeName write SetExeName;
    { Name of the unit, where the $R resourcer.res clause should be placed,
      mostly should be set to the name of the unit of the form, where
      the TResources is placed. }
    property UnitName: string read FUnitName write SetUnitName;
    { List of files (must be placed in the current directory or contain
      full pathname) to be inculded in the program's resources. They
      will be extracted to the same directory as the program exe file.
      Resource name is the same as the file name, non alfanumeric chars
      replaced with underscores }
    property FileList: TStringList read GetFileList write SetFileList;
    { Extract automatically the resources to files during program startup? }
    property AutoExtract: boolean read FAutoExtract write FAutoExtract;
    { Automatically delete files extracted from the resource during program shutdown? }
    property AutoDelete: boolean read FAutoDelete write FAutoDelete;
    { At design time - if true upon every FileList change the resource
      file will be updated, as well as .dpr (include as the first unit) and
      .pas ($R resourcer.res) source files }
    property Active: boolean read FActive write SetActive;
  end;

procedure Register;

implementation
const
  ResourcerBaseName = 'Resourcer';

{TResourcer.}
procedure TResourcer.Loaded;
begin
  inherited;
  if AutoExtract and (not (csDesigning in ComponentState)) then
    Extract;
end;

procedure TResourcer.RCUpdate;
var
  i: integer;
  sl: TStringList;
begin
  if not Designing then
    exit;
  sl := TStringList.Create;
  try
    for i := 0 to FileList.Count - 1 do begin
       sl.Add(FileNameToResName(FileList[i]) + ' RCDATA');
       sl.Add(FileList[i]);
    end;
    sl.SaveToFile(ResourcerBaseName + '.rc');
  finally
    sl.Free;
  end;
end;

procedure TResourcer.ResUpdate;
begin
  if not Designing then
    exit;
  {winutl editor}
  ExecuteCommand('', 'brc32 -r ' + ResourcerBaseName + '.rc', false);
end;

procedure TResourcer.ExeUpdate;
begin
  if not Designing then
    exit;
  TForm
  if ExeName <> '' then
    AddLineToFileIfNeeded(ExeName, 'uses', 1, '  ' + ResourcerBaseName + ',');
end;

procedure TResourcer.UnitUpdate;
begin
  if not Designing then   //designer   tform
    exit;
  if UnitName <> '' then begin
    AddLineToFileIfNeeded(UnitName, 'implementation', 1, '{$R ' + ResourcerBaseName + '.res}');
  end;
end;

procedure TResourcer.Update;
begin
  RCUpdate;
  ResUpdate;
  ExeUpdate;
  UnitUpdate;
end;

class function TResourcer.FileNameToResName(const AFileName: string): string;
begin
  Result := ExtractFileName(AFileName);
  Result := StringReplace(Result, ' ', '_', [rfReplaceAll]);
  Result := StringReplace(Result, '.', '_', [rfReplaceAll]);
end;

function TResourcer.GetFileList: TStringList;
begin
  if FFileList = nil then
    FFileList := TStringList.Create;
  Result := FFileList;
end;

procedure TResourcer.FileAdd(const AFileName: string);
var
  i: integer;
  rn: string;
begin
  rn := FileNameToResName(AFileName);
  for i := 0 to FileList.Count - 1 do begin
    if rn = FileNameToResName(FileList[i]) then
      Exception.Create('Resource name already in use: ' + rn);
  end;
  FileList.Add(AFileName)
end;

procedure TResourcer.FileDelete(const AFileName: string);
var i: integer;
begin
  i := FileList.IndexOf(AFileName);
  if i <> 0 then
    FileList.Delete(i);
end;

procedure TResourcer.ResToStream(const AFileName: string; AStream: TStream);
var
  m: HMODULE;
  r: HRSRC;//windows
  g: HGLOBAL;
  buf: pointer;
  size: integer;

begin
  m := GetModuleHandle(PChar(Application.ExeName));
  if m <> 0 then begin
    r := FindResource(m, PChar(FileNameToResName(AFileName)), RT_RCDATA); //ulfobju \cul\src\ulobj\ulfobju
    if r <> 0 then begin
      size := SizeOfResource(m, r);
      // can be bigger than actual size of the original data file (due to alignment); zero padded
      g := LoadResource(m, r);
      if g <> 0 then begin
        buf := LockResource(g);
        if buf <> nil then begin
          AStream.Write(buf^, size);
          //UnlockResource obsolete
        end;
        //FreeResource obsolete
      end;
    end;
  end;
end;

procedure TResourcer.FileExtract(const AFileName: string);
var
  fn: string;
  f: TFileStream;
begin
  fn := ExtractFilePath(Application.ExeName) + ExtractFileName(AFileName);
  f := TFileStream.Create(fn, fmCreate);
  try
    ResToStream(FileNameToResName(fn), f);
  finally
    f.Free;
  end;
end;

procedure TResourcer.Extract;
var
  i: integer;
begin
  for i := 0 to FileList.Count - 1 do begin
    FileExtract(FileList[i]);
  end;
end;

procedure TResourcer.Delete;
var
  i: integer;
begin
  for i := 0 to FileList.Count - 1 do begin
    DeleteFile(ExtractFilePath(Application.ExeName) + ExtractFileName(FileList[i]));
  end;
end;

procedure TResourcer.SetFileList(AList: TStringList);
var i: integer;
begin
  FileList.Clear;
  for i := 0 to AList.Count - 1 do begin
    FileAdd(AList[i]);
  end;
  if not Designing then
    exit;
  if Active then
    Update;
end;

procedure TResourcer.SetExeName(const AExeName: string);
begin
  if FExeName = AExeName then
    exit;
  FExeName := AExeName;
  ExeUpdate;
end;

procedure TResourcer.SetUnitName(const AUnitName: string);
begin
  if FUnitName = AUnitName then
    exit;
  FUnitName := AUnitName;
  UnitUpdate;
end;

procedure TResourcer.SetActive(OnOff: boolean);
begin
  if not OnOff then
    exit;
  Update;//designer
end;

function TResourcer.Designing: boolean;
begin                                 //binhex winutl typinfo
//  ShowMessage('ComponentState: ' + ComponentState);
  Result := (csDesigning in ComponentState) and
    (not (csReading in ComponentState));
end;

destructor TResourcer.Destroy;
begin
  FFileList.Free;
  inherited;
end;

{/TResourcer.}

procedure Register;
begin
  RegisterComponents('NonVis', [TResourcer]);
end;

//designintf
end.
