
07.01.2012, 10:50
|
Так проходящий
|
|
Регистрация: 18.07.2011
Сообщения: 805
Версия Delphi: 7Lite
Репутация: 6063
|
|
Google жил, Google жив, Google будет жить!
http://forums.fanatic.net.nz/index.php?showtopic=11758
PHP код:
procedure CreateKeys( Reg : TRegistry; key, CurPath : String );
begin
Reg.OpenKey( key,True);
Reg.WriteString('URL Protocol', '');
Reg.WriteInteger('EditFlags', 0);
Reg.WriteString('','URL:' + key + ' Protocol');
Reg.CloseKey;
Reg.OpenKey( key + '\DefaultIcon', True);
Reg.WriteString('', CurPath );
Reg.CloseKey;
Reg.OpenKey( key + '\shell', True );
Reg.CloseKey;
Reg.OpenKey( key + '\shell\open', True );
Reg.CloseKey;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
curPath : String;
cab: string;
Reg : TRegistry;
I,J, P : Integer;
Lucky : Boolean;
h: HWND;
begin
curPath := ExtractFilePath( ParamStr(0) );
if curPath[Length(curPath)]<>'\' then
curPath := curPath + '\';
curPath := curPath + ExtractFileName( ParamStr(0) );
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CLASSES_ROOT;
if not Reg.OpenKey( 'icc',False) then begin
CreateKeys( Reg, 'icc', curPath );
Reg.OpenKey( 'icc\shell\open\command', True );
Reg.WriteString('', '"'+curPath + '" %1' );
Reg.CloseKey;
end
else
form1.Close;
// Code below is what happens when the protocol is ran
if ParamCount>0 then begin
curPath := ParamStr(1);
if ParamStr(1) = 'notepad' then begin
{Your Code here}
end;
end
else
Application.Terminate;
end;
|