Capture Date & Time at Build Time

I'd like to use the build date and time to generate a program version.  Is there
some way to capture the current date and time during the build and put them
in my program so that they would be available at execution time?  
RalphSCoffinAsked:
Who is Participating?
 
BlackTigerXConnect With a Mentor Commented:
here's the code for that unit... it doesn't have any copyright so...

unit PEStamp;

interface

uses
  Classes, SysUtils, Messages,
  ToolsApi;

type
  TPEStampNotifier = class(TNotifierObject, IOTAIDENotifier, IOTAIDENotifier50)
  private
    FLastTarget: string;
    function AppWindowHook(var Msg: TMessage): Boolean;
  protected
    { IOTAIDENotifier }
    procedure AfterCompile(Succeeded: Boolean); overload;
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    procedure FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
    { IOTAIDENotifier50 }
    procedure AfterCompile(Succeeded: Boolean; IsCodeInsight: Boolean); overload;
    procedure BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean); overload;
  public
    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  Windows, Registry, ImageHlp,
  Forms, StdCtrls;

// Delphi version conditional defines

// Thanks to Roland Turcan for assistance with Delphi 5 compatibility
// Thanks to Milos Veselovsky for assistance with Delphi 6 compatibility

{$IFDEF VER130}
  {$DEFINE DELPHI_5_UP}
{$ENDIF}
{$IFDEF VER140}
  {$DEFINE DELPHI_5_UP}
  {$DEFINE DELPHI_6_UP}
{$ENDIF}

{$IFDEF VER150}
  {$DEFINE DELPHI_5_UP}
  {$DEFINE DELPHI_6_UP}
  {$DEFINE DELPHI_7_UP}
{$ENDIF}

{$IFNDEF DELPHI_5_UP}
  Delphi 5 or higher required.
{$ENDIF}

{$IFNDEF DELPHI_6_UP}
const
  UnixDateDelta = 25569;

type
  TLoadedImage = _LOADED_IMAGE;

function ExcludeTrailingPathDelimiter(const S: string): string; forward;
function IncludeTrailingPathDelimiter(const S: string): string; forward;
{$ENDIF}

function GetActiveProjectGroup: IOTAProjectGroup;
var
  I: Integer;
begin
  Result := nil;

  with BorlandIDEServices as IOTAModuleServices do
    for I := 0 to ModuleCount - 1 do
      if Supports(Modules[I], IOTAProjectGroup, Result) then
        Exit;
end;

function GetActiveProject: IOTAProject;
var
  ProjectGroup: IOTAProjectGroup;
  I: Integer;
begin
  Result := nil;

  ProjectGroup := GetActiveProjectGroup;
  if Assigned(ProjectGroup) then
    Result := ProjectGroup.ActiveProject
  else
    with BorlandIDEServices as IOTAModuleServices do
      for I := 0 to ModuleCount - 1 do
        if Supports(Modules[I], IOTAProject, Result) then
          Break;
end;

// get Delphi root directory

function GetDelphiRootDirectory: string;
{$IFNDEF DELPHI_7_UP}
var
  Registry: TRegistry;
{$ENDIF}
begin
  {$IFDEF DELPHI_7_UP}
    Result := (BorlandIDEServices as IOTAServices).GetRootDirectory;
  {$ELSE}
    Registry := TRegistry.Create(KEY_READ);
    try
      if Registry.OpenKeyReadOnly((BorlandIDEServices as IOTAServices).GetBaseRegistryKey) then
        Result := Registry.ReadString('RootDir');
    finally
      Registry.Free;
    end;
  {$ENDIF}
end;

// get Delphi environment variables (name-value pairs) from the registry

procedure GetEnvVars(Strings: TStrings);
var
  Registry: TRegistry;
  I: Integer;
begin
  Registry := TRegistry.Create(KEY_READ);
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    if Registry.OpenKeyReadOnly((BorlandIDEServices as IOTAServices).GetBaseRegistryKey + '\Environment Variables') then
    begin
      Registry.GetValueNames(Strings);
      for I := 0 to Strings.Count - 1 do
        Strings[I] := Strings[I] + '=' + Registry.ReadString(Strings[I]);
    end;
  finally
    Registry.Free;
  end;
end;

// get output directory of a project

function GetProjectOutputDir(Project: IOTAProject): string;
begin
  if Project.ProjectOptions.Values['GenPackage'] then // package project
  begin
    // use project options if specified
    Result := Project.ProjectOptions.Values['PkgDllDir'];
    // otherwise use environment options
    if Result = '' then
      Result := (BorlandIDEServices as IOTAServices).GetEnvironmentOptions.Values['PackageDPLOutput'];
  end
  else // non-package project, use project options
    Result := Project.ProjectOptions.Values['OutputDir'];

  // default is the project's path
  if Result = '' then
    Result := ExtractFilePath(Project.FileName);

  Result := IncludeTrailingPathDelimiter(Result);
end;

// get project source editor

function GetProjectSourceEditor(Project: IOTAProject): IOTASourceEditor;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Project.GetModuleFileCount - 1 do
    if Supports(Project.GetModuleFileEditor(I), IOTASourceEditor, Result) then
      Break;
end;

// get system environment variables

procedure GetSysVars(Strings: TStrings);
var
  P: PChar;
begin
  P := GetEnvironmentStrings;
  try
    repeat
      Strings.Add(P);
      P := StrEnd(P);
      Inc(P);
    until P^ = #0;
  finally
    FreeEnvironmentStrings(P);
  end;
end;

function GetTargetExtOverride(Project: IOTAProject): string; overload; forward;

// get target extension

function GetTargetExt(Project: IOTAProject): string;
begin
  // use {$E ...} override if specified
  Result := GetTargetExtOverride(Project);
  // otherwise use defaults
  if Result = '' then
  begin
    if Project.ProjectOptions.Values['GenPackage'] then // package
      Result := '.bpl'
    else if Project.ProjectOptions.Values['GenDll'] then // DLL
      Result := '.dll'
    else // application
      Result := '.exe';
  end;
end;

// read {$E ...} directive from project source

function GetTargetExtOverride(const ProjectSource: string): string; overload;
var
  P: PChar;

  procedure SkipComment(var P: PChar);
  begin
    case P^ of
      '{':
        begin
          while not (P^ in [#0, '}']) do
            Inc(P);
          if P^ = '}' then
            Inc(P);
        end;
      '/':
        if (P + 1)^ = '/' then
        begin
          while not (P^ in [#0, #10, #13]) do
            Inc(P);
          while (P^ in [#10, #13]) do
            Inc(P);
        end;
      '(':
        if (P + 1)^ = '*' then
          repeat
            Inc(P);
            case P^ of
              #0:
                Break;
              '*':
                if (P + 1)^ = ')' then
                begin
                  Inc(P, 2);
                  Break;
                end;
            end;
          until False;
    end;
  end;

  procedure SkipStringLiteral(var P: PChar);
  begin
    if P^ <> '''' then
      Exit;
    Inc(P);
    repeat
      case P^ of
        #0:
          Break;
        '''':
          begin
            Inc(P);
            if P^ = '''' then
              Inc(P)
            else
              Break;
          end;
        else
          Inc(P);
      end;
    until False;
  end;

  procedure SkipNonDirectives(var P: PChar);
  begin
    repeat
      case P^ of
        #0:
          Break;
        '''':
          SkipStringLiteral(P);
        '/':
          case (P + 1)^ of
            '/':
              SkipComment(P);
            else
              Inc(P);
          end;
        '(':
          case (P + 1)^ of
            '*':
              SkipComment(P);
            else
              Inc(P);
          end;
        '{':
          begin
            case (P + 1)^ of
              '$':
                Break;
              else
                SkipComment(P);
            end;
          end;
        else
          Inc(P);
      end;
    until False;
  end;
begin
  P := PChar(ProjectSource);
  repeat
    SkipNonDirectives(P);
    case P^ of
      #0:
        Break;
      '{':
        if StrLIComp(P, '{$E ', 4) = 0 then
        begin
          Inc(P, 4);
          Result := '.';
          while P^ = ' ' do
            Inc(P);
          while not (P^ in [#0, '}']) do
          begin
            if P^ <> ' ' then
              Result := Result + P^;
            Inc(P);
          end;
          Break;
        end
        else
          SkipComment(P);
    end;
  until False;
end;

// read {$E ...} directive from project source module

function GetTargetExtOverride(Project: IOTAProject): string; overload;
const
  BufferSize = 1024;
var
  SourceEditor: IOTASourceEditor;
  EditReader: IOTAEditReader;
  Buffer: array[0..BufferSize - 1] of Char;
  Stream: TStringStream;
  ReaderPos, CharsRead: Integer;
begin
  SourceEditor := GetProjectSourceEditor(Project);
  if Assigned(SourceEditor) then
  begin
    EditReader := SourceEditor.CreateReader;
    Stream := TStringStream.Create('');
    try
      ReaderPos := 0;
      repeat
        CharsRead := EditReader.GetText(ReaderPos, Buffer, BufferSize - 1);
        Inc(ReaderPos, CharsRead);
        Buffer[CharsRead] := #0;
        Stream.WriteString(Buffer);
      until CharsRead < BufferSize - 1;
      Result := GetTargetExtOverride(Stream.DataString);
    finally
      Stream.Free;
    end;
  end;
end;

// get project target file name (with path), resolve $(...) macros if used

function GetTargetFileName(Project: IOTAProject): string;
var
  PStart, PEnd: PChar;
  EnvVar, Value, FileName, Ext, S: string;
  EnvVars, SysVars: TStringList;
  I: Integer;
begin
  EnvVars := nil;
  SysVars := nil;
  try
    Result := GetProjectOutputDir(Project);
    PStart := StrPos(PChar(Result), '$(');
    while PStart <> nil do
    begin
      Value := '';

      PEnd := StrPos(PStart, ')');
      if PEnd = nil then
        Break;
      SetString(EnvVar, PStart + 2, PEnd - PStart - 2);
      if CompareText(EnvVar, 'DELPHI') = 0 then // $(DELPHI) macro is hardcoded
        Value := GetDelphiRootDirectory
      else
      begin
        // try Delphi environment variables from the registry
        if not Assigned(EnvVars) then
        begin
          EnvVars := TStringList.Create;
          GetEnvVars(EnvVars);
        end;

        for I := 0 to EnvVars.Count -1 do
          if CompareText(EnvVar, EnvVars.Names[I]) = 0 then
          begin
            {$IFDEF DELPHI_7_UP}
            Value := ExcludeTrailingPathDelimiter(EnvVars.ValueFromIndex[I]);
            {$ELSE}
            Value := ExcludeTrailingPathDelimiter(EnvVars.Values[EnvVars.Names[I]]);
            {$ENDIF}
            Break;
          end;
        if Value = '' then
        begin
          // try system environment variables
          if not Assigned(SysVars) then
          begin
            SysVars := TStringList.Create;
            GetSysVars(SysVars);
          end;
          for I := 0 to SysVars.Count - 1 do
            if CompareText(EnvVar, SysVars.Names[I]) = 0 then
            begin
              {$IFDEF DELPHI_7_UP}
              Value := ExcludeTrailingPathDelimiter(SysVars.ValueFromIndex[I]);
              {$ELSE}
              Value := ExcludeTrailingPathDelimiter(SysVars.Values[SysVars.Names[I]]);
              {$ENDIF}
              Break;
            end;
        end;
      end;

      I := PStart - PChar(Result) + 1;
      Delete(Result, I, Length(EnvVar) + 3);
      Insert(Value, Result, I);

      PStart := StrPos(PChar(Result), '$(');
    end;
    Ext := GetTargetExt(Project);
    FileName := ChangeFileExt(ExtractFileName(Project.FileName), '');
    // include prefix/suffix/version for DLL and package projects
    if Project.ProjectOptions.Values['GenDll'] then
    begin
      S := Project.ProjectOptions.Values['SOPrefix'];
      if Project.ProjectOptions.Values['SOPrefixDefined'] then
        FileName := S + FileName;
      S := Project.ProjectOptions.Values['SOSuffix'];
      if (S <> '') then
        FileName := FileName + S;
      FileName := FileName + Ext;
      S := Project.ProjectOptions.Values['SOVersion'];
      if S <> '' then
      FileName := FileName + '.' + S;
    end
    else
      FileName := FileName + Ext;
    Result := Result + FileName;
  finally
    EnvVars.Free;
    SysVars.Free;
  end;
end;

{$IFNDEF DELPHI_6_UP}
function ExcludeTrailingPathDelimiter(const S: string): string;
begin
  Result := ExcludeTrailingBackslash(S);
end;

function IncludeTrailingPathDelimiter(const S: string): string;
begin
  Result := IncludeTrailingBackslash(S);
end;
{$ENDIF}

// read TimeDateStamp from PE header, thanks to Petr Vones (PetrV)

function LinkerTimeStamp(const FileName: string): TDateTime;
var
  LI: TLoadedImage;
begin
  Win32Check(MapAndLoad(PChar(FileName), nil, @LI, False, True));
  Result := LI.FileHeader.FileHeader.TimeDateStamp / SecsPerDay + UnixDateDelta;
  UnMapAndLoad(@LI);
end;

// update TimeDateStamp value in the PE header, thanks to Petr Vones (PetrV)

procedure UpdateLinkerTimeStamp(const FileName: string; const Time: TDateTime);
var
  LI: TLoadedImage;
begin
  Win32Check(MapAndLoad(PChar(FileName), nil, @LI, False, False));
  LI.FileHeader.FileHeader.TimeDateStamp := Round((Time - UnixDateDelta) * SecsPerDay);
  UnMapAndLoad(@LI);
end;

{ TPEStampNotifier private }

function TPEStampNotifier.AppWindowHook(var Msg: TMessage): Boolean;
var
  I: Integer;
  Form: TForm;
  ProjectGroup: IOTAProjectGroup;
  Project: IOTAProject;
  TargetName: string;
  CompilerGroup: TGroupBox;
  ALabel: TLabel;
begin
  Result := False;

  // ShowModal of any form always calls DisableTaskWindows
  case Msg.Msg of
    WM_ENABLE:
      if not TWMEnable(Msg).Enabled then
      begin
        Form := nil;
        for I := 0 to Screen.FormCount - 1 do
          if Screen.Forms[I].ClassNameIs('TCompInfoDlg') then
          begin
            Form := Screen.Forms[I];
            Break;
          end;

        if not Assigned(Form) then
          Exit;

        Project := nil;
        ProjectGroup := GetActiveProjectGroup;
        if Assigned(ProjectGroup) then
          for I := 0 to ProjectGroup.ProjectCount - 1 do
            if AnsiCompareText(GetTargetFileName(ProjectGroup.Projects[I]), FLastTarget) = 0 then
            begin
              Project := ProjectGroup.Projects[I];
              Break;
            end
        else
          Project := GetActiveProject;
        if not Assigned(Project) then
          Exit;

        CompilerGroup := Form.FindComponent('CompilerGroup') as TGroupBox;
        if not Assigned(CompilerGroup) then
          Exit;

        // make room for new labels
        ALabel := Form.FindComponent('Label2') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 32;
        ALabel := Form.FindComponent('CodeSizeLabel') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 32;

        ALabel := Form.FindComponent('Label3') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 48;
        ALabel := Form.FindComponent('DataSizeLabel') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 48;

        ALabel := Form.FindComponent('Label4') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 64;
        ALabel := Form.FindComponent('StackSizeLabel') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 64;

        ALabel := Form.FindComponent('Label5') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 80;
        ALabel := Form.FindComponent('FileSizeLabel') as TLabel;
        if not Assigned(ALabel) then
          Exit;
        ALabel.Top := 80;

        // add new labels
        ALabel := TLabel.Create(Form);
        ALabel.Parent := CompilerGroup;
        ALabel.Name := 'Label6';
        ALabel.Left := 8;
        ALabel.Top := 96;
        ALabel.Width := 99;
        ALabel.Caption := 'Compile stamp:';

        TargetName := GetTargetFileName(Project);
        if FileExists(TargetName) then
        begin
          ALabel := TLabel.Create(Form);
          ALabel.Parent := CompilerGroup;
          ALabel.Name := 'CompileStampLabel';
          ALabel.Left := 110;
          ALabel.Top := 96;
          ALabel.Width := 99;
          ALabel.Caption := FormatDateTime('dd.mm.yyyy hh:nn:ss', LinkerTimeStamp(TargetName));
        end;
      end;
  end;
end;

{ TPEStampNotifier protected: IOTAIDENotifier }

procedure TPEStampNotifier.AfterCompile(Succeeded: Boolean);
begin
  // do nothing
end;

procedure TPEStampNotifier.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
  // do nothing
end;

procedure TPEStampNotifier.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string;
  var Cancel: Boolean);
begin
  // do nothing
end;

{ TPEStampNotifier protected: IOTAIDENotifier50 }

procedure TPEStampNotifier.AfterCompile(Succeeded, IsCodeInsight: Boolean);
var
  Stamp: TDateTime;
  Project: IOTAProject;
begin
  Stamp := Now;

  if IsCodeInsight or not Succeeded then
    Exit;
  Project := GetActiveProject;
  if not Assigned(Project) then
    Exit;

  FLastTarget := GetTargetFileName(Project);
  UpdateLinkerTimeStamp(FLastTarget, Stamp);
end;

procedure TPEStampNotifier.BeforeCompile(const Project: IOTAProject; IsCodeInsight: Boolean; var Cancel: Boolean);
begin
  // do nothing
end;

{ TPEStampNotifier public }

constructor TPEStampNotifier.Create;
begin
  inherited Create;
  Application.HookMainWindow(AppWindowHook);
end;

destructor TPEStampNotifier.Destroy;
begin
  Application.UnhookMainWindow(AppWindowHook);
  inherited Destroy;
end;

var
  _NotifierIndex: Integer = -1;

initialization
  with BorlandIDEServices as IOTAServices do
    _NotifierIndex := AddNotifier(TPEStampNotifier.Create);

finalization
  if _NotifierIndex <> -1 then
    with BorlandIDEServices as IOTAServices do
    begin
      RemoveNotifier(_NotifierIndex);
      _NotifierIndex := -1;
    end;

end.
0
 
RalphSCoffinAuthor Commented:
Not really, the URL to the Borland site with part of the solution  won't open.
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
BlackTigerXCommented:
it works if you open it with internet Explorer... are you using Firefox or something like that?
0
 
RalphSCoffinAuthor Commented:
Thanks, I'll give it a try and let you know.  I'm pretty well booked for
almost two weeks, so please be patient.  
0
 
cwwkieCommented:
No comment has been added to this question in more than 21 days, so it is now classified as abandoned.

I will leave the following recommendation for this question in the Cleanup topic area:
   Accept: BlackTigerX {http:#13794035}

Any objections should be posted here in the next 4 days. After that time, the question will be closed.

cwwkie
EE Cleanup Volunteer
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.