Зацикливание файлов в каталоге с помощью оболочки в Delphi - PullRequest
Новая
       18

Зацикливание файлов в каталоге с помощью оболочки в Delphi

2 голосов
/ 04 августа 2011

Я хочу перебрать все файлы в данном каталоге и вернуть их номер версии и имя exe. Я попытался покопаться в оболочке, чтобы посмотреть, смогу ли я справиться с этим, однако я не смог найти решение. Любые советы будут оценены.

1 Ответ

12 голосов
/ 04 августа 2011

Это делает это:

Бросьте TMemo и TButton на форму и сделайте 

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;

Скриншот http://privat.rejbrand.se/verinfo.png

...