Skojarzenia plików

Potrzebuje takiej funkcji:

<font color="blue">Function JakasTamNazwa(s : string) : boolean;</span>

Która ma sprawdzać, czy podane w "s" rozszerzenie pliku , np "MP3" jest otwierane przez mój program (sprawdzenie w rejestrze).

A nie lepiej samemu napisać taką funkcję ???
Na prawdę jest to łatwe ( o rejestracji plików jest w dziale Delphi ).

Musisz użyć TRegistry, dostać się do HCR.rozszerzenie, a dalej dostać się do klucza HCR, który jest podany jako domyślna wartość klucza HCR.rozszerzenie. Potem wchodzisz w shell\open, a tam w domyślnym kluczu jest ścieżka do exeka który "obsługuje" to rozszerzenie.
jeśli ten klucz (odpowiednio obsięty, bo tam gdzieś się cudzysłowy) jest równy applicatiion.exename (lub paramstr(0) jak kto woli) to result=true, a jeśli nie to result=false

Teraz już to tylko przetłumacz na Pascala...

Hmm musze przyznać, że jeśli chodzi o rejestr.. To nie mam pojęcia co do mnie mówisz człowieku - jakoś nie wchodzi mi rejestr do głowy... byłbym wdzięczny jakby ktoś napisałem mi taką funkcję...

Funkcja sprawdzająca, czy z plikiem o rozszerzeniu Extension jest skojarzona aplikacja App (rozszerzenie powinno być podawane bez początkowej kropki):
[code]function CheckAssociation(const Extension, App: string): boolean;
var
Reg: TRegistry;
Desc, AppReg: string;
AppRegEx: array[0..MAX_PATH - 1] of Char;
begin
Result := False;
Reg := TRegistry.Create;
try
with Reg do
begin
RootKey := HKEY_CLASSES_ROOT;

  if not OpenKey('.' + Extension, False) then Exit;
  Desc := ReadString('');
  Desc := Desc + '\shell\open\command';
  CloseKey;

  if not OpenKey(Desc, False) then Exit;
  AppReg := ReadString('');
  ExpandEnvironmentStrings(PChar(AppReg), AppRegEx, MAX_PATH);
  AppReg := AppRegEx;
  if
    (UpperCase(App) = UpperCase(Copy(AppReg, 1, Length(App)))) or
    ('"' + UpperCase(App) + '"' = UpperCase(Copy(AppReg, 1, Length(App) + 2)))
  then Result := TRUE; ///////////////////////////////////////////
  CloseKey;
end;

finally
Reg.Free;
end;
end;[/code]
W klauzuli uses należy dodać moduł Registry:
[code]uses
Windows, SysUtils, ... , Registry;[/code]
(Funkcja poprawiona i uzupełniona.
Był jeden mały błędzik z cudzysłowami. Dodałem ExpandEnvironmentStrings ponieważ w ścieżkach do programów występują niekiedy zmienne środowiskowe, np. %SystemRoot%.
Teraz już chyba wszystko powinno być OK.)

Dałem na forme takie checkboxy:

<font color="blue">nazwa : ext_txt, caption: TXT
nazwa: ext_php, caption: PHP</span>itd...

Procedura sprawdzająca, którą wymyśliłem do tego:

<font color="green"> for i:=0 to Options.ComponentCount-1 do begin if (Options.Components[i] is TCheckBox) and (string(Options.Components[i].Name)[1] = 'e') and (string(Options.Components[i].Name)[2] = 'x') and (string(Options.Components[i].Name)[3] = 't') then begin (Notatnik.Components[i] as TCheckBox).Checked := CheckAssociation((Options.Components[i] as TCheckBox).Caption, Application.ExeName); end; end;</span>

PS: options to nazwa formy.

Kompiluje się normalnie, ale przy wykonianiu procedury wyskakuje:

<font color="red">Invalid Class Typecass</span>

Co jest grane?

Błąd jest w linii (Notatnik.Components[i] as TCheckBox).Checked....
Dokonujesz enumeracji komponentów formy Options wykorzystując zmienną i. W tej samej pętli dokonujesz rzutowania komponentów z formy Notatnik stosując tą samą zmienną i.

Faktycznie, był to błąd przez pomyłkę (nie zauważenie), już wszystko jest poprawione, ale .... nie działa. Próbowałem na różnych rozszerzeniach i nic - wszystkie CheckBoxy są ODZNACZONE.

Może jakiś błąd jest w tej funkcji ?

Był mały błędzik.
Zajrzyj do postu powyżej. Tam jest poprawiona funkcja CheckAssociation.

Niestety dalej nic z tego - dalej nie działa. Próbowałem nawet stworzyć nową aplikację i zrobić najprostsze sprawdzenie jakie się tylko da, na różnych rozszerzeniach - zawsze wartość jest na FALSE. Czy ktoś sprawdzał u siebie czy to działa. ?

Po pierwsze ja bym raczej sprawdza wasciwosc Controls a nie Components a po drugie nie tylko CheckBoxy sa komponentami a za tem to co zwroci wlasciwosc Components moze nie pochodzic z bazowej klasy TcheckBox! zatem przed rzutowaniem dodaj linijke

if Notatnik.Components[j] is TCheckBox then
tu wstaw twoj taki jak jest tzn.
if( Notatnik.Components[j] as TCheckbox).checked then
itd...

[cya]

Funkcja jest dobra na 99%.
U mnie wszystko działa OK.

Spróbuj tak:
[code]procedure Test;
begin
if CheckAssociation('exe', '%1') then
ShowMessage('True')
else
ShowMessage('False');
end;[/code]
Powinien pojawić się komunikat z True.
Pamiętaj, że funkcja zwróci True tylko wtedy, gdy z rozszerzeniem Extension skojarzona jest aplikacja App.
Gdzie:
Extension - rozszerzenie bez początkowej kropki (np.: Extension := 'txt');
App - pełna ścieżka do programu (np.: App := 'C:\WINNT\system32\notepad.exe').
Jakbyś udostępnił fragment kodu, to może mógłbym więcej pomóc.

Niestety dalej wielkie NIC. Już myślałem, że bład tkwi w innej części kodu, dlatego postanowiłem zrobić zupełnie nową - testową aplikacje.

Cały kod (żeby był wszystko jasne):

[code]
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function CheckAssociation(const Extension, App: string): boolean;
var
Reg: TRegistry;
Desc, AppReg: string;
AppRegEx: array[0..MAX_PATH - 1] of Char;
begin
Result := False;
Reg := TRegistry.Create;
try
with Reg do
begin
RootKey := HKEY_CLASSES_ROOT;

if not OpenKey('.' + Extension, False) then Exit;
Desc := ReadString('');
Desc := Desc + '\shell\open\command';
CloseKey;

if not OpenKey(Desc, False) then Exit;
AppReg := ReadString('');
ExpandEnvironmentStrings(PChar(AppReg), AppRegEx, MAX_PATH);
AppReg := AppRegEx;
if
(UpperCase(App) = UpperCase(Copy(AppReg, 1, Length(App)))) or
('"' + UpperCase(App) + '"' = UpperCase(Copy(AppReg, 1,Length(App) + 2)))
then Result := TRUE; ///////////////////////////////////////////
CloseKey;
end;
finally
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckAssociation('php', Application.ExeName) then
ShowMessage('True')
else
ShowMessage('False');
end;

end.[/code]

Wstawiłem jeden TButton, i mimo czy daje skojarzenie php na ten program czy też inny, zawsze pokazuje się FALSE. Już mnie to zaczyna zdeczka denerwować. Proszę HELP Me..

<font color="blue">PS: Mam Borland Delphi 6.0 Enterprise + Windows XP Professional SP1</span>

Hmmm.... mnie też to zainteresowało :)
ale niestety mi działa dobrze [glowa]

p.s. wprowadziłem drobną zmianę co
do klucza 'open' może o to chodzi...

function CheckAssociation(Ext, App: String): Boolean;
var
  Reg : TRegistry;
  Tab : Array[0..255] of Char;
begin
  Result := False;
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CLASSES_ROOT;
  if Reg.OpenKey('.' + Ext, False) then
  begin
    Ext := Reg.ReadString('');
    Reg.CloseKey;
    if Reg.OpenKey(Ext + '\shell', False) then
    begin
      Ext := Reg.ReadString('');
      if Ext = '' then Ext := 'open';
      if Reg.OpenKey(Ext + '\command', False) then
      begin
        Ext := Reg.ReadString('');
        ExpandEnvironmentStrings(PChar(Ext), Tab, 256);
        Ext := Tab;
        Result := Pos(UpperCase(App), UpperCase(Ext)) > 0;
        Reg.CloseKey;
      end;
    end;
  end;
  Reg.Free;
end;

Ktoś ma może jakiś pomysł dlaczego to mi nie działa.. mi się wydaje, że chodzi o system XP - jakieś pomysły?

Ktoś ma może jakiś pomysł dlaczego to mi nie działa.. mi się wydaje, że chodzi o system XP - jakieś pomysły?

też mam XP, a może wklej wyciąg z klucza phpfile\shell ?
no nie wiem, dziwne to to...

Byłbym wdzięczny, jakby ktoś mi wysłał na maila skompilowany program - testujący np. 'php' albo 'ini' - obojętnie - może ja mam tu cos źle. Mój mail: [email protected]

Z góry THX!