Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Browser listeleme
#1
Merhaba, 

PC'de olan browser listesini ve bulunduğu klasör yolu almak için uğraşıyorum saatlerdir çıkamadım içinde bu konuyu nasıl çözebilirim?


procedure TForm1.Button2Click(Sender: TObject);
var
  Reg: TRegistry;
  S: TStringList;
  I: Integer;
begin
  S := TStringList.Create;
  Reg := TRegistry.Create;
  Memo1.BeginUpdate;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then
    begin
      showmessage('browser yok');
    end
    else
    begin
      Reg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        Memo1.Lines.Add(Reg.ReadString(S.Strings[I]));
      end;
    end;
  finally
    S.Free;
    Reg.CloseKey;
    Reg.Free;
    Memo1.EndUpdate;
  end;
end;
Cevapla
#2
(13-12-2020, Saat: 19:55)Altıner Adlı Kullanıcıdan Alıntı: Merhaba, 

PC'de olan browser listesini ve bulunduğu klasör yolu almak için uğraşıyorum saatlerdir çıkamadım içinde bu konuyu nasıl çözebilirim?


procedure TForm1.Button2Click(Sender: TObject);
var
  Reg: TRegistry;
  S: TStringList;
  I: Integer;
begin
  S := TStringList.Create;
  Reg := TRegistry.Create;
  Memo1.BeginUpdate;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then
    begin
      showmessage('browser yok');
    end
    else
    begin
      Reg.GetValueNames(S);
      for I := 0 to S.Count - 1 do
      begin
        Memo1.Lines.Add(Reg.ReadString(S.Strings[I]));
      end;
    end;
  finally
    S.Free;
    Reg.CloseKey;
    Reg.Free;
    Memo1.EndUpdate;
  end;
end;

Merhaba,

Aktif browser almak istiyorsanız bu kolay, sanırım siz bilgisayardaki tüm browser listesini almak istiyorsunuz. Bunun için browser'lar ile ilgili hangi kayıt defterine ne yazdıklarını bilerek ilerleyebilirsiniz.

Aktif browser'i almak için şöyle bir şey gördüm;
uses
 Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
 Reg: TRegistry;
 KeyName: string;
 ValueStr: string;
begin
 Reg := TRegistry.Create;
 try
   Reg.RootKey := HKEY_CLASSES_ROOT;
   KeyName     := 'htmlfile\shell\open\command';
   if Reg.OpenKey(KeyName, False) then
   begin
     ValueStr := Reg.ReadString('');
     Reg.CloseKey;
     ShowMessage(ValueStr);
   end
   else
     ShowMessage('There isn't a Default browser');
 finally
   Reg.Free;
 end;
end;
Cevapla
#3
Bu aşağıdaki sizin kodun düzeltilmiş hali...

procedure TForm1.Button2Click(Sender: TObject);
var
  Reg: TRegistry;
  S: TStringList;
  I: Integer;
begin
  S := TStringList.Create;
  Reg := TRegistry.Create;
  Memo1.Lines.BeginUpdate;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then
    begin
      showmessage('browser yok');
    end
    else
    begin
      Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', False);
      Reg.GetKeyNames( s ); // Temporary Get Folder Names...
      for I := 0 to S.Count - 1 do
      begin
        if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + s[i], false) then
        Memo1.Lines.Add(  Reg.ReadString('') );
        Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true); // Get back to the BrowserList root
      end;
    end;
  finally
    S.Free;
    Reg.CloseKey;
    Reg.Free;
    Memo1.Lines.EndUpdate;
  end;
end;


Bu aşağıdaki de görece daha kontrollü bir yapı... Idea


Uses Registry;

procedure ListBrowsers( aList: TStrings );
var
  Reg : TRegistry;
  idx : Integer;
begin
  aList.Clear;
  Reg := TRegistry.Create;
  try
    Reg.Access  := KEY_WOW64_64KEY or KEY_ALL_ACCESS;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    if not Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then Exit;
    Reg.GetKeyNames( aList ); // Temporary Get Folder Names...
    for idx := 0 to pred( aList.Count ) do
    begin
      if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + aList[idx], false) then
        aList[idx] :=  Reg.ReadString(''); // Read Friendly Name
      Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true); // Get back to the BrowserList root
    end;
  finally
    Reg.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBrowsers( Memo1.Lines );
end;

Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#4
(13-12-2020, Saat: 21:02)mrmarman Adlı Kullanıcıdan Alıntı: Bu aşağıdaki sizin kodun düzeltilmiş hali...

procedure TForm1.Button2Click(Sender: TObject);
var
  Reg: TRegistry;
  S: TStringList;
  I: Integer;
begin
  S := TStringList.Create;
  Reg := TRegistry.Create;
  Memo1.Lines.BeginUpdate;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then
    begin
      showmessage('browser yok');
    end
    else
    begin
      Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', False);
      Reg.GetKeyNames( s ); // Temporary Get Folder Names...
      for I := 0 to S.Count - 1 do
      begin
        if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + s[i], false) then
        Memo1.Lines.Add(  Reg.ReadString('') );
        Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true); // Get back to the BrowserList root
      end;
    end;
  finally
    S.Free;
    Reg.CloseKey;
    Reg.Free;
    Memo1.Lines.EndUpdate;
  end;
end;


Bu aşağıdaki de görece daha kontrollü bir yapı... Idea


Uses Registry;

procedure ListBrowsers( aList: TStrings );
var
  Reg : TRegistry;
  idx : Integer;
begin
  aList.Clear;
  Reg := TRegistry.Create;
  try
    Reg.Access  := KEY_WOW64_64KEY or KEY_ALL_ACCESS;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    if not Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then Exit;
    Reg.GetKeyNames( aList ); // Temporary Get Folder Names...
    for idx := 0 to pred( aList.Count ) do
    begin
      if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + aList[idx], false) then
        aList[idx] :=  Reg.ReadString(''); // Read Friendly Name
      Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true); // Get back to the BrowserList root
    end;
  finally
    Reg.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBrowsers( Memo1.Lines );
end;



Hocam listeleme gelmedi. 

Daha önce aşağıdaki kodlarla bir kez çalıştı. Ama bir daha çalışmadı bir kez listeleme yapabilmiştim.



function GetDefaultBrowser: string;
var
  Reg: TRegistry;
begin
  Result := '';
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', False) then
      Result := Reg.ReadString('')
    else
    begin
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', False) then
        Result := Reg.ReadString('')
    end;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + Result, False) then
      Result := Reg.ReadString('');
  finally
    Reg.Free;
  end;
end;

Procedure ListRegisteredBrowsers(List: TStrings);
var
  Reg: TRegistry;
  ki: TRegKeyInfo;
  i: Integer;
  keyname: string;
  len: DWORD;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then
      Exit;
    if not Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', False) then
      raise Exception.Create('ListRegisteredBrowsers: Could not open registry key.');
    if not Reg.GetKeyInfo(ki) then
      raise Exception.Create('ListRegisteredBrowsers: Could not obtain registry key information.');
    List.Clear;
    SetLength(keyname, len);
    for i := 0 to ki.NumSubKeys - 1 do
    begin
      len := ki.MaxSubKeyLen + 1;
      if RegEnumKeyEx(Reg.CurrentKey, i, PChar(keyname), len, nil, nil, nil, nil) <> ERROR_SUCCESS then
        RaiseLastOSError;
      if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + keyname, False) then
        List.Add(Reg.ReadString(''));
      Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true);
    end;
  finally
    Reg.Free;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
  i: Integer;
  DefBrw: string;
begin
  DefBrw := GetDefaultBrowser;
  sl := TStringList.Create;
  try
    ListRegisteredBrowsers(sl);
    Memo1.Lines.BeginUpdate;
    for i := 0 to sl.Count - 1 do
      if SameText(sl[i], DefBrw) then
        Memo1.Lines.Add(sl[i] + ' (Default)')
      else
        Memo1.Lines.Add(sl[i]);
    Memo1.Lines.EndUpdate;
  finally
    sl.Free;
  end;
end;
Cevapla
#5
Merhaba,
Konularımızı doğru kategorilerde açmaya özen gösterir isek daha iyi sonuçlar alabiliriz.
Konunuz genel programlama kategorisine taşınmıştır.
Cevapla
#6
@Altıner  projeniz yönetici olarak çalışmıyor olmalı.

aşağıdaki şekilde deneyin, read-only erişim yapar. Burada anahtarlarınız TRegistry.Create(KEY_READ) ve Reg.OpenKeyReadOnly


procedure ListBrowsers( aList: TStrings );
var
  Reg : TRegistry;
  idx : Integer;
begin
  aList.Clear;
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.Access  := KEY_WOW64_64KEY or KEY_ALL_ACCESS;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    if not Reg.OpenKeyReadOnly('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    Reg.GetKeyNames( aList ); // Temporary Get Folder Names...
    for idx := 0 to pred( aList.Count ) do
    begin
      if Reg.OpenKeyReadOnly('\SOFTWARE\Clients\StartMenuInternet\' + aList[idx] ) then
        aList[idx] :=  Reg.ReadString(''); // Read Friendly Name
      Reg.OpenKeyReadOnly('\SOFTWARE\Clients\StartMenuInternet'); // Get back to the BrowserList root
    end;
  finally
    Reg.Free;
  end;
end;




Kullanımı 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBrowsers( Memo1.Lines );
end;
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#7
(14-12-2020, Saat: 09:58)mrmarman Adlı Kullanıcıdan Alıntı: @Altıner  projeniz yönetici olarak çalışmıyor olmalı.

aşağıdaki şekilde deneyin, read-only erişim yapar. Burada anahtarlarınız TRegistry.Create(KEY_READ) ve Reg.OpenKeyReadOnly


procedure ListBrowsers( aList: TStrings );
var
  Reg : TRegistry;
  idx : Integer;
begin
  aList.Clear;
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.Access  := KEY_WOW64_64KEY or KEY_ALL_ACCESS;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    if not Reg.OpenKeyReadOnly('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    Reg.GetKeyNames( aList ); // Temporary Get Folder Names...
    for idx := 0 to pred( aList.Count ) do
    begin
      if Reg.OpenKeyReadOnly('\SOFTWARE\Clients\StartMenuInternet\' + aList[idx] ) then
        aList[idx] :=  Reg.ReadString(''); // Read Friendly Name
      Reg.OpenKeyReadOnly('\SOFTWARE\Clients\StartMenuInternet'); // Get back to the BrowserList root
    end;
  finally
    Reg.Free;
  end;
end;




Kullanımı 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBrowsers( Memo1.Lines );
end;

Teşekkür ederim Allah razı olsun. Yönetici olarak çalıştırmaya gerek kalmadı.
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  database dosyalarını listeleme akuyumcu63 3 214 28-05-2021, Saat: 11:00
Son Yorum: akuyumcu63
  İziBiz eFatura Listeleme MuhammedYasir 7 533 12-04-2021, Saat: 10:26
Son Yorum: mkysoft
  ComboBox1 Yan Yana Listeleme OZCANK 11 2.096 21-11-2020, Saat: 12:00
Son Yorum: OZCANK
  Failed to initialise Edge Browser Control hatası adeministrator 2 709 25-10-2020, Saat: 19:52
Son Yorum: adeministrator
  Veritabanı Dosyasındaki Dataları Listeleme bnyamin86 6 1.740 17-08-2020, Saat: 18:35
Son Yorum: bnyamin86



Konuyu Okuyanlar: 1 Ziyaretçi