Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 53. - Modifikace souboru aplikace přímo za jejího běhu

Jan Šindelář - 14.8.2002

Modifikace souboru aplikace přímo za jejího běhu

Jistě vás napadlo, že běžným způsobem to nepůjde, protože běžící program by vám neměl operační systém v žádném případě dovolit jakkoliv pozměňovat či mazat z disku a také vám to nedovolí. Způsobů, jak toto omezení obejít, lze určitě vymyslet několik, ale vždy se bude jednat o ne příliš obvyklý způsob a proto berte i čistotu dnešního zdrojového kódů poněkud tolerantněji.

Ale zpět k našemu příkladu. Jistou možností je vytvořit za běhu aplikace její upravenou kopii a původního souboru se poté zbavit například tím, že do registru systému vložíme příkaz k jeho vymazání po dalším restartu Windows. Jistě víte, že podobný způsob využívají například instalační programy, které se tak zbavují těch částí programu, které nemohly být z určitého důvodu ukončeny (a smazány) v době odinstalace aplikace. Způsob je to jistě korektní a čistý, ale má tu nevýhodu, že tento efekt změny není okamžitý a je závislý právě na restartu systému. Proto si ukážeme jiný postup, který bude mít okamžitý efekt, ale nebude tak způsobný, jako postup předchozí.

Než si ukážeme zdrojový kód, je třeba si slovně popsat celý princip. Věc není komplikovaná, ale je potřeba si ujasnit jisté situace, které mohou nastat a které jsou pro příklad klíčové. Velmi zkráceně řečeno je postup takový, že se vytvoří kopie běžící aplikace, která bude poté uložena na disk v již pozměněné podobě a pochopitelně pod jiným názvem. Tato nová aplikace bude poté spuštěna, původní aplikace se ukončí a bude novou aplikací z disku smazána. Nyní již zbývá jen poslední věc a tou je název nově vzniklé aplikace. Ten je totiž jiný, než byl u aplikace původní, protože jsme pochopitelně nemohli uložit na disk dva soubory téhož názvu. A proto si postup ještě jednou zopakujeme. Opět uložíme kopii souboru na disk, ale tentokrát již pod původním názvem, tato další nová aplikace bude opět spuštěna a postará se o smazání "dočasné" aplikace. Tím je celý postup u konce a na disku (a běžící v paměti) je teď již pouze modifikovaná aplikace s původním názvem. Celé to trošku připomíná jeden ze základních programátorských postupů výměny hodnot dvou proměnných, která se udělá pomocí proměnné třetí (tedy, jak možná víte, ono to jde udělat i bez pomocné proměnné, ale to teď nechme stranou).

Celá věc má ještě několik drobných fint, které by nemusely být ze zdrojového kódu hned jasné a tak si je teď ještě musíme vysvětlit. Příklad, který naleznete v závěru článku, řeší s využitím výše popsaného postupu jednoduchou registraci uživatele. Při prvním spuštění bude uživatel požádán o vložení jeho jména. Toto jméno bude poté uloženo přímo do aplikace modifikací jejího souboru a nemusí tak být uloženo v registrech nebo INI souboru. Když bude poté taková aplikace spuštěna, "pozná" že již byla registrována a tato úvodní procedura bude přeskočena. Toto uživatelské jméno bude uloženo na samém konci souboru mezi "klíčová" slova SONAME a EONAME. Tato slova jsou tam právě proto, aby aplikace při svém znovuspuštění poznala, zda již došlo k registraci a můžete si je dle potřeby změnit.

Znovu si tedy popišme celý postup, tentokrát již jen heslovitě:

Doufám, že je teď již postup zcela jasný a můžeme si tedy ukázat zdrojový kód. Příklad předpokládá, že na formuláři budete mít jeden Edit pro zadávání jména a dále pak SpeedButton, po jehož stisku dojde k registraci - spustí se modifikace souboru:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls,ShellAPI, ExtCtrls, Mask;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ExeString: String;

implementation

{$R *.DFM}

procedure Extract(A,B: String;Var C,D: String);
Var
E,F: Integer;
begin
if Pos(uppercase(A),C) > 0 then
  begin
    E := Pos(uppercase(A),C)+length(A);
    F := Pos(uppercase(B),C);
    D := Copy(C,E,F-E);
  end;
end;

procedure Exe2String(var A:String);
Var
ExeStream: TFileStream;
MyStream: TMemoryStream;
begin
  ExeStream:=TFileStream.Create(Application.ExeName,fmOpenRead or fmShareDenyNone);
  Try
    SetLength(A, ExeStream.Size);
    ExeStream.ReadBuffer(Pointer(A)^, ExeStream.Size);
  Finally
  ExeStream.Free;
  end;
end;

procedure Delay(ms : longint);
var
TheTime : LongInt;
begin
TheTime := GetTickCount + ms;
while GetTickCount < TheTime do Application.ProcessMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
Var
MyStream: TMemoryStream;
name,C,Temp: String;
D,E: integer;
begin
exe2String(ExeString);
if pos(uppercase(`soname`),exestring) > 0 then
begin
  delay(500);
  if pos(`_clone`,application.exename) = 0 then
  begin
    name := application.exename;
    Insert(`_clone`,name,(length(name)-3));
    deletefile(name);
  end;
////////////////////////////////////////////////////////////////////////////////
  edit1.visible := false;
  form1.color := $00c6aa84;
//////////////////////////////////////////////////////////////////////////////// 
end;

if pos(`_CLONE`,uppercase(application.exename)) <> 0 then
begin
delay(500);
name := application.exename;
Delete(name,length(name)-9,6);
if deletefile(name) then
begin
MyStream := TMemoryStream.Create;
try
  MyStream.WriteBuffer(Pointer(ExeString)^, Length(ExeString));
  MyStream.savetofile(name);
  finally
    MyStream.Free;
    ShellExecute(Handle, `open`, pchar(name), nil, nil, SW_SHOWNORMAL);
    application.terminate
end;
end
else showmessage(name+` nenalezen`);
end;
if Pos(uppercase(`soname`),exestring) > 0 then
begin
  Extract(`soname`,`eoname`,ExeString,Temp);
  SpeedButton1.Caption := `Program je registrován na: `+Temp;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
MyStream: TMemoryStream;
MyFile,newname: string;
A,B: Integer;
begin
If Speedbutton1.Caption <> `Napište vaše jméno a klikněte sem pro registraci` then exit;
if edit1.text = `` then
begin
  showmessage(`Vložte prosím vaše jméno !`);
  exit;
end;
MyStream := TMemoryStream.Create;
try
  ExeString := ExeString + uppercase(`soname`) + Edit1.Text + uppercase(`eoname`);
  MyStream.Clear;
  MyStream.WriteBuffer(Pointer(ExeString)^, Length(ExeString));
  newname := application.exename;
  Insert(`_clone`,newname,length(application.exename)-3);
  MyStream.savetofile(newname);
  finally
  MyStream.Free;
  end;
  ShellExecute(Handle, `open`, pchar(newname), nil, nil, SW_SHOWNORMAL);
  application.terminate;
end;

end.

Zdrojový program aplikace si ukazujeme celý, pěkně od začátku až do konce, aby nedošlo k nějakým nejasnostem. Zdrojový kód jsem nechal tentokrát téměř beze změn, tak jak se mi dostal do rukou.

Možná jste si všimli, že je opět použita jedna z variant procedury Delay. Je použita proto, aby v kritické fázi mazání jednoho souboru a spouštění jiného nedošlo ke vzájemné kolizi, ke které může dojít. Proto je vložena půlsekundová pauza.

Místo ve zdrojovém kódu, které je výrazně orámováno lomítky, obsahuje ten kód, který bude proveden v tom případě, že již došlo k úspěšné registraci (a v této fázi již by měl být tedy na disku pouze výsledný modifikovaný soubor). Sem tedy vložte ten kód, který má reagovat na tuto situaci. V naší ukázce dojde jednak k zneviditelnění komponenty Edit, protože ta již není potřeba, a pak je ještě změněna barva formuláře.

Co říci na úplný závěr? Vzhledem ke způsobu manipulace se soubory, jejich kopírování a mazání nebude zřejmě příliš vhodné tento postup použít pro velmi velké soubory. A i při použití pro menší soubory nelze vyloučit za určitých extrémních podmínek možné selhání, ale to je riziko každého podobného krkolomného postupu. Pokud však nemáte jinou možnost, račte vyzkoušet...