DBR Delphi-Ecke

// Versionen von .NET Framework auslesen:

// Getestet mit D4 unter XP und W7

// Variante 1
// Ornerstruktur auflisten

procedure findDir(pfad: string; gefunden: TStrings); 
var sr: TWin32FindData; 
  h: THandle; 
begin 
  h := FindFirstFile(PChar(pfad + 'v*'), sr); 
  if h <> INVALID_HANDLE_VALUE then repeat 
      if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0) 
        then gefunden.add(sr.cFileName); 
    until Findnextfile(h, sr) = false; 
  windows.FindClose(h); 
end; 
 
procedure dotnet(gefunden: TStrings); 
var P: PChar; 
  s: string; 
begin 
  gefunden.clear; 
  getmem(p, max_path); 
  GetWindowsDirectory(p, max_path); 
  s := p; 
  freemem(p); 
  if ansilastchar(s) <> '\' then s := s + '\'; 
  finddir(s + 'Microsoft.NET\Framework\', gefunden); 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  dotnet(Listbox1.Items); 
  if Listbox1.Items.count = 0 then Listbox1.Items.add('nicht gefunden'); 
end;

//-------------------------------------------------------------

// Variante 2
// Nachteil bei Variante 1 ist, dass alle Versionen, die jemals auf
// dem Rechner waren, aufgelistet werden. Relevant sind aber nur noch
// 2.0, 3.0, 3.5 und 4.0, wobei die Letztere inzwischen unter W7
// mit der Version 4.5 ersetzt werden kann. Deshalb habe ich einen
// Code gebastelt, der dem Rechnung trägt.

uses Registry; 
 
procedure frameworks(gefunden: TStrings); 
const 
  vsn = 'Version'; 
  sls = '\SOFTWARE\Microsoft\NET Framework Setup\NDP\v'; 
var 
  Reg: TRegistry; 
  Zeiger: Pointer; 
  s, z, pfd: string; 
  PFixInfo: PVSFixedFileInfo; 
  Nll, InfoSize, FixInfo: DWord; 
  function fw35445(const vrsn: string): string; 
  begin 
    result := ''; 
    Reg := TRegistry.create; 
    try 
      Reg.RootKey := HKEY_LOCAL_MACHINE; 
      if vrsn = '4' then begin 
        z := '\Client'; 
        if not Reg.Keyexists(sls + vrsn + z) 
          then z := '\Full'; 
      end else z := ''; 
      if Reg.OpenKey(sls + vrsn + z, false) 
        then begin 
        if Reg.Valueexists(vsn) then 
          result := Reg.readstring(vsn); 
      end; 
    except 
      result := ''; 
    end; 
    Reg.CloseKey; 
    Reg.Free; 
  end; 
  procedure hinzufuegen; 
  begin 
    if s <> '' then gefunden.add(s); 
  end; 
  function GetFileVersion(FileName: TFilename): string; 
  begin 
    result := ''; 
    InfoSize := GetFileVersionInfoSize(PChar(Filename), nll); 
    if InfoSize > 0 then begin 
      Zeiger := GetMemory(InfoSize); 
      if assigned(Zeiger) then begin 
        GetFileVersionInfo(PChar(Filename), 0, InfoSize, Zeiger); 
        if VerQueryValue(Zeiger, '\', Pointer(PFixInfo), FixInfo) 
          then begin 
          result := Format('%d.%d.%d.%d', 
            [HiWord(PFixInfo^.dwFileVersionMS), 
            LoWord(PFixInfo^.dwFileVersionMS), 
              HiWord(PFixInfo^.dwFileVersionLS), 
              LoWord(PFixInfo^.dwFileVersionLS)]); 
        end; 
        FreeMemory(Zeiger); 
      end; 
    end; 
  end; 
begin 
  setlength(pfd, max_path); 
  gefunden.clear; 
  nll := 0; 
  setlength(pfd, GetWindowsDirectory(PChar(pfd), max_path)); 
  if ansilastchar(pfd) <> '\' then pfd := pfd + '\'; 
  pfd := pfd + 'Microsoft.NET\Framework\'; 
  s := GetFileVersion(pfd + 'v2.0.50727\mscorwks.dll'); 
  hinzufuegen; 
  s := GetFileVersion(pfd + 
    'v3.0\Windows Communication Foundation\Infocard.exe'); 
  hinzufuegen; 
  s := fw35445('3.5'); 
  hinzufuegen; 
  s := fw35445('4'); 
  hinzufuegen; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  frameworks(Memo1.Lines); 
end;