Kontrola wersji. Przydatne

@Adam Boduch Dzięki powiadomienie - teraz jest klarowne. Rzeczywiście dwa razy umieściłem ten sam post, ale nie wiem, czy jeszcze raz nie zerwie mi się połączenie lub coś innego po drodze.

unit _0001_Version_info;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls, DBCtrls, DB, Mask, ADODB, Grids,
  DBGrids, DBTables, Menus, ShellApi, FileCtrl, UExtension;

type
  TFileVersionRecord = record
    ExeDir: string;
    ExeName: string;
    ExeLastModifDate: TDateTime;
    strComputerDateTime: string;
    strHDSerial: string;
    BuildInfo1: string;
    BuildInfo2: string;
  end;

//CC1D - 929B
procedure FillExeFileInfo(var richEdit: TRichEdit; var hd_serial: string); overload;
procedure FillExeFileInfo(var Memo: TMemo; var hd_serial: string); overload;
function GetHDSerialNumber: string;
function FileVersion1(AFileName: string): string;
function FileVersion2(const FileName: TFileName): String;
function GetFileModDate(filename : string) : TDateTime;

implementation
//
{$IFDEF undef}{$REGION 'FillExeFileInfo_XP_2014_01_25'}{$ENDIF}
//
procedure FillExeFileInfo(var richEdit: TRichEdit; var hd_serial: string);
var
  FileVersionRecord: TFileVersionRecord;
begin
  FileVersionRecord.ExeDir := ExtractFilePath(Application.ExeName);
  FileVersionRecord.ExeName := ExtractFileName(Application.ExeName);
  FileVersionRecord.ExeLastModifDate := GetFileModDate(Application.ExeName);
  FileVersionRecord.strComputerDateTime := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
  FileVersionRecord.strHDSerial := GetHDSerialNumber;
  FileVersionRecord.BuildInfo1 := FileVersion1(Application.ExeName);
  FileVersionRecord.BuildInfo2 := FileVersion2(Application.ExeName);
  richEdit.Text := '';
  richEdit.Lines.Add('ExeDir: ' + FileVersionRecord.ExeDir);
  richEdit.Lines.Add('ExeName: ' + FileVersionRecord.ExeName);
  richEdit.Lines.Add('ComputerDate: ' + FileVersionRecord.strComputerDateTime);
  richEdit.Lines.Add('ExeFileDate: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', FileVersionRecord.ExeLastModifDate));
  richEdit.Lines.Add('HDSerial: ' + FileVersionRecord.strHDSerial);
  richEdit.Lines.Add('BuildInfo: ' + FileVersionRecord.BuildInfo1);
  hd_serial := FileVersionRecord.strHDSerial;
end;

procedure FillExeFileInfo(var Memo: TMemo; var hd_serial: string);
var
  FileVersionRecord: TFileVersionRecord;
begin
  FileVersionRecord.ExeDir := ExtractFilePath(Application.ExeName);
  FileVersionRecord.ExeName := ExtractFileName(Application.ExeName);
  FileVersionRecord.ExeLastModifDate := GetFileModDate(Application.ExeName);
  FileVersionRecord.strComputerDateTime := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
  FileVersionRecord.strHDSerial := GetHDSerialNumber;
  FileVersionRecord.BuildInfo1 := FileVersion1(Application.ExeName);
  FileVersionRecord.BuildInfo2 := FileVersion2(Application.ExeName);
  Memo.Text := '';
  Memo.Lines.Add('ExeDir: ' + FileVersionRecord.ExeDir);
  Memo.Lines.Add('ExeName: ' + FileVersionRecord.ExeName);
  Memo.Lines.Add('ComputerDate: ' + FileVersionRecord.strComputerDateTime);
  Memo.Lines.Add('ExeFileDate: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss', FileVersionRecord.ExeLastModifDate));
  Memo.Lines.Add('HDSerial: ' + FileVersionRecord.strHDSerial);
  Memo.Lines.Add('BuildInfo: ' + FileVersionRecord.BuildInfo1);
  hd_serial := FileVersionRecord.strHDSerial;
end;
//
function GetHDSerialNumber: string;
var
  VolumeSerialNumber : DWORD;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
  SerialNumber : string;
  Drive : PChar;
begin
    Drive := PChar('C:\');
    GetVolumeInformation(
        Drive,
        nil,
        0,
        @VolumeSerialNumber,
        MaximumComponentLength,
        FileSystemFlags,
        nil,
        0) ;
   SerialNumber :=
         IntToHex(HiWord(VolumeSerialNumber), 4) +
         ' - ' +
         IntToHex(LoWord(VolumeSerialNumber), 4) ;
   Result := SerialNumber;
end;
//
function GetFileModDate(filename : string) : TDateTime;
var
  F : TSearchRec;
begin
  FindFirst(filename, faAnyFile, F);
  Result := FileDateToDatetime(F.Time);
  FindClose(F);
end;
//
{$IFDEF undef}{$REGION 'ExeInfoAndBuildInfo_XP_2014_01_25'}{$ENDIF}
//
{$IFDEF undef}{$REGION 'BuildInfo_XP_2014_01_25'}{$ENDIF}
//
//2014-01-25 BEGIN Równoważne sposoby odczytania BuildInfo//
//
//2014-01-25 Używana wersja BuildInfo
//
function FileVersion1(AFileName: string): string;
var
  szName: array[0..255] of Char;
  P: Pointer;
  Value: Pointer;
  Len: UINT;
  GetTranslationString: string;
  FFileName: PChar;
  FValid: boolean;
  FSize: DWORD;
  FHandle: DWORD;
  FBuffer: PChar;
begin
  FBuffer := #0;
  FSize := DWORD(0);
  FFileName := #0; 
  try
    FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
    FValid := False;
    FSize := GetFileVersionInfoSize(FFileName, FHandle);
    if FSize > 0 then
    try
      GetMem(FBuffer, FSize);
      FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
    except
      FValid := False;
      raise;
    end;
    Result := '';
    if FValid then
      VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len)
    else
      p := nil;
    if P <> nil then
      GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)),
        LoWord(Longint(P^))), 8);
    if FValid then
    begin
      StrPCopy(szName, '\StringFileInfo\' + GetTranslationString +
        '\FileVersion');
      if VerQueryValue(FBuffer, szName, Value, Len) then
        Result := StrPas(PChar(Value));
    end;
  finally
    try
      if FBuffer <> nil then
        FreeMem(FBuffer, FSize);
    except
    end;
    try
      StrDispose(FFileName);
    except
    end;
  end;
end;
//
//2014-01-25 Nieużywana wersja BuildInfo
//
function FileVersion2(const FileName: TFileName): String;
var
  VerInfoSize: Cardinal;
  VerValueSize: Cardinal;
  Dummy: Cardinal;
  PVerInfo: Pointer;
  PVerValue: PVSFixedFileInfo;
begin
  Result := '';
  VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  GetMem(PVerInfo, VerInfoSize);
  try
    if GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, PVerInfo) then
      if VerQueryValue(PVerInfo, '\', Pointer(PVerValue), VerValueSize) then
        with PVerValue^ do
          Result := Format('v%d.%d.%d build %d', [
            HiWord(dwFileVersionMS), //Major
            LoWord(dwFileVersionMS), //Minor
            HiWord(dwFileVersionLS), //Release
            LoWord(dwFileVersionLS)]); //Build
  finally
    FreeMem(PVerInfo, VerInfoSize);
  end;
end;
//
//2014-01-25 END Równoważne sposoby odczytania BuildInfo//
//
{$IFDEF undef}{$ENDREGION}{$ENDIF}
//
{$IFDEF undef}{$ENDREGION}{$ENDIF}
//
{$IFDEF undef}{$ENDREGION}{$ENDIF}
//
end.

@Artur Protasewicz:

Może jakiś opis co to w ogóle jest?
Po sensownym opisaniu tego być może miejsce na to będzie w Kompendium, nie na forum.