Code liefert keine Resultate in D2009

[Falcon37]

Weiß vielleicht irgend jemand, weshalb der folgende Code unter Delphi 2009
keine Resultate liefert, wenn er mit älteren Versionen kompiliert wird aber schon?

FUNCTION FileVersionInfo(CONST sAppNamePath : TFileName) : TFileVersionInfo;
VAR
  rSHFI : TSHFileInfo;
  iRet : INTEGER;
  VerSize : INTEGER;
  VerBuf : PChar;
  VerBufValue : POINTER;
  VerHandle : Cardinal;
  VerBufLen : Cardinal;
  VerKey : STRING;
  FixedFileInfo : PVSFixedFileInfo;

  // dwFileType, dwFileSubtype
  FUNCTION GetFileSubType(FixedFileInfo : PVSFixedFileInfo) : STRING;
  BEGIN
    CASE FixedFileInfo.dwFileType OF

      VFT_UNKNOWN : Result := 'Unknown';
      VFT_APP : Result := 'Application';
      VFT_DLL : Result := 'DLL';
      VFT_STATIC_LIB : Result := 'Static-link Library';

      VFT_DRV :
      CASE
        FixedFileInfo.dwFileSubtype OF
        VFT2_UNKNOWN : Result := 'Unknown Driver';
        VFT2_DRV_COMM : Result := 'Communications Driver';
        VFT2_DRV_Printer : Result := 'Printer Driver';
        VFT2_DRV_KEYBOARD : Result := 'Keyboard Driver';
        VFT2_DRV_LANGUAGE : Result := 'Language Driver';
        VFT2_DRV_DISPLAY : Result := 'Display Driver';
        VFT2_DRV_MOUSE : Result := 'Mouse Driver';
        VFT2_DRV_NETWORK : Result := 'Network Driver';
        VFT2_DRV_SYSTEM : Result := 'System Driver';
        VFT2_DRV_INSTALLABLE : Result := 'InstallableDriver';
        VFT2_DRV_Sound : Result := 'Sound Driver';
      END;
      VFT_Font :
      CASE FixedFileInfo.dwFileSubtype OF
        VFT2_UNKNOWN : Result := 'Unknown Font';
        VFT2_Font_RASTER : Result := 'Raster Font';
        VFT2_Font_VECTOR : Result := 'Vector Font';
        VFT2_Font_TRUETYPE : Result := 'Truetype Font';
        ELSE;
      END;
      VFT_VXD : Result := 'Virtual Defice Identifier = ' +
      IntToHex(FixedFileInfo.dwFileSubtype, 8);
    END;
  END;

  FUNCTION HasdwFileFlags(FixedFileInfo : PVSFixedFileInfo; Flag : WORD) : BOOLEAN;
  BEGIN
    Result := (FixedFileInfo.dwFileFlagsMask AND
    FixedFileInfo.dwFileFlags AND
    Flag) = Flag;
  END;

  FUNCTION GetFixedFileInfo : PVSFixedFileInfo;
  BEGIN
    IF NOT VerQueryValue(VerBuf, '', POINTER(Result), VerBufLen) THEN Result := NIL
  END;

  FUNCTION GetInfo(CONST aKey : STRING) : STRING;
  BEGIN
    Result := '';
    VerKey := Format('\StringFileInfo\%.4x%.4x\%s',
    [LoWord(INTEGER(VerBufValue^)),
    HiWord(INTEGER(VerBufValue^)), aKey]);
    IF VerQueryValue(VerBuf, PChar(VerKey),VerBufValue,VerBufLen) THEN Result := STRING(VerBufValue);
  END;

  FUNCTION QueryValue(CONST aValue : STRING) : STRING;
  Var Value : PChar;
  BEGIN
    Result := '';
    // obtain version information about the specified file
    IF GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) AND
    // return selected version information
  VerQueryValue(VerBuf, PChar('\VarFileInfo\Translation'), VerBufValue, VerBufLen) THEN Result := GetInfo(aValue);
  END;

BEGIN
  // Initialize the Result
  WITH Result DO BEGIN
    FileType := '';
    CompanyName := '';
    FileDescription := '';
    FileVersion := '';
    InternalName := '';
    LegalCopyRight := '';
    LegalTradeMarks := '';
    OriginalFileName := '';
    ProductName := '';
    ProductVersion := '';
    Comments := '';
    SpecialBuildStr := '';
    PrivateBuildStr := '';
    FileFunction := '';
    DebugBuild := FALSE;
    Patched := FALSE;
    PreRelease := FALSE;
    SpecialBuild := FALSE;
    PrivateBuild := FALSE;
    InfoInferred := FALSE;
  END;

  // Get the file type
  IF SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI),
  SHGFI_TYPENAME) <> 0 THEN Result.FileType := rSHFI.szTypeName;

  iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI), 0);
  IF iRet <> 0 THEN BEGIN
    // determine whether the OS can obtain version information
    VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
    IF VerSize > 0 THEN BEGIN
      VerBuf := AllocMem(VerSize);
      TRY
        WITH Result DO BEGIN
          CompanyName      := QueryValue('CompanyName');
          FileDescription  := QueryValue('FileDescription');
          FileVersion      := QueryValue('FileVersion');
          InternalName     := QueryValue('InternalName');
          LegalCopyRight   := QueryValue('LegalCopyRight');
          LegalTradeMarks  := QueryValue('LegalTradeMarks');
          OriginalFileName := QueryValue('OriginalFileName');
          ProductName      := QueryValue('ProductName');
          ProductVersion   := QueryValue('ProductVersion');
          Comments         := QueryValue('Comments');
          SpecialBuildStr  := QueryValue('SpecialBuild');
          PrivateBuildStr  := QueryValue('PrivateBuild');
          // Fill the  VS_FIXEDFILEINFO structure
          FixedFileInfo    := GetFixedFileInfo;
          DebugBuild       := HasdwFileFlags(FixedFileInfo,VS_FF_DEBUG);
          PreRelease       := HasdwFileFlags(FixedFileInfo,VS_FF_PRERELEASE);
          PrivateBuild     := HasdwFileFlags(FixedFileInfo,VS_FF_PRIVATEBUILD);
          SpecialBuild     := HasdwFileFlags(FixedFileInfo,VS_FF_SPECIALBUILD);
          Patched          := HasdwFileFlags(FixedFileInfo,VS_FF_PATCHED);
          InfoInferred     := HasdwFileFlags(FixedFileInfo,VS_FF_INFOINFERRED);
          FileFunction     := GetFileSubType(FixedFileInfo);
        END;
      FINALLY
        FreeMem(VerBuf, VerSize);
      END
    END;
  END
END;

[Fabian Classen]

Bist du mal mit dem Debugger durchgegangen?

MFG
Fabian

[tinof]

Hast du in den Projektoptionen unter "Versinsinformationen" den Haken "Versionsinformationen in das Projekt übernehmen" gesetzt ?
(Ich unterstelle, du willst die Infos deines eigenen Programms anzeigen).

Sonst sind keine Infos da und die Funktion liefert korrekt 'ich weiss von nix'.

Grüße
Tino

[Falcon37]

Bist du mal mit dem Debugger durchgegangen?

Kann ich leider nicht, weil wenn ich den Debugger aktiviere geht mein Delphi gar nicht mehr. Das kann ich erst in ein paar Monaten probieren, wenn ich meinen Rechner neu aufgesetzt habe.

[Falcon37]

Ich unterstelle, du willst die Infos deines eigenen Programms anzeigen.

Nein, ich will die Informationen von x-beliebigen Dateien sehen.

Wie gesagt, wenn ich den Code in Delphi 6.0 oder Delphi 2006 benutze funktioniert er einwandfrei, nur in der 2009er Version nicht.

[tinof]

Ok, also bei mir funktioniert der Code mit D2009.
Ich bin nur über das von mir genannte Problem 'gestolpert'.

Ansonsten geht's. In der Sysutils.pas findet sich zu GetFileVersionInfoSize noch dieser Schnipsel - vielleicht ist das einen Versuch wert. Aber wie gesagt, bei mir funktioniert es auch so

function GetFileVersion(const AFileName: string): Cardinal;
var
  FileName: string;
  InfoSize, Wnd: DWORD;
  VerBuf: Pointer;
  FI: PVSFixedFileInfo;
  VerSize: DWORD;
begin
  Result := Cardinal(-1);
  // GetFileVersionInfo modifies the filename parameter data while parsing.
  // Copy the string const into a local variable to create a writeable copy.
  FileName := AFileName;
  UniqueString(FileName);
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
  if InfoSize <> 0 then
  begin
    GetMem(VerBuf, InfoSize);
    try
      if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
        if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
          Result:= FI.dwFileVersionMS;
    finally
      FreeMem(VerBuf);
    end;
  end;
end;

Viel Erfolg, aber

wenn ich den Debugger aktiviere geht mein Delphi gar nicht mehr

Das ist imho auch eine Problemquelle.