unit unit_shortcuts;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Registry, StdCtrls, CheckLst;
type
TfrmFileShortcuts =
class(TForm)
listShortcuts: TCheckListBox;
btnClose: TButton;
btnSave: TButton;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
frmFileShortcuts: TfrmFileShortcuts;
implementation
uses
unit_main;
{$R *.dfm}
function AddCommand(Extension, Command, OpenWith, ParamString:
STRING; Asdefault: BOOLEAN):BOOLEAN;
var
Reg: TRegistry;
ExtType:
String;
begin
Reg := TRegistry.Create;
try
with Reg
do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey(Extension, True);
ExtType := ReadString('
');
if ExtType = '
'
then
begin
if Reg.KeyExists('
\' + Extension + '
\Shell\' + Command + '
\Command') = FALSE
then
Reg.CreateKey('
\' + Extension + '
\Shell\' + Command + '
\Command');
OpenKey('
\' + Extension + '
\Shell\' + Command + '
\Command', True);
WriteString('
', '
"' + OpenWith + '
" "' + ParamString + '
"');
if Reg.KeyExists('
\' + Extension + '
\DefaultIcon') = FALSE
then
Reg.CreateKey('
\' + Extension + '
\DefaultIcon');
OpenKey('
\' + Extension + '
\DefaultIcon', True);
WriteString('
', Application.ExeName + '
,0');
if AsDefault
then
begin
OpenKey('
\' + Extension + '
\Shell', True);
WriteString('
', Command);
end;
end
else
begin
if Reg.KeyExists('
\' + Extension + '
\Shell\' + Command + '
\Command') = FALSE
then
Reg.CreateKey('
\' + Extension + '
\Shell\' + Command + '
\Command');
OpenKey('
\' + ExtType + '
\Shell\'+Command+ '
\Command', True);
WriteString('
', '
"' + OpenWith + '
" "' + ParamString + '
"');
if Reg.KeyExists('
\' + Extension + '
\DefaultIcon') = FALSE
then
Reg.CreateKey('
\' + Extension + '
\DefaultIcon');
OpenKey('
\' + Extension + '
\DefaultIcon', True);
WriteString('
', Application.ExeName + '
,0');
if AsDefault
then
begin
OpenKey('
\' + ExtType + '
\Shell', True);
WriteString('
', Command);
end;
end;
end;
result := true;
except
result := False;
end;
Reg.Free;
end;
function ShowCommand(Extension, OpenWith:
STRING):BOOLEAN;
var
Reg: TRegistry;
ExtType:
String;
begin
Reg := TRegistry.Create;
try
with Reg
do
begin
RootKey := HKEY_CLASSES_ROOT;
OpenKey(Extension, True);
ExtType := ReadString('
');
if ExtType = '
'
then
begin
OpenKey('
\' + Extension + '
\Shell\Open\Command', True);
if Pos(Application.ExeName, ReadString('
')) > 0
then
result := true
else
result := false;
end
else
result := false;
end;
except
result := false;
end;
Reg.Free;
end;
procedure TfrmFileShortcuts.FormCreate(Sender: TObject);
begin
AddCommand('
.php', '
Open', Application.ExeName, '
%1', TRUE);
end;
procedure TfrmFileShortcuts.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmFileShortcuts.btnSaveClick(Sender: TObject);
var
i: Integer;
begin
for i:=0
to (listShortcuts.Count - 1)
do
if listShortcuts.Checked[i] = TRUE
then
AddCommand(listShortcuts.Items.Strings[i], '
Open', Application.ExeName, '
%1', TRUE);
Close;
end;
procedure TfrmFileShortcuts.FormShow(Sender: TObject);
var
i: Integer;
begin
for i:=0
to (listShortcuts.Count - 1)
do
listShortcuts.Checked[i] := ShowCommand(listShortcuts.Items.Strings[i], Application.ExeName);
end;
end.