Re: ACFinder 140106test exeのみ

このトピックの投稿一覧へ

なし Re: ACFinder 140106test exeのみ

msg# 1.3.1.1.1.1.1.2.1.1
depth:
9
前の投稿 - 次の投稿 | 親投稿 - 子投稿.1 | 投稿日時 2014.01.06 23:03 | 最終変更
OhYeah!  管理人   投稿数: 983 オンライン
これって、どこがどう変わってるんでしょうか?
あと、140105test 版ともバージョン情報が 140103test になっています。バージョン情報ダイアログに TFileVerInfo コンポーネントを貼り付け、バージョンラベルのキャプションを次のように設定してやれば、リソースの製品バージョンを修正するだけでバージョン情報ダイアログは自動的に更新されます。
VersionLabel.Caption := FileVerInfo1.ProductVersion;

unit VerInfo;

interface

uses
  Windows, SysUtils, Classes, StrUtils, Forms;

type
  EFileVerInfoError = class(Exception);
  TFileVerInfo = class(TComponent)
  private { Private 宣言 }
    FValid: boolean;
    FPBuf: pointer;
    FSize: DWORD;
    FSub: string;
    FPath: string;
    function GetComments: string;
    function GetCompanyName: string;
    function GetFileDescription: string;
    function GetFileVersion: string;
    function GetInternalName: string;
    function GetLegalCopyright: string;
    function GetLegalTradeMarks: string;
    function GetProductName: string;
    function GetProductVersion: string;
    function GetPrivateBuild: string;
    function GetSpecialBuild: string;
    procedure SetPath(TargetPath: string);
  protected { protected 宣言 }
  public { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetInfo(Name: string): string;
    property Valid: boolean read FValid;
    property Comments: string read GetComments;
    property CompanyName: string read GetCompanyName;
    property FileDescription: string read GetFileDescription;
    property FileVersion: string read GetFileVersion;
    property InternalName: string read GetInternalName;
    property LegalCopyright: string read GetLegalCopyright;
    property LegalTradeMarks: string read GetLegalTradeMarks;
    property ProductName: string read GetProductName;
    property ProductVersion: string read GetProductVersion;
    property PrivateBuild: string read GetPrivateBuild;
    property SpecialBuild: string read GetSpecialBuild;
  published { Published 宣言 }
    property Path: string read FPath write SetPath;
  end;

procedure Register;
function CopyrightSignToChar(Dst: string): string;
function RegisteredSignToChar(Dst: string): string;
function CopyrightCharToSign(Dst: string): string;
function RegisteredCharToSign(Dst: string): string;

implementation

procedure Register;
begin
  RegisterComponents('Hidemi', [TFileVerInfo]);
end;

function CopyrightSignToChar;
begin
  Result := AnsiReplaceText(Dst, #$A9, '(C)');
end;

function RegisteredSignToChar;
begin
  Result := AnsiReplaceText(Dst, #$AE, '(R)');
end;

function CopyrightCharToSign;
begin
  Result := AnsiReplaceText(Dst, '(C)', #$A9);
end;

function RegisteredCharToSign;
begin
  Result := AnsiReplaceText(Dst, '(R)', #$AE);
end;

function TFileVerInfo.GetInfo;
var
  len: DWORD;
  pinfo: pointer;
begin
  Result := '';
  if not FValid then Exit;
  VerQueryValue(FPBuf, PChar(FSub + Name), pinfo, len);
  if len > 0 then Result := PChar(pinfo);
end;

function TFileVerInfo.GetComments;
begin
  Result := GetInfo('Comments');
end;

function TFileVerInfo.GetCompanyName;
begin
  Result := GetInfo('CompanyName');
end;

function TFileVerInfo.GetFileDescription;
begin
  Result := GetInfo('FileDescription');
end;

function TFileVerInfo.GetFileVersion;
begin
  Result := GetInfo('FileVersion');
end;

function TFileVerInfo.GetInternalName;
begin
  Result := GetInfo('InternalName');
end;

function TFileVerInfo.GetLegalCopyright;
begin
  Result := GetInfo('LegalCopyright');
end;

function TFileVerInfo.GetLegalTradeMarks;
begin
  Result := GetInfo('LegalTradeMarks');
end;

function TFileVerInfo.GetProductName;
begin
  Result := GetInfo('ProductName');
end;

function TFileVerInfo.GetProductVersion;
begin
  Result := GetInfo('ProductVersion');
end;

function TFileVerInfo.GetPrivateBuild;
begin
  Result := GetInfo('PrivateBuild');
end;

function TFileVerInfo.GetSpecialBuild;
begin
  Result := GetInfo('SpecialBuild');
end;

procedure TFileVerInfo.SetPath;
type
  TDWord = packed record Lo, Hi: word; end;
var
  pinfo: pointer;
  ret, len: DWORD;
begin
  FPath := TargetPath;
  if csDesigning in ComponentState then Exit;
  FValid := false;
  if FSize <> 0 then FreeMem(FPBuf, FSize);
  if TargetPath = '' then FPath := Application.ExeName;
  FSize := GetFileVersionInfoSize(PChar(FPath), ret);
  if FSize = 0 then begin
    raise EFileVerInfoError.Create('EFileVerInfoError: Cannot Get FileVerInfo Size');
    Exit;
  end;
  try
    GetMem(FPBuf, FSize);
  except
    FSize := 0;
    raise EFileVerInfoError.Create('EFileVerInfoError: Insufficient Memory');
    Exit;
  end;
  if not GetFileVersionInfo(PChar(FPath), 0, FSize, FPBuf) then begin
    FreeMem(FPBuf, FSize);
    FSize := 0;
    raise EFileVerInfoError.Create('EFileVerInfoError: Cannot Get FileVerInfo');
    Exit;
  end;
  if not VerQueryValue(FPBuf, '\VarFileInfo\Translation', pinfo, len) or (len = 0) then begin
    FreeMem(FPBuf, FSize);
    FSize := 0;
    raise EFileVerInfoError.Create('EFileVerInfoError: Cannot Get FileVerInfo');
    Exit;
  end;
  FSub := '\StringFileInfo\' + IntToHex(TDWord(pinfo^).Lo, 4) +
         IntToHex(TDWord(pinfo^).Hi, 4) + '\';
  FValid := true;
end;

constructor TFileVerInfo.Create;
begin
  inherited Create(AOwner);
  SetPath(FPath);
end;

destructor TFileVerInfo.Destroy;
begin
  if FSize <> 0 then FreeMem(FPBuf, FSize);
  inherited;
end;

end.
投票数:0 平均点:0.00

投稿ツリー

  条件検索へ