Loop over files in a directory using the shell in delphi

Question

I want to loop through all the files in a given directory and return their version number and exe name. I have tried digging into the shell to see if I can pull this off, however I have not been able to find a solution. Any tips would be appreciated.

Answer 1

This does it:

Drop a TMemo and a TButton on your form and do

type
  TVerInfo = packed record
    vMajor, vMinor, vRelease, vBuild: word;
  end;

function GetFileVerNumbers(const FileName: string): TVerInfo;
var
  len, dummy: cardinal;
  verdata: pointer;
  verstruct: pointer;
const
  InvalidVersion: TVerInfo = (vMajor: 0; vMinor: 0; vRelease: 0; vBuild: 0);
begin
  len := GetFileVersionInfoSize(PWideChar(FileName), dummy);
  if len = 0 then
    Exit(InvalidVersion);
  GetMem(verdata, len);
  try
    GetFileVersionInfo(PWideChar(FileName), 0, len, verdata);
    VerQueryValue(verdata, '\', verstruct, dummy);
    result.vMajor := HiWord(TVSFixedFileInfo(verstruct^).dwFileVersionMS);
    result.vMinor := LoWord(TVSFixedFileInfo(verstruct^).dwFileVersionMS);
    result.vRelease := HiWord(TVSFixedFileInfo(verstruct^).dwFileVersionLS);
    result.vBuild := LoWord(TVSFixedFileInfo(verstruct^).dwFileVersionLS);
  finally
    FreeMem(verdata);
  end;
end;

function GetFileVer(const FileName: string): string;
begin
  with GetFileVerNumbers(FileName) do
    result := IntToStr(vMajor) + '.' +
      IntToStr(vMinor) + '.' + IntToStr(vRelease) + '.' +
      IntToStr(vBuild);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  path = 'C:\WINDOWS';
var
  SR: TSearchRec;
begin
  Memo1.Clear;
  if FindFirst(IncludeTrailingBackslash(path) + '*.exe', faAnyFile, SR) = 0 then
    try
      repeat
        Memo1.Lines.Add(SR.Name + #9 +
          GetFileVer(IncludeTrailingBackslash(path) + SR.Name));
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
end;