unit ReadMe;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

type
  TInfoForm = class(TForm)
    OKBtn: TButton;
    Memo: TRichEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  InfoForm: TInfoForm;

implementation

{$R *.DFM}

uses CmnFunc2;

{***********************************************************}
function AddBackslash (const S: String): String;
{ Adds a trailing backslash to the string, if one wasn't there already.
  But if S is an empty string, the function returns an empty string. }
begin
  Result := S;
  if (Result <> '') and (Result[Length(Result)] <> '\') then
    Result := Result + '\';
end;
{***********************************************************}

{***********************************************************}
function RemoveBackslashUnlessRoot (const S: String): String;
{ Removes the trailing backslash from the string, if one exists and if does
  not specify a root directory of a drive (i.e. "C:\"}
begin
  Result := S;
  if (Length(Result) >= 2) and (Result[Length(Result)] = '\') and
     (Result[Length(Result)-1] <> ':') then
    {$IFNDEF WIN32}
    Dec (Result[0]);
    {$ELSE}
    SetLength (Result, Length(Result)-1);
    {$ENDIF}
end;
{***********************************************************}

{***********************************************************}
function InternalGetFileAttr (const Name: String): Integer;
var
  OldErrorMode: UINT;
begin
  OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);  { Prevent "Network Error" boxes }
  try
    {$IFDEF WIN32}
    Result := GetFileAttributes(PChar(RemoveBackslashUnlessRoot(Name)));
    {$ELSE}
    Result := FileGetAttr(RemoveBackslashUnlessRoot(Name));
    {$ENDIF}
  finally
    SetErrorMode (OldErrorMode);
  end;
end;
{***********************************************************}

{***********************************************************}
function FileOrDirExists (const Name: String): Boolean;
{ Returns True if the specified directory or file name exists. The specified
  name may include a trailing backslash. }
begin
  Result := InternalGetFileAttr(Name) >= 0;
end;
{***********************************************************}

{***********************************************************}
function GenerateUniqueName (Path: String; const Extension: String): String;
  function IntToBase32 (Number: Longint): String;
  const
    Table: array[0..31] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUV';
  var
    I: Integer;
  begin
    Result := '';
    for I := 0 to 4 do begin
      Insert (Table[Number and 31], Result, 1);
      Number := Number shr 5;
    end;
  end;
var
  Rand, RandOrig: Longint;
begin
  Path := AddBackslash(Path);
  RandOrig := Random($2000000);
  Rand := RandOrig;
  repeat
    Inc (Rand);
    if Rand > $1FFFFFF then Rand := 0;
    if Rand = RandOrig then
      { practically impossible to go through 33 million possibilities,
        but check "just in case"... }
      raise Exception.Create('Too many files in path "'+Path+'". Unable to create temporary file.');
    { Generate a random name }
    Result := Path + 'TMP' + IntToBase32(Rand) + Extension;
  until not FileOrDirExists(Result);
end;
{***********************************************************}

function ExtractResource(Name: String; ID: Integer; var OutputName: String): Boolean;
var
    Buf : Pointer;
    Size : Longint;
    H, ResHandle : Cardinal;
    _DLL : File;
begin
  { If playing from resource, extract to temporary directory }
   OutputName := GetTempDir+OutputName;
   H:=GetModuleHandle(PChar(ExtractFileName(ParamStr(0))));
   ResHandle:=FindResource(H,MakeIntResource(ID),PChar(Name));
   if ResHandle=0 then
   begin
    Result := False;
    Exit;
   end;
   Buf:=Pointer(LoadResource(H,ResHandle));
   Size:=SizeOfResource(H,ResHandle);
   try
   AssignFile(_DLL,OutputName);
   Rewrite(_DLL,1);
   try
    BlockWrite(_DLL,Buf^,Size)
   finally
    CloseFile(_DLL);
   end;
   except
     Result := False;
     Exit;
   end;
  Result := True;
end;

procedure TInfoForm.FormCreate(Sender: TObject);
var Temp: string;
begin
  { Extract DLL resource }
  Temp := GenerateUniqueName(GetTempDir,'.TMP');
  Temp := ExtractFileName(Temp);
  ExtractResource('README',1000, Temp);
  try
    Memo.Lines.LoadFromFile(Temp);
  except
    Memo.Lines.Add('Unable to find information file.');
  end;
  DeleteFile(Temp);
end;

end.
