unit Rejestr;

interface

uses Forms, Registry, Windows, Dialogs, SysUtils;

//Zapisywanie polozenia i rozmiaru okna
function CzytajUstawieniaOkna(okno :TForm;klucz :String; komunikaty: Boolean) :Boolean;
function ZapiszUstawieniaOkna(okno :TForm;klucz :String; komunikaty: Boolean) :Boolean;

//Zapisywanie wartosci automatycznego uruchamiania aplikacji
function CzyIstniejeZapisAutostart(nazwa :String; kluczGlowny :HKEY) :Boolean;
function ZapiszAutostart(nazwa :String; kluczGlowny :HKEY; plikEXE :String) :Boolean;
function UsunAutostart(nazwa :String; kluczGlowny :HKEY) :Boolean;

//Menu kontekstowe zwiazane z plikami o danym rozszerzeniu
procedure RozszerzMenuKontekstoweIstniejacegoTypuPliku(rozszerzenie,polecenie,opis :String);

//Zapisywanie informacji o instalacji (Dodaj/Usun)
type TDodajUsunInfo = record
  DisplayName, DisplayIcon, DisplayVersion,
  Contact, Publisher, Comments, URLUpdateInfo, URLInfoAbout,
  InstallLocation, InstallSource, ProductID,
  UninstallString, UninstallPath, ModifyPath,
  Readme, HelpLink, HelpTelephone,
  RegCompany, RegOwner, LogFile :String;
  VersionMajor, VersionMinor,
  NoRemove, NoRepair, Language :Integer;
  end;

function CzyIstniejeZapisDodajUsun(nazwaKlucza :String) :Boolean;
function ZapiszDodajUsun(nazwaKlucza :String; rekord :TDodajUsunInfo) :Boolean;
function UsunDodajUsun(nazwaKlucza :String) :Boolean;

//Odczytywanie katalogów systemowych
function PobierzSciezkeDoKataloguSpecjalnego(wartosc :String) :String;
function PobierzSciezkeDoMojeDokumenty :String;

implementation

{ ****** Zapisywanie polozenia i rozmiaru okna ******** }

function CzytajUstawieniaOkna(okno :TForm; klucz :String; komunikaty: Boolean) :Boolean;
var Rejestr :TRegistry;
begin
Result:=False;
Rejestr:=TRegistry.Create;
Rejestr.Access:=KEY_READ;
Rejestr.RootKey:=HKEY_CURRENT_USER;

if Rejestr.KeyExists(klucz) then
  if Rejestr.OpenKey(klucz,False) then
    begin
    if Rejestr.ValueExists('Left') then okno.Left:=Rejestr.ReadInteger('Left');
    if Rejestr.ValueExists('Top') then okno.Top:=Rejestr.ReadInteger('Top');
    if Rejestr.ValueExists('Width') then okno.Width:=Rejestr.ReadInteger('Width');
    if Rejestr.ValueExists('Height') then okno.Height:=Rejestr.ReadInteger('Height');
    Rejestr.CloseKey;
    Result:=True;
    end
    else
    begin
    if komunikaty then ShowMessage('Klucz "'+klucz+'" nie może być otwarty.');
    end
  else
  if komunikaty then ShowMessage('Klucz "'+klucz+'" nie istnieje.');
Rejestr.Free;
end;


function ZapiszUstawieniaOkna(okno :TForm; klucz :String; komunikaty: Boolean) :Boolean;
var Rejestr :TRegistry;
begin
Result:=False;
Rejestr:=TRegistry.Create;
Rejestr.Access:=KEY_WRITE;
Rejestr.RootKey:=HKEY_CURRENT_USER;

if not Rejestr.KeyExists(klucz) then
  if not Rejestr.CreateKey(klucz) then
    begin
    ShowMessage('Klucz "'+klucz+'" nie może być utworzony.');
    Rejestr.Free;
    Exit;
    end;

if Rejestr.OpenKey(klucz,False) then
  begin
  Rejestr.WriteInteger('Left',okno.Left);
  Rejestr.WriteInteger('Top',okno.Top);
  Rejestr.WriteInteger('Width',okno.Width);
  Rejestr.WriteInteger('Height',okno.Height);
  Rejestr.CloseKey;
  Result:=True;
  end
  else ShowMessage('Klucz "'+klucz+'" nie może być otwarty.');

Rejestr.Free;
end;


{ ********************* AUTOSTART ********************** }

type TAutostartCzynnosci=(acSprawdz=0,acZapisz=1,acUsun=2);

function KonfigurujAutostart(nazwa :String; kluczGlowny :HKEY; plikEXE :String; czynnosc :TAutostartCzynnosci) :Boolean;
const klucz='\SOFTWARE\Microsoft\Windows\CurrentVersion\Run';
var Rejestr :TRegistry;
begin
Result:=False;
Rejestr:=TRegistry.Create;
Rejestr.Access:=KEY_SET_VALUE;
if czynnosc=acSprawdz then Rejestr.Access:=KEY_QUERY_VALUE;
Rejestr.RootKey:=kluczGlowny;

if Rejestr.OpenKey(klucz,False) then
  begin
  case czynnosc of
    acSprawdz: Result:=Rejestr.ValueExists(nazwa);
    acZapisz:  Rejestr.WriteString(nazwa,plikEXE);
    acUsun:    Rejestr.DeleteValue(nazwa);
  end;
  Rejestr.CloseKey;
  if czynnosc<>acSprawdz then Result:=True;
  end
  else ShowMessage('Klucz "'+klucz+'" nie istnieje lub nie może być otwarty.');

Rejestr.Free;
end;

function CzyIstniejeZapisAutostart(nazwa :String; kluczGlowny :HKEY) :Boolean;
begin
Result:=KonfigurujAutostart(nazwa,kluczGlowny,'',acSprawdz);
end;

function ZapiszAutostart(nazwa :String; kluczGlowny :HKEY; plikEXE :String) :Boolean;
begin
Result:=KonfigurujAutostart(nazwa,kluczGlowny,plikEXE,acZapisz);
end;

function UsunAutostart(nazwa :String; kluczGlowny :HKEY) :Boolean;
begin
Result:=KonfigurujAutostart(nazwa,kluczGlowny,'',acUsun);
end;

{ ********************* DODAJ/USUN ********************** }

{type TDodajUsunInfo = record
  NazwaKlucza, DisplayName, DisplayIcon, DisplayVersion,
  Contact, Publisher, Comments, URLUpdateInfo, URLInfoAbout,
  InstallLocation, InstallSource, ProductID,
  UninstallString, UninstallPath, ModifyPath,
  Readme, HelpLink, HelpTelephone,
  RegCompany, RegOwner, LogFile :String;
  VersionMajor, VersionMinor,
  NoRemove, NoRepair, Language :Integer;
  end;}

type TDodajUsunCzynnosci=(ducSprawdz=0,ducZapisz=1,ducUsun=2);

function KonfigurujDodajUsun(nazwaKlucza :String; rekord :TDodajUsunInfo; czynnosc :TDodajUsunCzynnosci) :Boolean;
const Klucz='\Software\Microsoft\Windows\CurrentVersion\Uninstall';
var
  Rejestr :TRegistry;
  KluczAplikacji :String;
  KluczAplikacjiIstnieje :Boolean;
begin
Result:=False;
Rejestr:=TRegistry.Create;
with Rejestr,rekord do
  begin
  Access:=KEY_ALL_ACCESS;
  RootKey:=HKEY_LOCAL_MACHINE;
  if KeyExists(Klucz) then //klucz Uninstall
    begin
    KluczAplikacji:=Klucz+'\'+nazwaKlucza;
    KluczAplikacjiIstnieje:=KeyExists(KluczAplikacji);
    if czynnosc=ducSprawdz then
      begin
      Result:=KluczAplikacjiIstnieje;
      Free;
      Exit;
      end;

    if KluczAplikacjiIstnieje then
      case czynnosc of
        ducSprawdz:
          begin
          Result:=KluczAplikacjiIstnieje;
          Free;
          Exit;
          end;
        ducZapisz:
          begin
          Result:=False;
          Free;
          Exit;
          end;
        ducUsun:
          begin
          Result:=DeleteKey(KluczAplikacji);
          Free;
          Exit;
          end;
        end
        else
        if czynnosc=ducUsun then
          begin
          Result:=False;
          Free;
          Exit;
          end;

    if OpenKey(KluczAplikacji,True) then
      begin
      if DisplayName<>'' then WriteString('DisplayName',DisplayName)
                         else
                         begin
                         Free;
                         raise Exception.Create('Pole "DisplayName" musi zawierać nazwę aplikacji.');
                         end;
      if UninstallString<>'' then WriteString('UninstallString',UninstallString)
                             else
                             begin
                             Free;
                             raise Exception.Create('Pole "UninstallString" musi zawierać ścieżkę do pliku instalatora.');
                             end;
      if DisplayIcon<>'' then WriteString('DisplayIcon',DisplayIcon);
      if DisplayVersion<>'' then WriteString('DisplayVersion',DisplayVersion);
      if Contact<>'' then WriteString('Contact',Contact);
      if Publisher<>'' then WriteString('Publisher',Publisher);
      if Comments<>'' then WriteString('Comments',Comments);
      if URLUpdateInfo<>'' then WriteString('URLUpdateInfo',URLUpdateInfo);
      if URLInfoAbout<>'' then WriteString('URLInfoAbout',URLInfoAbout);
      if InstallLocation<>'' then WriteString('InstallLocation',InstallLocation);
      if InstallSource<>'' then WriteString('InstallSource',InstallSource);
      if ProductID<>'' then WriteString('ProductID',ProductID);
      if UninstallPath<>'' then WriteString('UninstallPath',UninstallPath);
      if ModifyPath<>'' then WriteString('ModifyPath',ModifyPath);
      if Readme<>'' then WriteString('Readme',Readme);
      if HelpLink<>'' then WriteString('HelpLink',HelpLink);
      if HelpTelephone<>'' then WriteString('HelpTelephone',HelpTelephone);
      if RegCompany<>'' then WriteString('RegCompany',RegCompany);
      if RegOwner<>'' then WriteString('RegOwner',RegOwner);
      if LogFile<>'' then WriteString('LogFile',LogFile);
      if VersionMajor<>-1 then WriteInteger('VersionMajor',VersionMajor);
      if VersionMinor<>-1 then WriteInteger('VersionMinor',VersionMinor);
      if NoRemove<>-1 then WriteInteger('NoRemove',NoRemove);
      if NoRepair<>-1 then WriteInteger('NoRepair',NoRepair);
      if Language<>-1 then WriteInteger('Language',Language);
      CloseKey;
      Result:=True;
      end
      else
      begin
      Free;
      raise Exception.Create('Klucz informacji o instalacji nie może być stworzony lub otwarty.');
      end;
    end;
  Free;
  end;
end;

function CzyIstniejeZapisDodajUsun(nazwaKlucza :String) :Boolean;
var rekord :TDodajUsunInfo;
begin
Result:=KonfigurujDodajUsun(nazwaKlucza,rekord,ducSprawdz);
end;

function ZapiszDodajUsun(nazwaKlucza :String; rekord :TDodajUsunInfo) :Boolean;
begin
Result:=KonfigurujDodajUsun(nazwaKlucza,rekord,ducZapisz);
end;

function UsunDodajUsun(nazwaKlucza :String) :Boolean;
var rekord :TDodajUsunInfo;
begin
Result:=KonfigurujDodajUsun(nazwaKlucza,rekord,ducUsun);
end;

{ ********************* Moje dokumenty ********************** }

function PobierzSciezkeDoKataloguSpecjalnego(wartosc :String) :String;
const Klucz='\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
var Rejestr :TRegistry;
begin
Result:='';
Rejestr:=TRegistry.Create;
Rejestr.Access:=KEY_READ;
Rejestr.RootKey:=HKEY_CURRENT_USER;
if Rejestr.OpenKey(Klucz,False) then
    begin
    if Rejestr.ValueExists(Wartosc) then Result:=Rejestr.ReadString(Wartosc)
                                    else
                                    begin
                                    Rejestr.Free;
                                    raise Exception.Create('Wartosc '+Wartosc+' nie istnieje');
                                    end;
    Rejestr.CloseKey;
    end
    else
    begin
    Rejestr.Free;
    raise Exception.Create('Klucz "'+klucz+'" nie istnieje lub nie może być otwarty.');
    end;
Rejestr.Free;
end;

function PobierzSciezkeDoMojeDokumenty :String;
begin
Result:=PobierzSciezkeDoKataloguSpecjalnego('Personal');
end;

procedure RozszerzMenuKontekstoweIstniejacegoTypuPliku(rozszerzenie,polecenie,opis :String);
var
  Rejestr :TRegistry;
  NazwaTypu :String;
  Klucz :String;
begin
  Rejestr:=TRegistry.Create;
  Rejestr.RootKey := HKEY_CLASSES_ROOT;

  //Odczytwanie nazwy typu
  if Rejestr.OpenKey('\.'+rozszerzenie,False) then
    begin
    NazwaTypu:=Rejestr.ReadString('');
    Rejestr.CloseKey;
    end
    else
    begin
    Rejestr.Free;
    raise Exception.Create('Rozszerzenie "'+rozszerzenie+'" nie jest zarejestrowane');
    end;

  //Czy polecenie jest juz zdefiniowane
  Klucz:='\'+NazwaTypu+'\shell\'+polecenie;
  if Rejestr.KeyExists(Klucz) then
    begin
    Rejestr.Free;
    raise Exception.Create('Polecenie "'+polecenie+'" jest już zdefiniowane dla rozszerzenia ".'+rozszerzenie+'"');
    end;

  //Tworzenie klucza dla polecenia
  if Rejestr.OpenKey(Klucz,True) then
    begin
    Rejestr.WriteString('',opis);
    Rejestr.CloseKey;

    if Rejestr.OpenKey(Klucz+'\Command',True) then
      begin
      Rejestr.WriteString('','"'+Application.ExeName+'" "%1"');
      Rejestr.CloseKey;
      end
      else
      begin
      Rejestr.Free;
      raise Exception.Create('Utworzenie klucza '+Klucz+'\Command nie jest możliwe');
      end;

    end
    else
    begin
    Rejestr.Free;
    raise Exception.Create('Utworzenie klucza '+Klucz+' nie jest możliwe');
    end;
end;


end.
