TInstalledBrowsers - Komponente um Browser auszulesen

[MSSSSM]

Statt

Delphi-Quellcode:

procedure TBrowserInfo.OpenDocumentInBrowser(Document: string);
begin

 ShellExecute(Application.Handle, 'open', PChar(Binary), PChar(Document), nil, SW_SHOW);

end;

sollte hier

Delphi-Quellcode:

procedure TBrowserInfo.OpenDocumentInBrowser(Document: string);
begin

 ShellExecute(Application.Handle, 'open', PChar('"'+Binary+'"'), PChar(Document), nil, SW_SHOW);

end;

stehen.

[Andreas L.]

Zitat:

Zitat von MSSSSM

Statt

Delphi-Quellcode:

procedure TBrowserInfo.OpenDocumentInBrowser(Document: string);
begin

 ShellExecute(Application.Handle, 'open', PChar(Binary), PChar(Document), nil, SW_SHOW);

end;

sollte hier

Delphi-Quellcode:

procedure TBrowserInfo.OpenDocumentInBrowser(Document: string);
begin

 ShellExecute(Application.Handle, 'open', PChar('"'+Binary+'"'), PChar(Document), nil, SW_SHOW);

end;

stehen.

Das die Anführungszeichen beim Doukment übergeben werden sollten leuchtet mir ein. Kannst du begründen warum diese auch bei der Anwendung hin sollten?

[holliesoft]

Hi Andreas,

Zitat:

Zitat von Andreas L.

EDIT: Falls mir jemand helfen möchte: Ich brauche ein gutes Tutorial wie man auf SQLite Datenbanken zugreift. Chrome und Firefox 3 verwenden diese um Cookies zu speichern...

Ich kann immer wieder nur den Wrapper vonhttp://www.itwriting.com/blog/a-simp...r-for-sqlite-3 empfehlen.

Den benutze ich selbst für diverse Tools, die ich mir für meine Arbeit geschrieben habe (Datenauswertungen).

Zugriff erfolgt über ein TSQLitedatabase-Objekt, dass bei Abfrage mit einer GetTable(SQL: String)-Methode ein TSQLiteTable-Objekt mit den Daten zurückliefert.

Hier ein Beispiel (Schnell aus dem Gedächtnis abgetippt):

Delphi-Quellcode:

procedure ReadData;
var
  db: TSQLiteDatabase;
  table: TSQLiteTable;
  SQL: String;
  ListItem: TListItem;
begin
  db := TSQLiteDatabase.Create(DatenbankPfad);
  SQL := 'Select Vorname, Name, Anschrift, PLZ, Ort from Adressen order by Name';
  table := db.GetTable(sql);
  DatenListView.Items.Clear;
  if table.RowCount > 0 then
  begin
     table.MoveFirst;
     repeat
       ListItem := DatenListView.Items.Add;
       ListItem.Caption := Table.AsString(1);
       ListItem.SubItems.Add(Table.AsString(0));
       ListItem.SubItems.Add(Table.AsString(2));
       ListItem.SubItems.Add(Table.AsString(3));  
       ListItem.SubItems.Add(Table.AsString(4));
       table.next;
     until table.eof;
  end;
end;

Gruß,
Patrick

//edit: fehlende ) im Quelltext ergänzt :oops:

[Andreas L.]

Danke hollie :thumb: Sieht ja richtig einfach aus. Werde dann mal ein bisschen rumprobieren ;-)

[BlueStarHH]

Tolles Projekt! Aber: Unter Vista wird kein Firefox 3.0.4 bei mir erkannt. Es wird nur angezeigt, dass der IE installiert ist.

[Andreas L.]

Zitat:

Zitat von BlueStarHH

Tolles Projekt! Aber: Unter Vista wird kein Firefox 3.0.4 bei mir erkannt. Es wird nur angezeigt, dass der IE installiert ist.

Freut mich wenns dir gefällt. Ich überarbeite diese Komponente aktuell, werde den Fehler schon finden ;-) Leider konnte ich meinen Zeitplan nicht ganz einhalten, sollte aber nicht mehr lange dauern. Stay tuned :!:

[Florian H]

Bei "Default Browser" zeigt mir die Demo-App den IE an. Das ist jedoch eine dreiste Lüge, ich habe Opera als Standardbrowser, es werden auch alle Links, URLs aus fremden Anwendungen und *.htm(l)-Dokumente in Opera geöffnet.

[Andreas L.]

Zitat:

Zitat von Florian H

Bei "Default Browser" zeigt mir die Demo-App den IE an. Das ist jedoch eine dreiste Lüge, ich habe Opera als Standardbrowser, es werden auch alle Links, URLs aus fremden Anwendungen und *.htm(l)-Dokumente in Opera geöffnet.

Ist in der neuen Version bereits behoben. Trotzdem Danke für die Meldung :thumb: und fürs testen :-)

[torud]

Bei mir wird gar nix als Standardbrowser angezeigt. Alles ist leer, obwohl ich den FireFox als Standard habe. Beim Rekompoilieren der Demo erhalte ich die Fehlermeldung, dass die ntdll.dll vermisst wird.

Ich nutze D7 unter Windows XP Pro.

[Andreas L.]

Zitat:

Zitat von torud

Bei mir wird gar nix als Standardbrowser angezeigt. Alles ist leer, obwohl ich den FireFox als Standard habe. Beim Rekompoilieren der Demo erhalte ich die Fehlermeldung, dass die ntdll.dll vermisst wird.

Ich nutze D7 unter Windows XP Pro.

Hi, danke fürs testen. Wie schon gesagt, überarbeite ich die Komponente aktuell. Hier der aktuelle Source, die Demo-Anwendung kann man aber nicht mehr verwenden, weil sich die Struktur von TInstalledBrowsers stark geändert hat.

BCInstalledBrowsers.pas

Delphi-Quellcode:

unit BCInstalledBrowsers;

interface

uses
  SysUtils, Classes, ContNrs, ShellAPI, BCUtils, Registry, Windows, IniFiles,
  Graphics, ShlObj;

type
  TBcBrowserInfo = class;
  TBcInstalledBrowsers = class;

  {$WARNINGS OFF}
  TBcBrowserInfo = class(TPersistent)
  private
    FName: String;
    FVersion: String;
    FFileName: String;
    FPublisher: String;
    FDefaultBrowser: Boolean;
  protected
    procedure Assign(Source: TBcBrowserInfo);
  public
    function IsRunning:Boolean;
    function GetIcon(Size: Cardinal = 32; Index: Cardinal = 0):TBitmap;
    function Kill:Boolean;
    function Open(Document: String = ''):Boolean;
  published
    property Name: String read FName;
    property Publisher: String read FPublisher;
    property FileName: String read FFileName;
    property Version: String read FVersion;
    property DefaultBrowser: Boolean read FDefaultBrowser;
  end;
  {$WARNINGS ON}  

  TBcInstalledBrowsers = class(TComponent)
  private
    FBrowsers: TObjectList;
    FGetVersionOnlyFromBinary: Boolean;
  protected
    function GetBrowser(Index: Integer):TBcBrowserInfo;
    function GetDefaultBrowserFileName:String;
    function Add(AName, AVersion, AFilename, APublisher: String):Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IsMozillaControlInstalled:Boolean;
    function IsIEControlInstalled:Boolean;
    procedure Refresh;
    function Count:Integer;
    function SetDefaultBrowser(Index: Integer; Arguments: String):Boolean;
    function GetBrowserByName(Name: String):TBcBrowserInfo;
    property Browsers[Index: Integer]:TBcBrowserInfo read GetBrowser; default;
  published
    property GetVersionOnlyFromBinary: Boolean read FGetVersionOnlyFromBinary
      write FGetVersionOnlyFromBinary;
  end;

implementation

{ TBcBrowserInfo }
procedure TBcBrowserInfo.Assign(Source: TBcBrowserInfo);
begin
  FName := Source.Name;
  FVersion := Source.Version;
  FFileName := Source.FileName;
  FPublisher := Source.Publisher;
  FDefaultBrowser := Source.DefaultBrowser;
end;

function TBcBrowserInfo.IsRunning:Boolean;
begin
  Result := processExists(ExtractFileName(FileName));
end;

function TBcBrowserInfo.GetIcon(Size: Cardinal = 32; Index: Cardinal = 0):TBitmap;
var
  ico: TIcon;
begin
  Result := TBitmap.Create;
  ico := TIcon.Create;
  ico.Handle  := GethIcon(FileName, Size, Index);
  Result.Width := ico.Width;
  Result.Height := ico.Height;
  Result.Canvas.Draw(0, 0, ico);
  ico.Free;  
end;

function TBcBrowserInfo.Kill:Boolean;
var
  Counter: Integer;
begin
  Counter := 0;
  while IsRunning or (Counter > 10) do
  begin
    KillProcess(ExtractFileName(FileName));
    Counter := Counter + 1;
  end;
  Result := not IsRunning;  
end;

function TBcBrowserInfo.Open(Document: string = ''):Boolean;
begin
  Result := ShellExecute(0, 'open', PChar(FileName), PChar(Document), nil, SW_SHOW) > 32;
end;

{ TBcInstalledBrowsers }
constructor TBcInstalledBrowsers.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBrowsers := TObjectList.Create;
  FGetVersionOnlyFromBinary := False;
end;

destructor TBcInstalledBrowsers.Destroy;
begin
  FBrowsers.Free;
  inherited Destroy;
end;

function TBcInstalledBrowsers.GetBrowser(Index: Integer):TBcBrowserInfo;
begin
  Result := FBrowsers[Index] as TBcBrowserInfo;
end;

function TBcInstalledBrowsers.Add(AName, AVersion, AFilename, APublisher: String):Integer;
var
  NewItem: TBcBrowserInfo;
begin
  Result := -1;
  if FileExists(ExtractFileNameFromShellString(AFilename)) and
    (AName <> '') and
    (AVersion <> '') then
  begin
    NewItem := TBcBrowserInfo.Create;
    NewItem.FName := AName;
    NewItem.FVersion := AVersion;
    NewItem.FPublisher := APublisher;
    NewItem.FFileName := ExtractFileNameFromShellString(AFileName);
    NewItem.FDefaultBrowser := LowerCase(GetDefaultBrowserFileName) = LowerCase(AFilename);
    Result := FBrowsers.Add(NewItem);
  end;
end;

function TBcInstalledBrowsers.GetDefaultBrowserFileName:String;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Reg.OpenKey('\http\shell\open\command', False);
    Result := Reg.ReadString('');
    Result := ExtractFileNameFromShellString(Result);
  finally
    Reg.Free;
  end;
end;

function TBcInstalledBrowsers.GetBrowserByName(Name: string):TBcBrowserInfo;
var
  iBrowser: Integer;
begin
  Result := TBcBrowserInfo.Create;
  for iBrowser := 0 to Count -1 do
  begin
    if pos(Name, Browsers[iBrowser].Name) > 0 then
    begin
      Result.Assign(Browsers[iBrowser]);
      Break;
    end;
  end; 
end;

function TBcInstalledBrowsers.IsMozillaControlInstalled:Boolean;
begin
  Result := ProgIDExists('Mozilla.Browser.1');
end;

function TBcInstalledBrowsers.IsIEControlInstalled:Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Count -1 do
  begin
    if Browsers[i].Name = 'Internet Explorer' then
    begin
      Result := StrToInt(Browsers[i].Version[1]) >= 4;
      Break;
    end;
  end;
end;

function TBcInstalledBrowsers.Count:Integer;
begin
  Result := FBrowsers.Count;
end;

function TBcInstalledBrowsers.SetDefaultBrowser(Index: Integer; Arguments: String):Boolean;
var
  Reg: TRegistry;
  tmp: String;
begin
  Reg := TRegistry.Create;
  Result := False;
  try
    if Count > Index then
    begin
      Reg.RootKey := HKEY_CLASSES_ROOT;
      Reg.OpenKey('\http\shell\open\command', True);
      if Arguments <> '' then
        tmp := '"' + Browsers[Index].FileName + '" ' + Arguments
      else
        tmp := Browsers[Index].FileName;
      Reg.WriteString('', tmp);
      Result := True;
    end;
  finally
    Reg.Free;
  end;
end;

procedure TBcInstalledBrowsers.Refresh;
var
  Reg: TRegistry;
  Versions: TStrings;
  iKey: Integer;
  tmp, PathToExe: String;
  Ini: TMemIniFile;
begin
  FBrowsers.Clear;
  Reg := TRegistry.Create(KEY_READ);
  Versions := TStringList.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;

    { Mozilla Firefox }
    if Reg.OpenKey('\SOFTWARE\Mozilla\Mozilla Firefox', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if Reg.OpenKey('\SOFTWARE\Mozilla\Mozilla Firefox\' + Versions[iKey] + '\Main', False) then
        begin
          if GetVersionOnlyFromBinary then
            tmp := BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory')) + 'firefox.exe')
          else
          begin
            tmp := Versions[iKey];
            tmp := Copy(tmp, 1, pos('(', tmp) - 1);
          end;
          Add('Mozilla Firefox', tmp, IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory')) + 'firefox.exe', 'Mozilla Foundation');
        end;
      end;
    end;

   { Internet Explorer }
   if not GetVersionOnlyFromBinary then
   begin
     if Reg.OpenKey('\SOFTWARE\Microsoft\Internet Explorer', False) then
       tmp := Reg.ReadString('Version');
   end
   else
     tmp := BCUtils.GetVersion(IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_PROGRAM_FILES)) + 'Internet Explorer\iexplore.exe');
   Add('Internet Explorer', tmp, IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_PROGRAM_FILES)) + 'Internet Explorer\iexplore.exe', 'Microsoft Corporation');

   { Mozilla Seamonkey }
    if Reg.OpenKey('\SOFTWARE\mozilla.org\SeaMonkey', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if Reg.OpenKey('\SOFTWARE\mozilla.org\SeaMonkey\' + Versions[iKey] + '\Main', False) then
        begin
        PathToExe := IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory')) + 'seamonkey.exe';
          if GetVersionOnlyFromBinary then
            tmp := BCUtils.GetVersion(PathToExe)
          else
          begin
            if Reg.OpenKey('\SOFTWARE\mozilla.org\Seamonkey\' + Versions[iKey] + '\Uninstall', False) then
            begin
              tmp := Reg.ReadString('Description');
              tmp := StringReplace(tmp, 'Seamonkey', '', [rfIgnoreCase]);
              tmp := StringReplace(tmp, '(', '', []);
              tmp := StringReplace(tmp, ')', '', []);
              tmp := StringReplace(tmp, ' ', '', [rfReplaceAll]);
            end;
          end;
          Add('Mozilla Seamonkey', tmp, PathToExe, 'Mozilla Foundation');
        end;
      end;
    end;

   { Beonex Communicator }
    if Reg.OpenKey('\SOFTWARE\Beonex\Beonex Communicator', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if Reg.OpenKey('\SOFTWARE\Beonex\Beonex Communicator\' + Versions[iKey] + '\Main', False) then
        begin
          PathToExe := IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory')) + 'beonex-comm.exe';
          if GetVersionOnlyFromBinary then
            tmp := BCUtils.GetVersion(PathToExe)
          else
          begin
            if Reg.OpenKey('\SOFTWARE\Beonex\Beonex Communicator\' + Versions[iKey] + '\Uninstall', False) then
            begin
              tmp := Reg.ReadString('Description');
              tmp := StringReplace(tmp, 'Beonex Communicator', '', [rfIgnoreCase]);
              tmp := StringReplace(tmp, '(', '', []);
              tmp := StringReplace(tmp, ')', '', []);
              tmp := StringReplace(tmp, ' ', '', [rfReplaceAll]);
            end;
          end;
          Add('Beonex Communicator', tmp, PathToExe, 'Beonex');
        end;
      end;
    end;

    { Flock }
    if Reg.OpenKey('\SOFTWARE\Flock\Flock', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if Reg.OpenKey('\SOFTWARE\Flock\Flock\' + Versions[iKey] + '\Main', False) then
        begin
          if GetVersionOnlyFromBinary then
            tmp := BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory') + 'flock.exe'))
          else
          begin
            tmp := Versions[iKey];
            Delete(tmp, pos('(', tmp), pos(')', tmp));
            tmp := StringReplace(tmp, ' ', '', [rfReplaceAll]);
          end;
          Add('Flock', tmp, IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory')) + 'flock.exe', 'Flock Inc.');
        end;
      end;
    end;

    { SlimBrowser }
    if Reg.OpenKey('\SOFTWARE\FlashPeak\SlimBrowser', False) then
      Add('SlimBrowser', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('')) + 'sbrowser.exe'), IncludeTrailingPathDelimiter(Reg.ReadString('')) + 'sbrowser.exe', 'FlashPeak Inc.');

    { Netscape }
    if Reg.OpenKey('\SOFTWARE\Netscape\Netscape', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if Reg.OpenKey('\SOFTWARE\Netscape\Netscape\' + Versions[iKey] + '\Main', False) then
        begin
          if GetVersionOnlyFromBinary then
            tmp := BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory') + 'Netscp.exe'))
          else
          begin
            if Reg.OpenKey('\SOFTWARE\Netscape\Netscape\' + Versions[iKey] + '\Uninstall', False) then
            begin
              tmp := Reg.ReadString('Description');
              tmp := StringReplace(tmp, 'Netscape', '', [rfIgnoreCase]);
              tmp := StringReplace(tmp, '(', '', []);
              tmp := StringReplace(tmp, ')', '', []);
              tmp := StringReplace(tmp, ' ', '', [rfReplaceAll]);
            end;
          end;
          Add('Netscape Navigator', tmp, IncludeTrailingPathDelimiter(Reg.ReadString('Install Directory')) + 'Netscp.exe', 'Netscape Communications Corporation');
        end;
      end;
    end;

    { MyBrowser }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MyBrowser.exe', False) then
    begin
      if GetVersionOnlyFromBinary then
        tmp := BCUtils.GetVersion(Reg.ReadString(''))
      else
      begin
        if Reg.OpenKey('\SOFTWARE\SoftOrange Interactive\MyBrowser\', False) then
        begin
          Reg.GetKeyNames(Versions);
          tmp := Versions[0];
        end;
      end;
      Add('MyBrowser', tmp, Reg.ReadString(''), 'SoftOrange Interactive');
    end;

    { Amaya }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\Amaya.exe', False) then
    begin
      if GetVersionOnlyFromBinary then
        tmp := BCUtils.GetVersion(Reg.ReadString(''))
      else
      begin
        if Reg.OpenKey('\SOFTWARE\W3C - INRIA\Amaya\', False) then
        begin
          Reg.GetKeyNames(Versions);
          tmp := Versions[0];
        end;
      end;
      Add('Amaya', tmp, Reg.ReadString(''), 'W3C');
    end;

    { BrownIE }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\BrownIE.exe', False) then
      Add('BrownIE', BCUtils.GetVersion(Reg.ReadString('')), Reg.ReadString(''), 'Compunet WebWorks');

    { GOIAS }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\goias.exe', False) then
      Add('Goias', BCUtils.GetVersion(Reg.ReadString('')), Reg.ReadString(''), 'G.O. International Air Service');

    { InetPlus }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\inetplus.Exe', False) then
      Add('InetPlus', BCUtils.GetVersion(Reg.ReadString('')), Reg.ReadString(''), 'Dean Software Design');

    { Maxthon 2 }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Maxthon2', False) then
      Add('Maxthon 2', BCUtils.GetVersion(Reg.ReadString('DisplayIcon')), Reg.ReadString('DisplayIcon'), 'Maxthon International Limited');

    { GreenBrowser }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if pos('GreenBrowser', Versions[iKey]) > 0 then
        begin
          if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + Versions[iKey], False) then
            Add('GreenBrowser', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('InstallLocation')) + 'GreenBrowser.exe'), IncludeTrailingPathDelimiter(Reg.ReadString('InstallLocation')) + 'GreenBrowser.exe', 'MoreQuickTools');
          Break;
        end;
      end;
    end;

    { HotJava Browser }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\HotJava Browser', False) then
      Add('HotJava Browser', BCUtils.GetVersion(ExtractFilePath(ExtractFileNameFromShellString(Reg.ReadString('UninstallString'))) + 'hotjava.exe'), ExtractFilePath(ExtractFileNameFromShellString(Reg.ReadString('UninstallString'))) + 'hotjava.exe', 'Sun Microsystems Inc.');

    { Shareon }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if pos('Shareon', Versions[iKey]) > 0 then
        begin
          if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + Versions[iKey], False) then
            Add('Shareon', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('Inno Setup: App Path')) + 'Shareon.exe'), IncludeTrailingPathDelimiter(Reg.ReadString('Inno Setup: App Path')) + 'Shareon.exe', 'PLUSPLUS Co., Ltd.');
          Break;
        end;
      end;
    end;

    { AOLBrowser }
    if Reg.OpenKey('\SOFTWARE\America Online\Products\AOL Explorer', False) then
    begin
      Reg.GetKeyNames(Versions);
      for iKey := 0 to Versions.Count -1 do
      begin
        if Reg.OpenKey('\SOFTWARE\America Online\Products\AOL Explorer\' + Versions[iKey] + '\', False) then
        begin
          if GetVersionOnlyFromBinary then
            tmp := BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('BrowserInstallFolder')) + 'AOLExplorer.exe')
          else
            tmp := Versions[iKey];
          Add('AOL Explorer', tmp, IncludeTrailingPathDelimiter(Reg.ReadString('BrowserInstallFolder')) + 'AOLExplorer.exe', 'America Online LLC');
        end;
      end;
    end;

    { Multi-Browser XP }
    if Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\MultiBrowser.exe', False) then
      Add('Multi-Browser XP', BCUtils.GetVersion(Reg.ReadString('')), Reg.ReadString(''), 'Binh Nguyen-Huu');

    { Opera }
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\SOFTWARE\Opera Software', False) then
      Add('Opera', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('Last Directory3')) + 'opera.exe'), IncludeTrailingPathDelimiter(Reg.ReadString('Last Directory3')) + 'opera.exe', 'Opera Software ASA');

    { K-Meleon }
    if Reg.OpenKey('\SOFTWARE\K-Meleon\General', False) then
      Add('K-Meleon', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('InstallDir')) + 'k-meleon.exe'), IncludeTrailingPathDelimiter(Reg.ReadString('InstallDir')) + 'k-meleon.exe', 'K-Meleon project');

    { AvantBrowser }
    if Reg.OpenKey('\SOFTWARE\Avant Browser', False) then
      Add('Avant Browser', IncludeTrailingPathDelimiter(Reg.ReadString('InstallPath')) + 'avant.exe', IncludeTrailingPathDelimiter(Reg.ReadString('InstallPath')) + 'avant.exe', 'Avant Force');

    { AcooBrowser }
    if Reg.OpenKey('\SOFTWARE\AcooBrowser\Acoo Browser\', False) then
      Add('AccoBrowser', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Reg.ReadString('Install_Dir')) + 'AcooBrowser.exe'), IncludeTrailingPathDelimiter(Reg.ReadString('Install_Dir')) + 'AcooBrowser.exe', 'Acoo Browser');

    { Safari }
    Reg.RootKey := HKEY_CLASSES_ROOT;
    if Reg.OpenKey('\SafariDownload\shell\open\command', False) then
      Add('Safari', BCUtils.GetVersion(ExtractFileNameFromShellString(Reg.ReadString(''))), Reg.ReadString(''), 'Apple Inc.');

    { PowerBrowser }
    if FileExists(IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_WINDOWS)) + 'WEBSTATN.INI') then
    begin
      Ini := TMemIniFile.Create(IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_WINDOWS)) + 'WEBSTATN.INI');
      Add('PowerBrowser', BCUtils.GetVersion(IncludeTrailingPathDelimiter(Ini.ReadString('Setup', 'WiseInstallDir32', '')) + 'BROWSE95.EXE'), IncludeTrailingPathDelimiter(Ini.ReadString('Setup', 'WiseInstallDir32', '')) + 'BROWSE95.EXE', 'Oracle Corporation');
      Ini.Free;
    end;

    { Google Chrome }
    if FileExists(IncludeTrailingPathDelimiter(GetSpecialBrowserFolder(FID_GOOGLE_CHROME_APP)) + 'chrome.exe') then
      Add('Chrome', BCUtils.GetVersion(IncludeTrailingPathDelimiter(GetSpecialBrowserFolder(FID_GOOGLE_CHROME_APP)) + 'chrome.exe'), IncludeTrailingPathDelimiter(GetSpecialBrowserFolder(FID_GOOGLE_CHROME_APP)) + 'chrome.exe', 'Google Inc.');

  finally
    Reg.Free;
    Versions.Free;
  end;
end;

end.

BCUtils.pas:

Delphi-Quellcode:

unit BCUtils;

interface

uses
  Windows, Classes, SysUtils, ShlObj, ActiveX, WindowsVersionInfo, TLHelp32,
  StrUtils;

  function GetSpecialBrowserFolder(ID: Integer):String;
  function ReverseStringByPair(AText: String; APairSize: Integer):String;
  function RemoveBaseDir(Path, BaseDir: String):String;
  function GoOneDirUp(Path: String):String;
  function GetDirectorySize(Path: String):Int64;
  function GetFileSize(FileName: String):Integer;
  function ExtractFileNameFromShellString(Value: String):String;  
  procedure DeleteEmptyDirectories(Path: String);
  function GetShellFolder(CSIDL: integer): string;
  function HexStrToString(const value:string):string;
  function EncodeURL(URL: String):String;
  function DecodeURL(URL: String):String;
  function ExpandFileNameEx(Base, FileName: String):String;
  function ExcludeBeginningPathDelimiter(Path: String):String;
  function FileTimeStringsToDateTime(Low, High: String):TDateTime;
  function FileTimeToDateTime(FileTime:TFileTime):TDateTime;
  function DateTimeToFileTime(Value: TDateTime):TFileTime;
  function GethIcon(FileName: String; icoSize: Cardinal; icoIndex: integer = 0): Cardinal;
  function GetVersion(FileName: string):String;
  function ProgIDExists(const ProgID:WideString):Boolean;
  function KillProcess(const ExeName: String):Boolean;
  function processExists(exeFileName: string): Boolean;
  function GetCurrentUserName:string;
  procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
  function Like(const AString, APattern: String): Boolean;

const
  { Avant Browser }
  FID_AVANT_PROFILES                  = 1;

  { Google Chrome }
  FID_GOOGLE_CHROME                   = 11;
  FID_GOOGLE_CHROME_APP               = 12; { Application Files (.exe, ...) }
  FID_GOOGLE_CHROME_USERDATA          = 13; { Profiles }
  FID_GOOGLE_CHROME_PLUGINS           = 14;

  { Microsoft Internet Explorer }
  FID_IE_COOKIES                      = 21;
  FID_IE_FAVORITES                    = 22;
  FID_IE_CACHE                        = 23;
  FID_IE_HISTORY                      = 24;
  FID_IE_QUICKLAUNCH                  = 25; { Links in Windows TaskBar }
  FID_IE_DHTMLBEHAVIORS               = 26; { UserData directory }
  FID_IE_DHTMLBEHAVIORS_LOW           = 27; { " -  WinVista, IE without admin rights}
  FID_IE_COOKIES_LOW                  = 28;

  { Mozilla Firefox }
  FID_MOZILLA_FF_PROFILES             = 31;

  { Flock }
  FID_FLOCK_PROFILES                  = 41;

  { Mozilla Seamonkey/Suite }
  FID_MOZILLA_PROFILES                = 51;
  FID_MOZILLA_EXTENSIONS              = 52;

  { Opera }
  FID_OPERA_PROFILE                   = 61;
  FID_OPERA_PROFILE_FEEDS             = 62;
  FID_OPERA_PROFILE_WIDGETS           = 63;
  FID_OPERA_PROFILE_CACHE             = 64;
  FID_OPERA_PROFILE_IMAGES            = 65;
  FID_OPERA_MAIL                      = 66;

  { K-Meleon }
  FID_KMELEON_PROFILES                = 71;

  { Flash }
  FID_FLASH_SHAREDOBJECTS             = 81;

  { Netscape }
  FID_NETSCAPE_PROFILES               = 91;

  { Safari }
  FID_APPLE_SAFARI                    = 101;

  { Beonex Communicator }
  FID_BEONEX_PROFILES                 = 111;

  CSIDL_PROGRAM_FILES                 = $0026; {C:\Program Files\}
  CSIDL_WINDOWS                       = $0024; {C:\Windows\}

implementation

{ utility methods }
function GetSpecialBrowserFolder(ID: Integer):String;
var
  WinVer: TWindowsVersionInfo;
begin
  case ID of
    { Avant Browser }
    FID_AVANT_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Avant Profiles\';

    { Google Chrome }
    FID_GOOGLE_CHROME: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Google\Chrome\';
    FID_GOOGLE_CHROME_APP: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Google\Chrome\Application\';
    FID_GOOGLE_CHROME_USERDATA: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Google\Chrome\User Data\';
    FID_GOOGLE_CHROME_PLUGINS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Google\Chrome\Plugins\';

    { Microsoft Internet Explorer }
    FID_IE_COOKIES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_COOKIES));
    FID_IE_FAVORITES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_FAVORITES));
    FID_IE_CACHE: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_INTERNET_CACHE));
    FID_IE_HISTORY: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_HISTORY));
    FID_IE_QUICKLAUNCH: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Microsoft\Internet Explorer\Quick Launch\';
    FID_IE_DHTMLBEHAVIORS:
    begin
      WinVer := TWindowsVersionInfo.Create(nil);
      if WinVer.MajorVersion = 5 then
        Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_PROFILE)) + 'UserData\'
      else
        Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Microsoft\Internet Explorer\UserData\';
      WinVer.Free;
    end;
    FID_IE_DHTMLBEHAVIORS_LOW: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Microsoft\Internet Explorer\UserData\Low\';
    FID_IE_COOKIES_LOW: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_COOKIES)) + 'Low\';

    { Mozilla Firefox }
    FID_MOZILLA_FF_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Mozilla\Firefox\Profiles\';

    { Flock }
    FID_FLOCK_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Mozilla\Flock\Profiles\';

    { Mozilla Seamonkey/Suite }
    FID_MOZILLA_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Mozilla\Profiles\';
    FID_MOZILLA_EXTENSIONS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Mozilla\Extensions\';

    { Opera }
    FID_OPERA_PROFILE: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Opera\Opera\profile\';
    FID_OPERA_PROFILE_FEEDS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Opera\Opera\profile\webfeeds\';
    FID_OPERA_PROFILE_WIDGETS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Opera\Opera\profile\widgets';
    FID_OPERA_PROFILE_CACHE: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Opera\Opera\profile\cache4\';
    FID_OPERA_PROFILE_IMAGES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Opera\Opera\profile\images\';
    FID_OPERA_MAIL: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_LOCAL_APPDATA)) + 'Opera\Opera\mail\';

    { K-Meleon }
    FID_KMELEON_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'K-Meleon\';

    { Flash }
    FID_FLASH_SHAREDOBJECTS: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA) + 'Macromedia\Flash Player\#SharedObjects\');

    { Netscape }
    FID_NETSCAPE_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Netscape\Profiles\';

    { Safari }
    FID_APPLE_SAFARI: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Apple Computer\Safari\';

    { Beonex Communicator }
    FID_BEONEX_PROFILES: Result := IncludeTrailingPathDelimiter(GetShellFolder(CSIDL_APPDATA)) + 'Beonex\Profiles\';
  else
    Result := IncludeTrailingPathDelimiter(GetShellFolder(ID));
  end;

  if not DirectoryExists(Result) then
    Result := '';
end;

function ReverseStringByPair(AText: String; APairSize: Integer):String;
var
  i, x, CharIndex: Integer;
begin
  CharIndex := 1;
  Result := '';
  for i := Length(AText) div APairSize downto 1 do
  begin
    for x := 1 to APairSize do
      Result := Result + AText[CharIndex + x];
    CharIndex := CharIndex + APairSize;
  end;
end;

function RemoveBaseDir(Path, BaseDir: String):String;
begin
  Result := StringReplace(Path, BaseDir, '', [rfIgnoreCase]);
  if Result[1] = PathDelim then
    Result := Copy(Result, 2, Length(Result) - 1);
end;

function GoOneDirUp(Path: String):String;
begin
  Result := ExcludeTrailingPathDelimiter(Path);
  Result := ExtractFilePath(Result);
end;

function GetDirectorySize(Path: String):Int64;
var
  Files: TStrings;
  i: Integer;
begin
  Files := TStringList.Create;
  FindAllFiles(Files, Path, '*', True, False, True);
  Result := 0;
  for i := 0 to Files.Count -1 do
    Result := Result + GetFileSize(Files[i]);
  Files.Free;  
end;

function GetFileSize(FileName: String):Integer;
var
  FileHandle: THandle;
begin
  FileHandle := CreateFile(PChar(FileName), GENERIC_READ, 0, nil,
    OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := Windows.GetFileSize(FileHandle, nil);
  if Result < 0 then
    Result := 0;
  CloseHandle(FileHandle);
end;

function ExtractFileNameFromShellString(Value: String):String;
begin
  Result := Value;
  if not FileExists(Result) then
  begin
    Result := Copy(Result, pos('"', Result) + 1, posEx('"', Result, pos('"', Result) + 1) - 2);
    if not FileExists(Result) then
      Result := '';
  end;
end;

procedure DeleteEmptyDirectories(Path: String);
var
  iFolder, iFile: Integer;
  Folders, Files: TStrings;
begin
  Folders := TStringList.Create;
  FindAllFiles(Folders, Path, '*', False, True, True);
  for iFolder := Folders.Count -1 downto 0 do
  begin
    Files := TStringList.Create;
    FindAllFiles(Files, Folders[iFolder], '*', True, True, True);
    for iFile := Files.Count -1 downto 0 do
    begin
      if DirectoryExists(Files[iFile]) then
        DeleteEmptyDirectories(Path);
    end;
    if Files.Count > 0 then
      RemoveDir(Folders[iFolder]);
    Files.Free;
  end;
  Folders.Free;
end;

function HexStrToString(const value:string):string;
begin
   SetLength(Result, Length(value) div 2);
   if Length(value) > 0 then
      HexToBin(PChar(value), PChar(Result), Length(value));
end;

function EncodeURL(URL: String):String;
begin
  Result := URL;
  Result := StringReplace(Result, ' ', '%20', [rfReplaceAll]);
  Result := StringReplace(Result, '!', '%21', [rfReplaceAll]);
  Result := StringReplace(Result, '"', '%22', [rfReplaceAll]);
  Result := StringReplace(Result, '$', '%24', [rfReplaceAll]);
  Result := StringReplace(Result, '''', '%27', [rfReplaceAll]);
  Result := StringReplace(Result, '(', '%28', [rfReplaceAll]);
  Result := StringReplace(Result, ')', '%29', [rfReplaceAll]);
  Result := StringReplace(Result, '*', '%2A', [rfReplaceAll]);
  Result := StringReplace(Result, '+', '%2B', [rfReplaceAll]);
  Result := StringReplace(Result, ';', '%3B', [rfReplaceAll]);
  Result := StringReplace(Result, '<', '%3C', [rfReplaceAll]);
  Result := StringReplace(Result, '>', '%3E', [rfReplaceAll]);
  Result := StringReplace(Result, '@', '%40', [rfReplaceAll]);
  Result := StringReplace(Result, '[', '%5B', [rfReplaceAll]);
  Result := StringReplace(Result, ']', '%5D', [rfReplaceAll]);
  Result := StringReplace(Result, '^', '%5E', [rfReplaceAll]);
  Result := StringReplace(Result, '{', '%7B', [rfReplaceAll]);
  Result := StringReplace(Result, '|', '%7C', [rfReplaceAll]);
  Result := StringReplace(Result, '}', '%7D', [rfReplaceAll]);
end;

function DecodeURL(URL: String):String;
var
  temp: String;
  EOS: Boolean;  //end of string ;-)
begin
  EOS := False;
  temp := URL;
  while not EOS do
  begin
    Result := Result + Copy(temp, 1, pos('%', temp) - 1);
    Result := Result + HexStrToString(Copy(temp, pos('%', temp) + 1, 2));
    Delete(temp, 1, pos('%', temp) + 2);
    if pos('%', temp) = 0 then
    begin
      Result := Result + temp;
      EOS := True;
    end;
  end;
end;

function ExpandFileNameEx(Base, FileName: String):String;
begin
  Result := IncludeTrailingPathDelimiter(Base) +
            ExcludeBeginningPathDelimiter(FileName);
end;

function ExcludeBeginningPathDelimiter(Path: String):String;
var
  AllRemoved: Boolean;
begin
  Result := Path;
  AllRemoved := False;
  while not AllRemoved do
  begin
    if (Result[1] = '\') or (Result[1] = '/') then
      Delete(Result, 1, 1)
    else
      AllRemoved := True;
  end;
end;

function FileTimeStringsToDateTime(Low, High: String):TDateTime;
var
  ft: TFileTime;
begin
  ft.dwLowDateTime := StrToInt64(Low);
  ft.dwHighDateTime := StrToInt64(High);
  Result := FileTimeToDateTime(ft);
end;

function FileTimeToDateTime(FileTime: TFileTime):TDateTime;
var
  LocalTime: TFileTime;
  SystemTime: TSystemTime;
begin
  Result := EncodeDate(1900,1,1);
  if FileTimeToLocalFileTime(FileTime, LocalTime) then
    if FileTimeToSystemTime(LocalTime, SystemTime) then
      Result := SystemTimeToDateTime(SystemTime);
end;

function DateTimeToFileTime(Value: TDateTime):TFileTime;
var
  SystemTime: TSystemTime;
begin
  DateTimeToSystemTime(Value, SystemTime);
  SystemTimeToFileTime(systemtime, Result);
end;

{ ThirdParty routines }
function GethIcon(FileName: String; icoSize: Cardinal; icoIndex: integer = 0): Cardinal;
var DeskTopISF: IShellFolder; IExIcon: IExtractIcon; PathPidl: PItemIDList; hIconL, hIconS: HIcon;
begin
  Result := 0;
  if SHGetDesktopFolder(DeskTopISF) <> NOERROR then Exit;
  PathPidl := nil;
  if DeskTopISF.GetUIObjectOf(0, 1, PathPidl, IID_IExtractIconA, nil, IExIcon) <> NOERROR then Exit;
  if (IExIcon.Extract(PChar(FileName), icoIndex, hIconL, hIconS,
    icoSize or (16 shl 16)) = NOERROR) and (hIconL <> 0) then Result := hIconL;
  DestroyIcon(hIconS);
end; { unknown author}

function processExists(exeFileName: string): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  Result := False;
  while Integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
      UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
      UpperCase(ExeFileName))) then
    begin
      Result := True;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end; { unknown author}

function KillProcess(const ExeName: String):Boolean;
var
  Process: TProcessEntry32;
  h: THandle;
begin
  Result := False;
  Process.dwSize := SizeOf(Process);
  h := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  try
   if Process32First(h, Process) then
    repeat
     if AnsiLowerCase(Process.szExeFile) = AnsiLowerCase(ExeName) then Result := TerminateProcess(OpenProcess(Process_Terminate, False, Process.th32ProcessID), 0);
    until (not Process32Next(h, Process)) or Result;
  finally
   CloseHandle(h);
  end;
end; { unknown author}

{$WARNINGS OFF}
function GetVersion(FileName: string):String;
var
  VerInfoSize, VerValueSize, Dummy: DWord;
  VerInfo           : Pointer;
  VerValue          : PVSFixedFileInfo;
  Major, Minor, Release, Build: DWORD;  
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  if VerInfoSize <> 0 then
  begin
    GetMem(VerInfo, VerInfoSize);
    try
      GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, VerInfo);
      if VerInfo <> nil then
      begin
        if VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize) then
        begin
          with VerValue^ do
          begin
            Major := dwFileVersionMS shr 16;
            Minor := dwFileVersionMS and $FFFF;
            Release := dwFileVersionLS shr 16;
            Build := dwFileVersionLS and $FFFF;
          end;
        end;
      end;
    finally
      FreeMem(VerInfo, VerInfoSize);
    end;
  end;
  Result := Format('%d.%d.%d.%d', [major, Minor, Release, Build]);
end; { Manuel Faux }
{$WARNINGS ON}

function ProgIDExists(const ProgID:WideString):Boolean;
var
  tmp : TGUID;
begin
  Result := Succeeded(CLSIDFromProgID(PWideChar(ProgID), tmp));
end; { Michael Puff }

function GetCurrentUserName:string;
const
  cnMaxUserNameLen = 254;
var
  sUserName: string;
  dwUserNameLen: DWORD;
begin
  dwUserNameLen := cnMaxUserNameLen - 1;
  SetLength(sUserName, cnMaxUserNameLen);
  GetUserName(PChar(sUserName), dwUserNameLen);
  SetLength(sUserName, dwUserNameLen);
  Result := sUserName;
end; { unknown author }

procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
  procedure LFindAllFiles(AParentFolder: String);
  var LSearchRec: TSearchRec;
  begin
    if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then
    begin
      repeat
        if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
        begin
          if LSearchRec.Attr and faDirectory = faDirectory then
          begin
            if AddFolderNames and
               (IgnoreMaskAtFolderNames or Like(AnsiLowerCase(LSearchRec.Name), Mask)) then
              FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              LFindAllFiles(AParentFolder + LSearchRec.Name + '\');
          end
          else if Like(AnsiLowerCase(LSearchRec.Name), Mask) then
            FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False));
        end;
      until FindNext(LSearchRec) <> 0;
      FindClose(LSearchRec);
    end;
  end;
begin
  Mask := AnsiLowerCase(Mask);
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end; {Michael Puff & SirThornberry}

function GetShellFolder(CSIDL: integer): string;
var
  pidl                   : PItemIdList;
  FolderPath             : string;
  SystemFolder           : Integer;
  Malloc                 : IMalloc;
begin
  Malloc := nil;
  FolderPath := '';
  SHGetMalloc(Malloc);
  if Malloc = nil then
  begin
    Result := FolderPath;
    Exit;
  end;
  try
    SystemFolder := CSIDL;
    if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then
    begin
      SetLength(FolderPath, max_path);
      if SHGetPathFromIDList(pidl, PChar(FolderPath)) then
      begin
        SetLength(FolderPath, length(PChar(FolderPath)));
      end;
    end;
    Result := IncludeTrailingPathDelimiter(FolderPath);
  finally
    Malloc.Free(pidl);
  end;
end; { Michael Puff }

function Like(const AString, APattern: String): Boolean;
var
  StringPtr, PatternPtr: PChar;
  StringRes, PatternRes: PChar;
begin
  Result:=false;
  StringPtr:=PChar(AString);
  PatternPtr:=PChar(APattern);
  StringRes:=nil;
  PatternRes:=nil;
  repeat
    repeat // ohne vorangegangenes "*"
      case PatternPtr^ of
        #0: begin
          Result:=StringPtr^=#0;
          if Result or (StringRes=nil) or (PatternRes=nil) then
            Exit;
          StringPtr:=StringRes;
          PatternPtr:=PatternRes;
          Break;
        end;
        '*': begin
          inc(PatternPtr);
          PatternRes:=PatternPtr;
          Break;
        end;
        '?': begin
          if StringPtr^=#0 then
            Exit;
          inc(StringPtr);
          inc(PatternPtr);
        end;
        else begin
          if StringPtr^=#0 then
            Exit;
          if StringPtr^<>PatternPtr^ then begin
            if (StringRes=nil) or (PatternRes=nil) then
              Exit;
            StringPtr:=StringRes;
            PatternPtr:=PatternRes;
            Break;
          end
          else begin
            inc(StringPtr);
            inc(PatternPtr);
          end;
        end;
      end;
    until false;
    repeat // mit vorangegangenem "*"
      case PatternPtr^ of
        #0: begin
          Result:=true;
          Exit;
        end;
        '*': begin
          inc(PatternPtr);
          PatternRes:=PatternPtr;
        end;
        '?': begin
          if StringPtr^=#0 then
            Exit;
          inc(StringPtr);
          inc(PatternPtr);
        end;
        else begin
          repeat
            if StringPtr^=#0 then
              Exit;
            if StringPtr^=PatternPtr^ then
              Break;
            inc(StringPtr);
          until false;
          inc(StringPtr);
          StringRes:=StringPtr;
          inc(PatternPtr);
          Break;
        end;
      end;
    until false;
  until false;
end; {Michael Winter}

end.

Lizenz: GPL