Einzelnen Beitrag anzeigen

daPimP

Registriert seit: 27. Okt 2006
25 Beiträge
 
#8

Re: aus Registry Werten den Dateinamen und Pfad ermitteln

  Alt 24. Mai 2007, 00:35
So, meine Lösung funktioniert soweit.

Ich habe den Code auskommentiert und ein OpenSourceProject daraus gemacht.

Hier der Link: OpenSource

Bild

Für faule hier ein Ausschnitt (Das Projekt laden= besser, weil macht die Sache auch recht anschaulich)

Delphi-Quellcode:
(*Prüft den String und versucht, den Klarpfad anzuzeigen*)
function DATEIOPEN(Pfad: String): string;
var
  FileName,Directory: string;
  ExecuteFileName: array[0..Max_Path] of char;
  i: Integer;
begin
  // Pfad-string zerlegen wenn möglich
  FileName:=extractfilename(Pfad) ;
  Directory:= extractfilepath(Pfad) ;
  FillChar(ExecuteFileName, SizeOf(ExecuteFileName), ' ');

  //FindExecutabel versucht die Datei zu finden - alles unter 32 ist ein Fehler
  if SHELLAPI.FindExecutable(@FileName[1], @Directory[1], @ExecuteFileName[0]) > 32 then
    result:= ExecuteFileName
  else //bei Fehler
    result:= 'failed';
end;


(*Dateien ohne Verzeichnis werden hier wieder hergestellt
  Bsp: aus Antivir - wird C:\Windows\System32\Antivir.exe
  oder aus rundll32 C:\WINDOWS\LXBTtime.dll,_RunDLLEntry@16 - wird C:\WINDOWS\LXBTtime.dll
  Falls Parameter existieren, werden diese an Parameters übergeben*)

function FileFromRegistry(Memo: TMemo; str: string; out Parameters: string): string;
var
    i, Quotestart, QuoteEnd: integer;
    InQuote : boolean;
    Foundquotes : boolean;
    Sprungstelle : integer;
begin
 result:= str;
 //Datei im Klartext eingetragen
 if FileExists(result) then
   Exit;

 //Prüfe auf rundll32 oder rundll32.exe als loader
 if (Pos('rundll32', AnsilowerCase(str)) = 1) then begin
   if str[9]=' then
     str:= copy(str,10,length(str))
   else
     if (Pos('rundll32.exe', AnsilowerCase(str)) = 1) then
       if str[13]=' then
         str:= copy(str,14,length(str));
   result:= str;

   Memo.lines.add('rundll32 befreit: '+str);
   if FileExists(str) then
     Exit;
   //Prüfe ob Einsprungpunkt vorhanden (alles nach dem Komma)
   //Problem: Auch in Dateinamen dürfen Kommata vorkommen - ist aber unwahrscheinlich
   Sprungstelle:= Pos(',', str);
   if Sprungstelle >0 then begin
     str:= copy(str, 1, Sprungstelle-1);
     Memo.lines.add('Sprungstelle bereinigt: '+str);
   end;
 end;


 //Prüfe auf PATH-Variable (%...% und Verzeichnislose Konstrukte) (eventuelle PARAMETER noch nicht abgeschnitten)
 result:= DATEIOPEN(str);
 Memo.lines.add('DATEIOPEN (keine Parameterüberprüfung): '+result);
 if FileExists(Result) then
   Exit;


 //Prüfe auf Quotationmarks ("")
 InQuote := false;
 QuoteStart := 0;
 QuoteEnd := length(str);
 Foundquotes:= false;
          i := 0;
 while i <= length(str) do begin
   if str[i] = '"then begin
     FoundQuotes:= true;
     if InQuote= false then
       QuoteStart:= i
     else
       QuoteEnd:= i;
     InQuote := not InQuote;
   end;

   if (str[i] = ' ') and (not Inquote) then begin
     break;
   end;
   inc(i);
 end;
 //eventuelle Parameter vom Dateinamen trennen
 Parameters := Copy(str, i + 1, length(str));
 //Wenn Anführungszeichen gefunden "..." - eleminieren, sonst nur von eventuellen Parametern trennen
 if Foundquotes= true then
   str := Copy(str, 1+QuoteStart, quoteEnd-QuoteStart-1)
 else
   str := Copy(str, 1, i-1);
 Memo.lines.add('Parameterbereinigt: '+str);

 result:= str;
 if FileExists(result) then
   Exit;

 //Prüfe NOCHMAL auf PATH-Variable (%...% und Verzeichnislose Konstrukte) (HIER PARAMETER abgeschnitten)
 result:= DATEIOPEN(str);
 Memo.lines.add('DATEIOPEN (Parameterbereinigt): '+result);

 if FileExists(Result) then
   Exit
 else
   result:= 'Datei nicht gefunden!';

(*weitere Gedanken zum optimieren und verbessern:*)
(*Die Funktion ProcessPath zerlegt einen Pfad in Laufwerksbuchstaben-, Verzeichnisnamen- und Dateinamen-Teile.*)
(*um an alle virtuellen ordner ranzukommen - ShGetSpecialFolderLocation*)
(*SearchPath wäre auch noch interessant*)
end;
watch out ... SySSnapper... coming soon
  Mit Zitat antworten Zitat