Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Регистрация своего файлового росширения, как зарегистрировать новое файловое росш 
:(
    Опции темы
D1myan
  Дата 4.5.2008, 18:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 40
Регистрация: 22.3.2008

Репутация: нет
Всего: нет
Как програмно(кодом) зарегистрировать новое файловое росширение(тип) с использованием своей иконки в системе WindowsXP?
PM MAIL   Вверх
Exai1e
Дата 4.5.2008, 18:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 908
Регистрация: 3.12.2006
Где: Moscow

Репутация: 2
Всего: 30
Как зарегистрировать своё расширение?
Код

Uses Registry;
{©Drkb v.3(2007): www.drkb.ru, 
®Vit (Vitaly Nevzorov) - [email protected]}
procedure RegisterFileType(FileType,FileTypeName, Description,ExecCommand:string);
begin
if (FileType='') or (FileTypeName='') or (ExecCommand='') then exit;
if FileType[1]<>'.' then FileType:='.'+FileType;
if Description='' then Description:=FileTypeName;
with Treginifile.create do
try
rootkey := hkey_classes_root;
writestring(FileType,'',FileTypeName);
writestring(FileTypeName,'',Description);
writestring(FileTypeName+'\shell\open\command','',ExecCommand+' "%1"');
finally
free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('txt','TxtFile', 'Plain text','notepad.exe');
end;



это ?

Добавлено через 2 минуты и 22 секунды
или так

Код

Не хуже M$ получается! У них свои типы файлов, и у нас будут свои! Всё, что для этого нужно - точно выполнять последовательность действий и научиться копировать в буфер, чтобы не писать все те коды, что будут тут изложены :)) 

Сначала, естественно, объявляем в uses модуль Registry. 

Code:
 
uses
Registry;
Затем в публичных объявлениях объявляем процедуру регистрации нового типа файлов: 
Code:
public
{ Public declarations }
procedure RegisterFileType(ext: string; FileName: string);

Описываем её так: 

Code:
procedure TForm1.RegisterFileType(ext: string; FileName: string);
var
reg: TRegistry;
begin
reg:=TRegistry.Create;
with reg do
begin
   RootKey:=HKEY_CLASSES_ROOT;
   OpenKey('.'+ext,True);
   WriteString('',ext+'file');
   CloseKey;
   CreateKey(ext+'file');
   OpenKey(ext+'file\DefaultIcon',True);
   WriteString('',FileName+',0');
   CloseKey;
   OpenKey(ext+'file\shell\open\command',True);
   WriteString('',FileName+' "%1"');
   CloseKey;
   Free;
end;

end;

Ну а по нажатию какого-нибудь батона регистрируем! 

Code:
 
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('DelphiWorld', Application.ExeName);
end;
 
©Drkb::01742
http://delphiworld.narod.ru/
DelphiWorld 6.0


или так smile хотя помоему без разницы smile


--------------------
"Решение зависит от выбранного геморроя" © Snowy
"у нас как в армии - либо работает, либо так и задумано"
PM MAIL ICQ   Вверх
D1myan
  Дата 4.5.2008, 18:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 40
Регистрация: 22.3.2008

Репутация: нет
Всего: нет
Огромное СПС! щяс попробую
PM MAIL   Вверх
D1myan
  Дата 4.5.2008, 18:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 40
Регистрация: 22.3.2008

Репутация: нет
Всего: нет
Не чето не то! у мя теперь двойной клик по файлу открывает мою программу это хорошо но всеже как насчет с использованием своей иконки?
PM MAIL   Вверх
aktuba
Дата 4.5.2008, 19:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38
Цитата(D1myan @  4.5.2008,  19:43 Найти цитируемый пост)
Не чето не то! у мя теперь двойной клик по файлу открывает мою программу это хорошо но всеже как насчет с использованием своей иконки? 

Компьютер перезагрузить не пробовал?


--------------------
user posted image
PM MAIL WWW Skype   Вверх
Qu1nt
Дата 4.5.2008, 19:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 602
Регистрация: 13.1.2007

Репутация: 18
Всего: 50
Вот набросал примерчик:
Код

uses
  Registry;

procedure AppRegister(const Ext: string);
begin
  with TRegistry.Create do
  begin
    RootKey := HKEY_CLASSES_ROOT;
    LazyWrite := False;
    OpenKey('.' + Ext + '\shell\open\command', True);
    WriteString('', Application.ExeName + ' "%1"');
    CloseKey;
    OpenKey('.' + Ext + '\DefaultIcon', True);
    WriteString('', Application.ExeName + ',0');
    CloseKey;
    Free;
  end;
  SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar('RegistrySection')));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AppRegister('hello');
end;
PM MAIL   Вверх
Beltar
Дата 5.5.2008, 07:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 627
Регистрация: 11.1.2006

Репутация: 3
Всего: 7
С иконками всегда плохо, у самой MS работает через одно место. Пока не перезагрузишься системный ImageList может тупо не перестраиваться.
Вообще меня поражает почему MS не написала API ф-ии для регистрации, когда мне присписпичило свое расширение регистрировать, а также проверить корректность регистрации и убрать ее, пришлось вспоминать как работать с реестром (предпочитаю ini-файлы для настроек). smile 


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы. smile(с) я, хотя может и нет
Пищущий на C++ мужик. Даже если это мужик сидит в написанном на Delphi и жрущем паскалевскую библиотеку билдере.
PM MAIL   Вверх
Rennigth
Дата 5.5.2008, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76
Делал мудуль недавно для этого(недоработан конечно, но что есть), мож пригодиться smile
Код

unit ubfrFileExtAssociator;

(* By Bifor *)
(* Shit File Extantion Association Module *)
(* Module Created Date: 06/12/2007 *)
(* Module Last Debug Date: 07/12/2007 *)
(* version 1.00 *)
(* Good luck!! :) *)

interface

uses
  Windows, SysUtils;

type
  TFileExtAssociatorErrorEvent = procedure (ASender: TObject;
    const AError: string) of object;
  TFileExtAssociatorErrorCB = procedure (ASender: TObject;
    const AError: string);


  TFileExtAssociator = class
  private
    FOnError: TFileExtAssociatorErrorEvent;
    FProgPath: string;
    FProgName: string;
    FFileExt: string;
    FProgParam: string;
    FFileDescr: string;
    FOnErrorCB: TFileExtAssociatorErrorCB;

    function CheckEnteredData: Boolean;
    function GetExtProgramName: string;
  protected
    procedure DoAssociateExt; virtual;
    procedure DoRegisterExt; virtual;
    procedure DoError(const AError: string); virtual;
  public
    property FileExtension: string read FFileExt write FFileExt;
    property FileDescription: string read FFileDescr write FFileDescr;

    property ProgramName: string read FProgName write FProgName;
    property ProgramPath: string read FProgPath write FProgPath;
    property ProgramParam: string read FProgParam write FProgParam;

    procedure RegisterExt;
    procedure AssociateExt;

    property OnError: TFileExtAssociatorErrorEvent read FOnError write FOnError;
    property OnErrorCB: TFileExtAssociatorErrorCB read FOnErrorCB write FOnErrorCB;
  end;

  procedure FileExtAssociate(const AFileExtension, AFileDescription,
    AProgramName, AProgramPath, AProgramParam: string);

implementation

procedure FileExtAssociate(const AFileExtension, AFileDescription,
  AProgramName, AProgramPath, AProgramParam: string);
begin
  with TFileExtAssociator.Create do
  try
    FileExtension := AFileExtension;
    FileDescription := AFileDescription;
    ProgramName := AProgramName;
    ProgramPath := AProgramPath;
    ProgramParam := AProgramParam;
    RegisterExt;
    AssociateExt;
  finally
    Free;
  end;
end;

{ TFileExtAssociator }

procedure TFileExtAssociator.AssociateExt;
begin
  DoAssociateExt;
end;

function TFileExtAssociator.CheckEnteredData: Boolean;
begin
  Result := True;
  if Trim(FFileExt) = '' then
  begin
    Result := False;
    if Assigned(FOnError) then
      FOnError(Self, 'file extension is empty');
    Exit;
  end;

  if Trim(FProgName) = '' then
  begin
    Result := False;
    if Assigned(FOnError) then
      FOnError(Self, 'program name is empty');
    Exit;
  end;

  if not FileExists(FProgPath) then
  begin
    Result := False;
    if Assigned(FOnError) then
      FOnError(Self, 'program not found');
    Exit;
  end;

end;

procedure TFileExtAssociator.DoAssociateExt;
const
  C_SUB_KEY_SOURSE_OPEN: string = '%s\shell\open\command';
  C_SUB_KEY_SOURSE_ICON: string = '%s\DefaultIcon';
  C_VALUE_SOURSE_OPEN: string = '"%s" %s';
var
  lPrName: string;
  hRegKey: HKEY;
  dwRes: DWord;
  lpdwDisposition: DWORD;
  lValue: string;
begin
  if CheckEnteredData then
  begin
    lPrName := GetExtProgramName;
    if Trim(lPrName) <> '' then
    begin
      (* source path open *)
      dwRes := RegCreateKeyEx(HKEY_CLASSES_ROOT,
        PAnsiChar(Format(C_SUB_KEY_SOURSE_OPEN, [lPrName])), 0, nil, 0,
        KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, @lpdwDisposition);
      if dwRes = ERROR_SUCCESS then
      begin
        lValue := Format(C_VALUE_SOURSE_OPEN, [FProgPath, FProgParam]);
        dwRes := RegSetValueEx(hRegKey, nil, 0, REG_SZ,
          PAnsiChar(lValue), Length(lValue));
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
        dwRes := RegFlushKey(hRegKey);
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
        dwRes := RegCloseKey(hRegKey);
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
      end else DoError(SysErrorMessage(dwRes));

      (* source path icon *)
      dwRes := RegCreateKeyEx(HKEY_CLASSES_ROOT,
        PAnsiChar(Format(C_SUB_KEY_SOURSE_ICON, [lPrName])), 0, nil, 0,
        KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, @lpdwDisposition);
      if dwRes = ERROR_SUCCESS then
      begin
        lValue := Format('"%s",%d', [FProgPath, 0]);
        dwRes := RegSetValueEx(hRegKey, nil, 0, REG_SZ,
          PAnsiChar(lValue), Length(lValue));
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
        dwRes := RegFlushKey(hRegKey);
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
        dwRes := RegCloseKey(hRegKey);
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
      end else DoError(SysErrorMessage(dwRes));

      (* description *)
      dwRes := RegOpenKeyEx(HKEY_CLASSES_ROOT, PAnsiChar(lPrName), 0, KEY_SET_VALUE,
        hRegKey);
      if dwRes = ERROR_SUCCESS then
      begin
        dwRes := RegSetValueEx(hRegKey, nil, 0, REG_SZ, PAnsiChar(FFileDescr), Length(FFileDescr));
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
        dwRes := RegFlushKey(hRegKey);
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
        dwRes := RegCloseKey(hRegKey);
        if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
      end else DoError(SysErrorMessage(dwRes));
    end;
  end;
end;

procedure TFileExtAssociator.DoError(const AError: string);
begin
  if Assigned(FOnError) then
    FOnError(Self, AError);
  if Assigned(FOnErrorCB) then
    FOnErrorCB(Self, AError);
end;

procedure TFileExtAssociator.DoRegisterExt;
var
  hRegKey: HKEY;
  dwRes: DWORD;
  lpdwDisposition: DWORD;
begin
  if CheckEnteredData then
  begin
    dwRes := RegCreateKeyEx(HKEY_CLASSES_ROOT, PAnsiChar(FFileExt), 0, nil,
      0, KEY_SET_VALUE or KEY_CREATE_SUB_KEY, nil, hRegKey, @lpdwDisposition);
    if dwRes = ERROR_SUCCESS then
    begin
      dwRes := RegSetValueEx(hRegKey, nil, 0, REG_SZ, PAnsiChar(FProgName), Length(FProgName));
      if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
      dwRes := RegFlushKey(hRegKey);
      if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
      dwRes := RegCloseKey(hRegKey);
      if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
    end else DoError(SysErrorMessage(dwRes));
  end;
end;

function TFileExtAssociator.GetExtProgramName: string;
var
  hRegKey: HKEY;
  lpBuff: PChar;
  dwSize, dwType, dwRes: DWord;
begin
  Result := '';
  dwRes := RegOpenKeyEx(HKEY_CLASSES_ROOT, PAnsiChar(FFileExt), 0, KEY_READ,
    hRegKey);
  if dwRes = ERROR_SUCCESS then
  begin
    dwType := REG_SZ;
    dwRes := RegQueryValueEx(hRegKey, nil, nil, @dwType, nil, @dwSize);
    if dwRes = ERROR_SUCCESS then
    begin
      lpBuff := GetMemory(dwSize);
      try
        dwRes := RegQueryValueEx(hRegKey, nil, nil, @dwType, PByte(lpBuff), @dwSize);
        if dwRes = ERROR_SUCCESS then
        begin
          Result := lpBuff;
        end else DoError(SysErrorMessage(dwRes));
      finally
        FreeMemory(lpBuff);
      end;
    end else DoError(SysErrorMessage(dwRes));
    dwRes := RegCloseKey(hRegKey);
    if dwRes <> ERROR_SUCCESS then DoError(SysErrorMessage(dwRes));
  end else DoError(SysErrorMessage(dwRes));
end;

procedure TFileExtAssociator.RegisterExt;
begin
  DoRegisterExt;
end;

end.



--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
D1myan
  Дата 5.5.2008, 16:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 40
Регистрация: 22.3.2008

Репутация: нет
Всего: нет
ВСЕМ ОГРОМНОЕ СПАСИБО ЗА ПОМОЩЬ smile !!!!!! ВСЕ ПОЛУЧИЛОСЬ smile 
PM MAIL   Вверх
Beltar
Дата 6.5.2008, 11:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 627
Регистрация: 11.1.2006

Репутация: 3
Всего: 7
Ой мама. Аж классище целый. Мне и

Код

function CheckFileAssociation:Boolean;
var S:String;
begin
Result:=false;
Reg.RootKey:=HKEY_CLASSES_ROOT;
if Reg.KeyExists('.wtr') then
  begin
  Reg.OpenKey('.wtr',false);
  if Reg.ReadString('')='WC.File' then Result:=true;
  Reg.CloseKey;
  end;
Reg.RootKey:=HKEY_CLASSES_ROOT;
if ((Result=true) and (Reg.KeyExists('WC.File\Shell\Open\command'))) then
  begin
  Reg.OpenKey('WC.File\Shell\Open\command',false);
  S:=Reg.ReadString('');
  if S<>'"'+Application.ExeName+'" "%1"' then
    Result:=false;
  Reg.CloseKey;
  end
  else Result:=false;
end;

function SetFileAssociation:Boolean;
begin
  try
  Result:=false;
  Reg.RootKey:=HKEY_CLASSES_ROOT;
  Reg.OpenKey('.wtr',true);
  Reg.WriteString('','WC.File');
  Reg.CloseKey;
  Reg.RootKey:=HKEY_CLASSES_ROOT;
  Reg.OpenKey('WC.File\Shell\Open\command',true);
  Reg.WriteString('','"'+Application.ExeName+'" "%1"');
  Reg.CloseKey;
  Result:=true;
  except
  end;
end;

function ResetFileAssociation:Boolean;
begin
Result:=false;
  try
  Reg.RootKey:=HKEY_CLASSES_ROOT;
  Reg.DeleteKey('.wtr');
  Reg.DeleteKey('WC.File');
  Result:=true;
  except
  end;
end;


хватило.


--------------------
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы. smile(с) я, хотя может и нет
Пищущий на C++ мужик. Даже если это мужик сидит в написанном на Delphi и жрущем паскалевскую библиотеку билдере.
PM MAIL   Вверх
Rennigth
Дата 6.5.2008, 11:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76
Цитата(Beltar @  6.5.2008,  11:36 Найти цитируемый пост)
Ой мама. Аж классище целый. Мне и

...
Цитата(Beltar @  6.5.2008,  11:36 Найти цитируемый пост)
хватило. 

У тебя иконка дефолтом не ставиться  smile.
А классище не классище, зато на API и с обработкой ошибок. Был вынужден так сделать т.к. нужно было юзать при инициализации, а в это время SEH еще не инициализирован,  и при недостатке доступа к реестру TRegistry пытался рейзить ошибку после чего приложение просто падало smile


Это сообщение отредактировал(а) Rennigth - 6.5.2008, 12:00


--------------------
(* Honesta mors turpi vita potior *)
PM MAIL ICQ   Вверх
aktuba
Дата 6.5.2008, 11:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Смышленный
***


Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38
Цитата(Beltar @  6.5.2008,  12:36 Найти цитируемый пост)
Ой мама. Аж классище целый.

Кому как... Мне, например, с классами удобнее, да и привычнее.


--------------------
user posted image
PM MAIL WWW Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1321 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.