Открытие определеного типа файлов в приложении

 
0
 
Delphi, Kylix and Pascal
ava
Volkogriz | 21.01.2013, 19:03
Доброе время суток!
Есть такая проблема.
Привязанные к приложению тип файлов открывается,
но повторное нажатие на файл не к чему не приводит(
Нужно примерно так:
К примеру тыкнул на файл он воспроизводится в приложении, тыкнул на другой воспроизводится другой.
Я делаю так:

procedure TForm1.FormShow(Sender: TObject);
var s: string; i: integer;
begin
Image1.Enabled:=true;
Image1.Picture:=nil;
for i := 1 to ParamCount do
begin
S:=paramstr(i);
if FileExists(s) then
play(s);
end;
end;

С уважением,
Volkogriz!
Ответы (5)
ava
Чучмек | 21.01.2013, 18:49 #
Цитата (Volkogriz @  21.1.2013,  18:03 findReferencedText)
но повторное нажатие на файл не к чему не приводит(

Должно приводить к запуску новой копии приложения.
ava
Volkogriz | 21.01.2013, 19:15 #
Хотелось бы не к копии а просто к открытию файла!
Как сделать простенький пример можно!
Я где то нашёл модуль:


unit OnlyOneClass;

interface

// Класс ассоциаций файлов с программой
uses
  Windows, Messages, iniFiles, SysUtils, Registry, ShlObj, Dialogs;

// procedure MessageOnlyOne(var msg: TWMCopyData); message WM_COPYDATA;

type
  OnlyOne = class
    private
      class function Init_Mutex(mid: string): boolean;
      class function mut_id(s: string): string;
    public
      class procedure Init(handle: integer);
      class function GetHandle: integer;
      class procedure SendMessage(handle: THandle; messageStr: string);
      class function GetMessage:string;
  end;

procedure FileAssociate(const Ext, progName: string; Icon: string = ''; ProgPath: string = '');
procedure FileUnAssociate(const Ext, progName:string);
function CryptDllMD5(const text:AnsiString):string;

implementation

type
TMD5Context = record
    i : array[1..2] of cardinal;
    buf : array[1..4] of cardinal;
    _in : array[1..64] of byte;
    digest : array[1..16] of byte;
end;

const cryptdll = 'cryptdll.dll';

procedure MD5Init(var context : TMD5Context);  stdcall; external cryptdll ;
procedure MD5Final(var context : TMD5Context); stdcall; external cryptdll ;
procedure MD5Update(var context: TMD5Context; const input : PAnsiChar; len: cardinal); stdcall; external cryptdll;

var
  AppData: array [0 .. $FF] of char;
  iniName: string;
  mut, hmut: thandle;
  i: TIniFile;


function CryptDllMD5(const text:AnsiString):string;
var context : TMD5Context;
    dig : byte;
begin
    MD5Init(context);
    MD5Update(context, pAnsiChar(text), length(text));
    MD5Final(context);
    for dig in context.digest do begin
        result := result + IntToHex(dig,2);
    end;
end;

procedure FileAssociate(const Ext, progName: string; Icon: string = ''; ProgPath: string = '');
var r: TRegistry;
begin
  r:=TRegistry.Create;
  r.RootKey:=HKEY_CURRENT_USER;
  r.OpenKey('Software\Classes\.'+UpperCase(Ext),true);
  r.WriteString('',progName);
  r.CloseKey;
  r.OpenKey('Software\Classes\'+progName+'\shell\open\command',true);
  if ProgPath='' then
     r.WriteString('','"'+ParamStr(0)+'" "%1"')
  else
     r.WriteString('','"'+ProgPath+'" "%1"');
  r.CloseKey;

  if Icon<>'' then begin
    r.OpenKey('Software\Classes\'+progName+'\DefaultIcon',true);
    r.WriteString('',Icon);
    r.CloseKey;
  end;
  r.Free;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

procedure FileUnAssociate(const Ext, progName:string);
var r: TRegistry;
begin
  r:=TRegistry.Create;
  r.RootKey:=HKEY_CURRENT_USER;
  if r.OpenKey('Software\Classes\'+progName,false) then begin
    r.CloseKey;
    r.DeleteKey('Software\Classes\'+progName);
  end;
  if r.OpenKey('Software\Classes\.'+UpperCase(Ext),false) and
     (r.ReadString('') = progName) then begin
     r.CloseKey;
     r.DeleteKey('Software\Classes\.'+UpperCase(Ext));
  end;
  r.Free;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;

{ OnlyOne }

class function OnlyOne.GetHandle: integer;
begin
  i:=TIniFile.Create(iniName);
  result:=i.ReadInteger('process','handle',0);
  i.Free;
end;

class function OnlyOne.GetMessage: string;
begin
  i:=TIniFile.Create(iniName);
  result:=i.ReadString('process','data','');
  i.Free;
end;

class function OnlyOne.Init_Mutex(mid: string): boolean;
begin
  mut := CreateMutex(nil, false, pchar(mut_id(mid)));
  result := not((mut = 0) or (GetLastError = ERROR_ALREADY_EXISTS));
end;

class function OnlyOne.mut_id(s: string): string;
var
  f: integer;
begin
  result := s;
  for f := 1 to length(s) do
    if (result[f] = '\') or (result[f] = '/') then
      result[f] := '_';
end;

class procedure OnlyOne.Init(handle: integer);
begin
  i:=TIniFile.Create(iniName);
  i.WriteInteger('process','handle',handle);
  i.Free;
end;

class procedure OnlyOne.SendMessage(handle: THandle; messageStr: string);
var aCopyData: TCopyDataStruct;
begin
  with aCopyData do
   begin
     dwData := 0;
     cbdata := 0;
     lpData := pchar('');
   end;
   i:=TIniFile.Create(iniName);
   i.WriteString('process','data',messageStr);
   i.Free;
   Windows.SendMessage(handle, WM_COPYDATA, 0, Longint(@aCopyData));
end;

initialization
// запускем программу
mut := 0;
ExpandEnvironmentStrings(PChar('%AppData%'), AppData, SizeOf(AppData));
iniName:=String(AppData)+'\'+CryptDllMD5(AnsiString(ParamStr(0)))+'.tmp';
if not OnlyOne.Init_Mutex(ParamStr(0)) then begin
  // нельзя создать мютекс
  mut := 0;
  hmut:=OnlyOne.GetHandle;
  if hmut<>0 then begin
    // подаем сигнал процессу
    ShowWindow(hmut,SW_RESTORE);
    SetForegroundWindow(hmut);
    OnlyOne.SendMessage(hmut,ParamStr(1));
  end;
  halt; // аварийный выброс
end;

inalization

if mut <> 0 then
begin
  CloseHandle(mut);
  OnlyOne.Init(0);
end;
end.


Использую так:


FileAssociate('BIK','*.BIK',ExtractFilePath(ParamStr(0))+'IT.ico'); //Ассоциация
и
FileUnAssociate('BIK','*.BIK'); //убрать Асоциацию






ava
Чучмек | 21.01.2013, 20:02 #
При запуске программы проверяй наличие уже запущенной копии. Если есть(и не зависшая) - передавай ей paramstr
ava
Poseidon | 24.01.2013, 08:27 #
Цитата




for i := 1 to ParamCount do

begin

S:=paramstr(i);

if FileExists(s) then

play(s);

end;




На сколько я помню, ассоциированный файл передается в paramstr(1). Дальше передаются остальные параметры. Так что проходить циклом по всем параметрам и проверять, а не файл ли это - глупо.

Хочешь запуск только одной копии, делай как посоветовал Чучмек. http://forum.vingrad.ru/topic-1111.html
 
ava
kami | 24.01.2013, 22:56 #
Цитата (Poseidon @  24.1.2013,  08:27 findReferencedText)
ассоциированный файл передается в paramstr(1)

Не факт. Всё зависит от того, как записано в реестре. Например, для jar-файлов выглядит так:
"C:\Program Files\Java\jre7\bin\javaw.exe" -jar "%1" %*
Первым параметром идет -jar, а вторым уже имя файла. Что означает третий параметр - не знаю.
Зарегистрируйтесь или войдите, чтобы написать.
Фирма дня
Вы также можете добавить свою фирму в каталог IT-фирм, и публиковать статьи, новости, вакансии и другую информацию от имени фирмы.
Подробнее
Участники
advanced
Отправить