[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]

{
>try using resource files with TurboVision. When opening a resource file with
>extension EXE, TV will append it to the file during write operations.
>I did it already for registration stuff and it works fine.

The trouble with this approach is that each write operation appends a
record, it doesn change the existing one.  For something you do only once
like registration, that's okay, but for config changes, you need to do
something to pack the records.  With Resource files that's complicated, but
possible.  Here's the unit I use to do it.
}

unit resources;

{ Unit to provide extra functions to TVision TResourceFiles }

interface

uses
  objects;

type
  PPackableResource = ^TPackableResource;
  TPackableResource = object(TResourceFile)
    function pack : boolean;
    { Packs the resource file by reading all resources and rewriting them to
      the stream.  Returns false if it fails. }
  end;

implementation

type
  { Type here to get at the secret fields of the TResourceFile }
  TResourceSecrets = object(TObject)
    Stream   : PStream;
    Modified : Boolean;
    BasePos  : Longint;
    IndexPos : Longint;
    Index    : TResourceCollection;
  end;

  PNamedItem = ^TNamedItem;
  TNamedItem = object(TObject)
    Item : PObject;
    Name : PString;
    destructor done; virtual;
  end;

destructor TNamedItem.done;
begin
  DisposeStr(Name);
  inherited done;
end;

procedure Deletechars(var S : TStream; count : Longint);
{ Deletes the given number of characters from the stream }
var
  copy    : longint;
  buffer  : array [1..1024] of byte;
  bufsize : word;
  pos     : longint;
begin
  pos     := S.GetPos;
  copy    := S.GetSize - pos - count;
  bufsize := sizeof(buffer);

  while copy > 0 do
  begin
    if copy < sizeof(buffer) then
      bufsize := copy;
    S.Seek(pos + count);
    S.Read(Buffer, bufsize);
    S.Seek(pos);
    S.write(Buffer, bufsize);
    inc(pos, bufsize);
    dec(copy, bufsize);
  end;
  S.Truncate;
end;

function TPackableResource.Pack : boolean;
var
  contents  : TCollection;
  i         : integer;
  item      : PObject;
  nameditem : PNamedItem;
  OldSize   : longint;
begin
  Flush;
  pack := false;   { Assume failure }
  if Stream^.status <> stOk then
    exit;

  { First, make a copy of all the contents in memory }

  contents.init(Count, 10);
  for i := 0 to pred(Count) do
  begin
    item := Get(KeyAt(i));
    New(NamedItem, init);
    if (NamedItem = nil) or (item = nil) then
    begin
      contents.done;
      exit;
    end;
    NamedItem^.item := item;
    NamedItem^.name := Newstr(Keyat(i));
    contents.atinsert(i, nameditem);
  end;

  { Now, remove all traces of the original. }

  with TResourceSecrets(Self) do
  begin
    Stream^.Seek(BasePos + 4);
    Stream^.Read(OldSize, Sizeof(OldSize));
    Stream^.Seek(BasePos);
    DeleteChars(Stream^, OldSize + 8);
  end;

  { Now, close down and restart }
  TResourceSecrets(Self).Index.Done;
  Stream^.Seek(0);
  inherited init(Stream);

  { Now rewrite all those saved objects. }
  for i := 0 to pred(contents.count) do
  begin
    nameditem := PNamedItem(contents.At(i));
    Put(nameditem^.item, nameditem^.name^);
  end;

  { Get rid of the copies from memory }
  contents.done;

  if Stream^.Status = stOk then
    pack := true;
end;

end.

[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]