Newsgroup: it.comp.lang.delphi
Titolo: Registrare Estensione

Salve ho fatto un programma per criptografare i file e siccome i file
criptografati cambiano estenzione vorrei automaticamente far partire il mio
programma al doppio click dell'utente, il problema non sta nei parametri(se
č come per il Pascal "normale" non dovrei avere problemi) ma bensě nel
registrare l'estensione del file ed il programma a lei associato. Io non me
ne intendo ma per intuito si potrebbe fare questo lavoro al primo avvio
dell'applicazione, giusto?ok aspetto fiducioso la soluzione al mio
"problema" :-) possibilmente dettagliata.
Neo
ICQ     :  146381266

 registrare l'estensione del file ed il programma a lei associato.
procedure CreaNuovaAssociazione( Ext,
                                 ProgID,
                                 ProgDescr,
                                 ProgPath : string ) ;
var RegistroWin : TRegistry ;
begin
  RegistroWin := TRegistry.Create ;
  try
    RegistroWin.RootKey := HKEY_CLASSES_ROOT ;
    RegistroWin.OpenKey( '.' + Ext, true ) ;
    RegistroWin.WriteString( '', ProgID ) ;
    RegistroWin.CloseKey ;
    RegistroWin.OpenKey( ProgID, true ) ;
    RegistroWin.WriteString( '', ProgDescr ) ;
    RegistroWin.OpenKey( 'shell\open\command', true ) ;
    RegistroWin.WriteString( '', '"'+ProgPath+'" "%1"' ) ;
    RegistroWin.CloseKey ;
    RegistroWin.CloseKey ;
  finally
    RegistroWin.CloseKey ;
    RegistroWin.Free ;
  end ;
end ;
procedure TForm1.Button1Click(Sender: TObject);
begin
  CreaNuovaAssociazione( 'alf',
                         '.ALF files program processor',
                         'Applicazione di prova per file .ALF',
                         'C:\WinNT\System32\Notepad.exe' ) ;
end ;
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

> procedure CreaNuovaAssociazione( Ext,
Per caso hai anche una procedurina pronta per vedere se un'associazione per
una certa estensione esiste gia'?
Qualcosa tipo:
function EsisteAssociazione(ext:string):boolean;
Se ce l'hai la metto nelle faq insieme all'altra.
Ciao !
--
{MSX}  -  
http://msx.rules.it
Mantenitore delle FAQ di it.comp.lang.delphi,
reperibili qui: 
http://gpi.infomedia.it/abc/delphi/FaqDelphi.txt

una certa estensione esiste gia'?
Spiacente, di pronto non ho nulla, ma penso che il metodo
sia relativamente semplice.  Basta ripercorrere la strada al
contrario, aprire HKEY_CLASSES_ROOT e verificare che la
OpenKey della estensione (compreso il punto iniziale) vada a
buon fine.
-- 
Andrea Laforgia - walkietalkie(at)
libero.it
Spostare "Windows" nel cestino ?

"{MSX}" ha scritto nel messaggio
| Per caso hai anche una procedurina pronta per vedere se un'associazione
per
| una certa estensione esiste gia'?
| Qualcosa tipo:
|
| function EsisteAssociazione(ext:string):boolean;
|
function EsisteAssociazione(ext:string): boolean;
var RegistroWin : TRegistry ;
begin
  RegistroWin := TRegistry.Create ;
  try
    RegistroWin.RootKey := HKEY_CLASSES_ROOT ;
    Result := RegistroWin.OpenKey( '.' + Ext, False ) ;
  finally
    RegistroWin.CloseKey ;
    RegistroWin.Free ;
  end ;
end ;
--
Ciao.
ACSH
[D4]
---------------------------
Chi fa da se'
fatica il doppio

Perfetto, ora la FAQo, grazie :D


var RegistroWin : TRegistry ;
Posso utilizzare TRegIniFile?(sicuramente si)so utilizzarlo meglio, oppure
mi consigli di studiare il TRegistry?è più efficente?apparte al fatto che è
legato ai file ini che sono concettualmente vecchi penso che possa
utilizzare per tutto TRegIniFile, infondo possono manipolare il contenuto
del registro come i TRegistry.
Abituandomi ai TRegistry mi troverei meglio con altri ambienti di sviluppo
integrato (sempre per Win32) che magari non hanno oggetti atti a garantire
la trasportabilità di programmi vecchi che utilizzano i file ini?
Neo
ICQ     :  146381266


 This software is PizzaNCokeWare: if you use this source code in your
 program, feel free to pay me a pizza and a coke ;-)
*)
 uses
    Sysutils
  , Registry
  , Windows
  ;
 function FileClassNew
 (
  const Name: String;
  Root: HKEY = HKEY_CLASSES_ROOT
 ): HKEY;
  var
   ErrCode: Cardinal;
 begin
  ErrCode:=
  RegCreateKeyEx(
   Root,
   PChar(Name),
   0,
   nil,
   0,
   KEY_ALL_ACCESS,
   nil,
   Result,
   nil
  );
  if ErrCode <> ERROR_SUCCESS then begin
   SetLastError(ErrCode);
   RaiseLastWin32Error;
  end;
 end;
 procedure FileClassClose(var ClassKey: HKEY);
 begin
  RegCloseKey(ClassKey);
  ClassKey:= 0;
 end;
 procedure FileClassSetTitle
 (
  const ClassKey: HKEY;
  const ClassTitle: String
 );
 begin
  with TRegistry.Create do try
   RootKey:= ClassKey;
   OpenKey('', False);
   WriteString('', ClassTitle);
  finally
   Free();
  end;
 end;
 procedure FileClassSetIcon
 (
  const ClassKey: HKEY;
  const IconPath: String;
  IconIndex: Integer = 0;
  PathExpand: Boolean = False
 );
  const
   IconPathFormatShort = '%s,%d';
   IconPathFormatLong = '"%s",%d';
  var
   IconPathFormat: String;
 begin
  with TRegistry.Create() do try
   RootKey:= ClassKey;
   OpenKey('\DefaultIcon', True);
   try
    if IconPath = '' then
     DeleteValue('')
    else begin
     if IconPath[1] = '"' then
      IconPathFormat:= IconPathFormatShort
     else
      IconPathFormat:= IconPathFormatLong;
     if PathExpand then
      WriteExpandString('', Format(IconPathFormat, [IconPath, IconIndex]))
     else
      WriteString('', Format(IconPathFormat, [IconPath, IconIndex]));
    end;
   finally
    CloseKey();
   end;
  finally
   Free();
  end;
 end;
 procedure FileClassSetOperation
 (
  const ClassKey: HKEY;
  const CommandLine: String;
  CommandLineExpand: Boolean = False;
  const Verb: String = 'open';
  const Title: String = '';
  UseDDE: Boolean = False;
  const DDEString: String = '';
  const DDEApplication: String = '';
  const DDETopic: String = ''
 );
  var
   OperationRoot: HKEY;
 
 begin
  with TRegistry.Create() do try
   RootKey:= ClassKey;
   if CommandLine <> '' then begin
    OpenKey('\shell\' + verb, True);
    try
     OperationRoot:= CurrentKey;
     with TRegistry.Create() do try
      RootKey:= OperationRoot;
      (* display name for this verb *)
      if Title <> '' then begin
       OpenKey('', False); (* CurrentKey:= RootKey; *)
       WriteString('', Title);
      end;
      (* command line for this verb *)
      OpenKey('\command', True);
      if CommandLineExpand then
       WriteExpandString('', CommandLine)
      else
       WriteString('', CommandLine);
      CloseKey(); (* close <CLASS>\shell\<VERB>\command key *)
      (* DDE options *)
      if UseDDE then begin
       (* DDE command string *)
       OpenKey('\ddexec', True);
       WriteString('', DDEString);
       CloseKey(); (* close <CLASS>\shell\<VERB>\ddexec key *)
       (* DDE application *)
       if DDEApplication <> '' then begin
        OpenKey('\ddexec\application', True);
        WriteString('', DDEApplication);
        CloseKey(); (* close <CLASS>\shell\<VERB>\ddexec\application key *)
       end;
       (* DDE topic *)
       if DDETopic <> '' then begin
        OpenKey('\ddexec\topic', True);
        WriteString('', DDETopic);
        CloseKey(); (* close <CLASS>\shell\<VERB>\ddexec\topic key *)
       end;
      end;
     finally
      Free();
     end;
    finally
     CloseKey(); (* close <CLASS>\shell\<VERB> key *)
    end;
   end;
  finally
   Free();
  end;
 end;
 function FileClassAssociateExt
 (
  const FileClassName, Extension: String;
  Root: HKEY = HKEY_CLASSES_ROOT
 ): String;
 begin
  with TRegistry.Create() do try
   RootKey:= Root;
   OpenKey('', False); (* CurrentKey:= RootKey; *)
   OpenKey(Extension, True);
   try
    Result:= ReadString('');
    WriteString('', FileClassName);
   finally
    CloseKey();
   end;
  finally
   Free();
  end;
 end;
 var
  ClassKey: HKEY;
begin
 (* you can pass any valid key handle instead of HKEY_CLASSES_ROOT. For
    example, on Windows 2000 you can pass the handle returned by
    RegOpenUserClassesRoot to register a file class for the current user
    if you have no permission to register it for all users, or a handle to
    HKEY_CURRENT_USER\Software\Classes to register it for the current
    user only, or a handle to any key using the same structure of file
    classes (for example HKLM\SOFTWARE\Clients\<class>\<client name>\
    Protocols\<protocol name>) *)
 ClassKey:= FileClassNew('TestClass', HKEY_CLASSES_ROOT);
 try
  FileClassSetTitle(ClassKey, 'Test file class');
  FileClassSetOperation
  (
   ClassKey,
   '"notepad.exe" %1',
   False,
   'open',
   'Ouvre',
   True,
   '[FileOpen("%1")]',
   'foo',
   'bar'
  );
  FileClassAssociateExt('TestClass', '.doh', HKEY_CLASSES_ROOT);
 finally
  FileClassClose(ClassKey);
 end;
end.

 piuttosto cosě:
Grazie della precisazione KJK.
Ho scritto quella routine per il mio Win98 di casa, non l'ho
mai testata su un NT.
