Datei suchen u. Path dann in die Registry schreiben

[MathiasSimmack]

Wirklich? Ich kam mir schon so ausgeschlossen vor:

Zitat:

Wir sind hier leider keine Hellseher ...

So, als würde ich gar nicht mehr dazu gehören.

Also, m-werk -

Mein Vorschlag wäre, dass du die eigentliche Suchroutine in eine eigene Prozedur einklammerst. Das ist der beste Weg, da sich diese Prozedur für jedes Unterverzeichnis wieder selbst aufrufen muss. Schließlich willst du ja nicht nur das Hauptverzeichnis C:\ sondern auch C:\Programme usw. durchsuchen?!

Ich schlage vor, dass du dieser Prozedur den Root-Pfad immer mit übergibst und diesen Wert nie änderst. Das passiert natürlich programmtechnisch und würde z.B. (s. for-Schleife in meinem letzten AUQ-Posting) so aussehen:

Code:

for i  := 2 to 25 do
  // Laufwerk muss existieren und dem
  // gewünschten Typ entsprechen
  if(DriveExists(i)) and (IsHD(i)) then
    // es muss möglich sein, auf das Laufwerk
    // zu wechseln
    if(SetCurrentDir(CHR(i + BYTE('A')) + ':\')) then
      begin
        // rekursive Suchfunktion aufrufen
        scanit(CHR(i + BYTE('A')) + ':\');

        // die Suche abbrechen, wenn die Datei
        // gefunden wurde
        if(found) then break;
      end;

In der Suchprozedur stellst du dann als erstes fest, wie das aktuelle Verzeichnis heißt, und in der letzten Zeile der Funktion vergleichst du das aktuelle Verzeichnis mit dem übergebenen Root-Pfad. Sind sie unterschiedlich, springst du wieder eine Ebene nach oben.

Wozu?

Das hat mit der Funktion an sich zu tun. Deine Suche startet z.B. in C:\, und die Funktion findet jetzt z.B. das Programme-Verzeichnis. Also wechselt sie in diesen Ordner und ruft sich selbst wieder auf, um die Suche fortzusetzen.
Jetzt mal angenommen, es gäbe keine Unterordner mehr. Wenn die Funktion die gesuchte Datei nicht findet, steckt sie im Programme-Ordner fest, und die Suche würde nicht mehr weitergehen, bzw. keine Ergebnisse mehr liefern. Du musst also wieder eine Ebene nach oben ins Hauptverzeichnis C:\ springen, damit dann z.B. der Windows-Ordner gefunden und durchsucht werden kann. usw. usw.

Code:

procedure scanit(orgPath: string);
var
  path : string;
begin
  path := GetCurrentDir;

  // Suchfunktion
  // kommt gleich, und muss HIER REIN!!!

  if(Path <> orgPath) then ChDir('..');
end;

Nun zur Suche. Grundlegend kann (!) eine FindFirst/FindNext-Suche so aussehen:

Code:

var
  res : integer;
  ds  : TSearchRec;
begin
  res  := FindFirst('*.*',faAnyFile,ds);
  while(res = 0) do
    begin
      // Anzeige des aktuellen Dateinamens/Verzeichnisses
      // im Label der Form
      Form1.Label1.Caption := path + '\' + ds.Name;

      // ist der Dateiname mit dem Suchnamen identisch?
      if(lowercase(ds.Name) = lowercase(szSearchFile)) and
        (ds.Attr and faDirectory = 0) then
      begin
        // Ja!
        Found := true;
      end
      // Nein, es ist aber ein Unterverzeichnis.
      // Also, rein da, & weitersuchen!
      else if(ds.Attr and faDirectory <> 0) and
        (ds.Name <> '.') and (ds.Name <> '..') then
      begin
        SetCurrentDir(ds.Name);
        scanit(orgPath);
      end;

      // die Suche ist beendet!
      if(Found) then break;

      res := FindNext(ds); 
    end;
    FindClose(ds);

  {mal empfehlenswert ->} Application.ProcessMessages;
end;

Es gibt auch noch andere Varianten mit repeat-until, aber ich persönlich benutze seit vergangenen TurboPASCAL-Tagen diese while-Konstruktion.
Du siehst hier auch gleich meine Bool-Variable. Wenn sie auf TRUE gesetzt wird, wird die Schleife verlassen. Logisch! Die Datei wurde ja gefunden, jede weitere Suche wäre Zeitverschwendung. Du solltest wirklich auch break verwenden, damit FindClose in jedem Fall aufgerufen wird. exit wäre zum Verlassen der Schleife zwar möglich, aber nicht empfehlenswert. Übrigens darf die Bool-Variable keine lokale Variable der Prozedur "scanit" sein!

Übrigens, schöner Nebeneffekt: bei mir benötigte die Funktion beim ersten Durchlauf ca. 10 Sekunden, um auf einem Athlon mit 1GHz die Laufwerke C-H mit insgesamt 26.685 Dateien und 2.206 Ordnern zu durchsuchen. (Ich habe extra mal nach einem Programm auf der H-Partition suchen lassen!)
Das Ganze scheint irgendwie und irgendwo gecacht zu werden, denn jeder weitere Durchlauf benötigte nur noch ca 1.6 Sekunden.

Gruß,
Mathias.

[m-werk]

Danke für die ausführliche beschreibung. Ich hab nur ein kleines Problem damit.
In welche Procedure setze ich den 1. und den 3. Code?

Ich habe den 3 Code in den Button 'Suchen' gesetzt. Ich bin mir aber nicht sicher, ob das auch richtig ist.

[MathiasSimmack]

Also ich habe eine Funktion geschrieben, die "Suchen" heißt und so deklariert ist:

Code:

procedure Suchen(const szSearchFile: string);

In dieser ... hm, eigentlich ist´s ja eine: Prozedur stecken die Routinen

• DriveExists
• IsHD
• scanit

als untergeordnete Funktionen/Prozeduren. Ach was soll´s. So sieht sie komplett aus:

Code:

procedure Suchen(const szSearchFile: string);
var
  Found            : boolean;
  iFiles, iFolders : integer;

  function DriveExists(DriveByte: Byte): Boolean;
  begin
    Result := GetLogicalDrives and (1 shl DriveByte) <> 0;
  end;

  function IsHD(DriveByte: Byte): boolean;
  begin
    case GetDriveType(pchar(CHR(DriveByte + BYTE('A')) + ':\')) of
      // Festplatten
      DRIVE_FIXED,
      // gemappte Netzlaufwerke
      DRIVE_REMOTE,
      // CD-ROM-Laufwerke
      DRIVE_CDROM:
        Result := true;
      else
        Result := false;
    end;
  end;

  procedure scanit(orgPath: string);
  var
    path : string;
    res  : integer;
    ds   : TSearchRec;
  begin
    path := GetCurrentDir;
    res  := FindFirst('*.*',faAnyFile,ds);
    while(res = 0) do
      begin
        // Anzeige des aktuellen Dateinamens/Verzeichnisses
        // im Label der Form
        Form1.Label1.Caption := path + '\' + ds.Name;

        // ist der Dateiname mit dem Suchnamen identisch?
        if(ds.Attr and faDirectory = 0) then
          begin
            inc(iFiles);
            if(lowercase(ds.Name) = lowercase(szSearchFile)) then Found := true;
          end
        // Nein, es ist aber ein Unterverzeichnis.
        // Also, rein da, & weitersuchen!
        else if(ds.Attr and faDirectory <> 0) and
          (ds.Name <> '.') and (ds.Name <> '..') then
        begin
          inc(iFolders);
          SetCurrentDir(ds.Name);
          scanit(orgPath);
        end;

        // die Suche ist beendet!
        if(Found) then break;

        res := FindNext(ds);
      end;
    FindClose(ds); Application.ProcessMessages;

    if(path <> orgPath) then ChDir('..');
  end;

var
  i       : integer;
  dwTime  : dword;
begin
  found         := false;
  iFiles        := 0;
  iFolders      := 0;
  Screen.Cursor := crHourglass;

  dwTime        := GetTickCount;

  // da üblicherweise die Buchstaben A & B für Disketten
  // reserviert sind, kann die Schleife bei C beginnen
  // 2 + 65 (ASCII-Code für A) = 67 (ASCII-Code für C)
  for i  := 2 to 25 do
    // Laufwerk muss existieren und dem
    // gewünschten Typ entsprechen
    if(DriveExists(i)) and (IsHD(i)) then
      // es muss möglich sein, auf das Laufwerk
      // zu wechseln
      if(SetCurrentDir(CHR(i + BYTE('A')) + ':\')) then
        begin
          // rekursive Suchfunktion aufrufen
          scanit(CHR(i + BYTE('A')) + ':\');

          // die Suche abbrechen, wenn die Datei
          // gefunden wurde
          if(found) then break;
        end;

  dwTime               := GetTickCount - dwTime;
  Form1.Label2.Caption := inttostr(dwTime) + ' msec';
  Form1.Label3.Caption := inttostr(iFiles) + ' Dateien, ' +
    inttostr(iFolders) + ' Ordner durchsucht';

  Screen.Cursor := crDefault;
  // nichts gefunden, Label leeren
  if(not(found)) then Form1.Label1.Caption := '';
  Form1.Button2.Enabled := found;
end;

Und du rufst bei deinem Suchen-Button nur diese Funktion auf:

Code:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Suchen('Kundendaten.mdb');
end;

Ich habe noch drei Labels. Label1 ist das, wo bei dir dann wohl auch der Name angezeigt werden soll. Die beiden anderen sind nur zur Anzeige der Zeit und der Anzahl der Dateien/Ordner, weil ich halt wissen wollte, wie lange das dauert.

[m-werk]

Hi, vielen Dank für deine bemühungen.

Code:

procedure TForm1.SuchenClick(Sender: TObject);
begin
  Suchen('Kundendaten.mdb');
end;

Bei diesem Code kommen folgende Fehlermeldungen:
Bei 'Suchen(' steht der Cursor nach der Klammer und die fehlermeldung lautet:
Operator oder Semikolon fehlt

Und zum Schluss dieser Zeile 'Anweisung erforderlich, aber Ausdruck vom Typ 'TButton' gefunden'

Ich habe dann bei 'Suchen:=('Kundendaten.....' eingegeben

Nun kommt nur mehr eine Meldung:
[Fehler] DBsuche.pas(171): Inkompatible Typen: 'TButton' und 'String'

Mit dieser kann ich leider nichts anfangen

[MathiasSimmack]

Zitat:

Zitat von m-werk

Mit dieser kann ich leider nichts anfangen

Ich schon. Es liegt auf der Hand, wenn du dir mal deinen Code ansiehst:

Code:

// Der Button, auf den du klickst, heißt "Suchen"
procedure TForm1.SuchenClick(Sender: TObject);
begin
  // Die Funktion, die du aufrufst, heißt AUCH "Suchen"
  Suchen('Kundendaten.mdb');
end;

Da ich ja nicht wissen konnte, wie du deinen Button nennst, habe ich meiner Funktionen einen recht eindeutigen Namen gegeben, der nun -sinnigerweise- mit dem deines Buttons identisch ist. Also kommen sich beide in die Quere.

Zwei Möglichkeiten:

• Du nennst den Button um, etwa "SuchenBtn", "Search", "SearchBtn" ...
• Du gibst der Prozedur "Suchen" einen neuen Namen, etwa
  
  Code:

  procedure DatenbankSuchen(const szSearchFile: string);

  Du musst dann natürlich im "OnClick"-Ereignis des Buttons dann auch den neuen Prozedurnamen benutzen, sonst ändert sich an der Fehlermeldung nichts. :wink:

[m-werk]

Hi, danke, das mit dem Suchen funktioniert jetzt prima.

Ich hab nur noch ein kleines anliegen. Wenn ich jetzt auf Aktualisieren klicke, dann wird jetzt der Wert, der im Label steht richtig in die Registry geschrieben.
Dabei ist mir jetzt eines aufgefallen.
Im Label steht z.B. C:\Arius\Datenbank\Kundendaten.mdb

Wenn ich jetzt den Label in die Registry hineinstelle, dann steht dort auch der Wert C:\Arius\Datenbank\Kundendaten.mdb

Ich möchte aber jetzt nur in der Registry stehen haben C:\Arius\Datenbank

Wie kann ich das jetzt noch machen, dass die Datei nicht mit übernommen wird?

[MrSpock]

Hallo m-werk,

dazu gibt es die Funktion:

Code:

function ExtractFilePath(const FileName: string): string;

diese gibt als Ergebnis nur den Pfad zurück, der in FileName enthalten ist.

[m-werk]

Hi, und wo baue ich diesen code ein?

Zum Aktualisieren sieht mein Code so aus:

Code:

procedure TForm1.AktualisierenClick(Sender: TObject);
var
REG:TRegistry;
b:string;
begin
b:=Form1.Label4.Caption;
  REG:=TRegistry.Create;
  try
    REG.RootKey := HKEY_CURRENT_USER;
    if REG.OpenKey('Software\AriusDB\SettingsDB', True) then
      begin
      REG.WriteString('DBPath', b);
      end;
    finally
      REG.CloseKey;
      REG.Free;
    end;
end;

[MrSpock]

Hallo m-werk,

Code:

...
begin
  b:=Form1.Label4.Caption;
  REG:=TRegistry.Create;
  try
    REG.RootKey := HKEY_CURRENT_USER;
    if REG.OpenKey('Software\AriusDB\SettingsDB', True) then
      begin
      REG.WriteString('DBPath', ExtractFilePath(b));
      end;
    finally
      REG.CloseKey;
      REG.Free;
    end;
end;

oder

Code:

...
begin
  b:=ExtractFilePath(Form1.Label4.Caption);
  REG:=TRegistry.Create;
  try
    REG.RootKey := HKEY_CURRENT_USER;
    if REG.OpenKey('Software\AriusDB\SettingsDB', True) then
      begin
      REG.WriteString('DBPath', b);
      end;
    finally
      REG.CloseKey;
      REG.Free;
    end;
end;

Dabei sollte aber sicher gestellt sein, dass Label4 immer einen gültigen Dateinamen (inkl. Pfad) enthält.

[m-werk]

Hi, danke und was ist jetzt mit dieser Funktion:

Code:

function ExtractFilePath(const FileName: string): string;

Benötige ich diese auch noch? Wenn ja, wo setze ich diese hinein?