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...