?
Solved

Capture Date & Time at Build Time

Posted on 2005-04-14
7
Medium Priority
?
286 Views
Last Modified: 2010-04-05
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?  
0
Comment
Question by:RalphSCoffin
6 Comments
 
LVL 17

Expert Comment

by:mokule
ID: 13787695
0
 

Author Comment

by:RalphSCoffin
ID: 13787897
Not really, the URL to the Borland site with part of the solution  won't open.
0
 
LVL 13

Expert Comment

by:BlackTigerX
ID: 13794024
it works if you open it with internet Explorer... are you using Firefox or something like that?
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 13

Accepted Solution

by:
BlackTigerX earned 2000 total points
ID: 13794035
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
 

Author Comment

by:RalphSCoffin
ID: 13794237
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
 
LVL 14

Expert Comment

by:cwwkie
ID: 16412423
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

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
This Micro Tutorial will teach you how to add a cinematic look to any film or video out there. There are very few simple steps that you will follow to do so. This will be demonstrated using Adobe Premiere Pro CS6.
Screencast - Getting to Know the Pipeline
Suggested Courses

807 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question