学习写一个控件,但是得不到结果(100分)

  • 主题发起人 主题发起人 daifan
  • 开始时间 开始时间
D

daifan

Unregistered / Unconfirmed
GUEST, unregistred user!
{
控件代码如下
功能:如果指定EXE文件的版本信息(EXE文件中包含了版本信息)
运行到function GetVersionString( FileName : String) : String时,取不到版本信息,怎么解决?
}
unit UVersionLabel;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls, Forms,
Dialogs, Graphics;

type
TVersionLabel = class(TCustomLabel)
private
{ Private declarations }
FMask: String;
FFileName: TFileName;
function GetEnvPathString : String;
function GetApplicationName( const AppName : String) : String;
protected
{ Protected declarations }
procedure SetFileName(const Value: TFileName);
procedure SetMask(const Value: String);
procedure SetVersion;
property Caption stored False;
public
{ Public declarations }
published
{ Published declarations }
constructor Create(AOwner : TComponent); override;
property FileName : TFileName read FFileName write SetFileName;
property Mask : String read FMask write SetMask;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Delphi Study', [TVersionLabel]);
end;

function GetVersionString( FileName : String) : String;
resourcestring
VersionRequestString =
'//StringFileInfo//040904E4//FileVersion';
var
Size, Dummy, Len : DWord;
Buffer : PChar;
RawPointer : Pointer;
begin
result := '<unknow>';
Size := GetFileVersionInfoSize( PChar(FileName), Dummy );
if( Size = 0 ) then exit;

GetMem( Buffer, Size );
try
if( GetFileVersionInfo( PChar(FileName), Dummy, Size, Buffer ) = False ) then exit;

if( VerQueryValue( Buffer, PChar('//StringFileInfo//040904E4//FileVersion'), RawPointer, Len ) = False ) then exit;
result := StrPas( PChar(RawPointer) );
finally
FreeMem(Buffer);
end;
end;

procedure DecodeVersion( Version : String; var MajorVersion,
MinorVersion, Release, Build : String);
function GetValue( var Version : String) : String;
begin
result := Copy( Version, 1, Pos('.', Version ) - 1);
if( result = EmptyStr ) then result := 'x';
Delete( Version, 2, Pos('.', Version));
end;
begin
MajorVersion := GetValue(Version);
MinorVersion := GetValue(Version);
Release := GetValue(Version);
Build := GetValue(Version);
end;

{ TVersionLabel }

constructor TVersionLabel.Create(AOwner: TComponent);
resourcestring
DefaultMask = 'Version %s.%s (Release %s Build %s)';
begin
inherited;
Mask := DefaultMask;
end;

resourcestring
DefaultPath = './;/';
function TVersionLabel.GetEnvPathString: String;
const
MAX = 1024;
begin
SetLength( result, MAX);
if( GetEnvironmentVariable( PChar('Path'), PChar(result), MAX) = 0 ) then
result := DefaultPath;
end;

function TVersionLabel.GetApplicationName(const AppName: String): String;
begin
if (csDesigning in ComponentState ) then
// see if a compiled version already exists, if we are designing
result := FileSearch( AppName, GetEnvPathString + DefaultPath)
else
result := Application.EXEName;
end;

procedure TVersionLabel.SetFileName(const Value: TFileName);
begin
if( CompareText( FFileName, Value ) = 0 ) then exit;
FFileName := GetApplicationName( Value);
SetVersion;
end;

procedure TVersionLabel.SetMask(const Value: String);
begin
if( FMask = Value ) then exit;
FMask := Value;
SetVersion;
end;

procedure TVersionLabel.SetVersion;
var
MajorVersion, MinorVersion, Release, Build : String;
Version : String;
begin
Version := GetVersionString( FFileName );
DecodeVersion( Version, MajorVersion, MinorVersion, Release, Build);
Caption := Format(FMask, [MajorVersion, MinorVersion, Release, Build] );
end;

end.
 
你搞错了,由于M$的SDK是以C的形式给出,而C中斜杠是转义字符,要以双斜杠来表示单斜杠,
所以用Pascal写同样的程序时应以单斜杠代替双斜杠.如:
resourcestring
VersionRequestString =
'/StringFileInfo/040904E4/FileVersion';
 
我改了,但好象还是不行,您看看还有没有别的问题呢?
 
修改了一下,好像有点面目全非.
unit UVersionLabel;

interface

uses
Windows, Messages, SysUtils, Classes,
Controls, StdCtrls, Forms, Dialogs,
Graphics;

type
TVersionLabel = class(TCustomLabel)
private
FMask: string;
FFileName: TFileName;
function GetEnvPathString: string;
function GetApplicationName(const AppName: string): string;
protected
procedure SetFileName(const Value: TFileName);
procedure SetMask(const Value: string);
procedure SetVersion;
property Caption stored False;
public
constructor Create(AOwner: TComponent); override;
published
property FileName: TFileName read FFileName write SetFileName;
property Mask: string read FMask write SetMask;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Delphi Study', [TVersionLabel]);
end;

function GetVersionString(FileName: string): string;
{resourcestring
VersionRequestString = '/StringFileInfo/040904B4/FileVersion'; }
var
Size, Dummy: DWord;
Buffer: PChar;
//RawPointer: Pointer;
VerInfo: PVSFixedFileInfo;
begin
result := '<unknow>';
Size := GetFileVersionInfoSize(PChar(FileName), Dummy);
if (Size = 0) then exit;

GetMem(Buffer, Size);
try
if (GetFileVersionInfo(PChar(FileName), 0, Size, Buffer) = False) then exit;

if (VerQueryValue(Buffer, '/', Pointer(VerInfo), Size) = False) then exit;
Result := Format('%d.%d.%d.%d.', [
VerInfo.dwFileVersionMS shr 16, VerInfo.dwFileVersionMS and $FFFF,
VerInfo.dwFileVersionLS shr 16, VerInfo.dwFileVersionLS and $FFFF]);
//result := StrPas(PChar(VerInfo));
finally
FreeMem(Buffer);
end;
end;

procedure DecodeVersion(Version: string; var MajorVersion,
MinorVersion, Release, Build: string);
function GetValue(var Version: string): string;
begin
result := Copy(Version, 1, Pos('.', Version) - 1);
if (result = EmptyStr) then result := 'x';
Delete(Version, 1, Pos('.', Version));
end;
begin
MajorVersion := GetValue(Version);
MinorVersion := GetValue(Version);
Release := GetValue(Version);
Build := GetValue(Version);
end;

{ TVersionLabel }

constructor TVersionLabel.Create(AOwner: TComponent);
resourcestring
DefaultMask = 'Version %s.%s (Release %s Build %s)';
begin
inherited;
Mask := DefaultMask;
end;

resourcestring
DefaultPath = './;/';

function TVersionLabel.GetEnvPathString: string;
const
MAX = 1024;
begin
SetLength(result, MAX);
if (GetEnvironmentVariable(PChar('Path'), PChar(result), MAX) = 0) then
result := DefaultPath;
end;

function TVersionLabel.GetApplicationName(const AppName: string): string;
begin
if not (csDesigning in ComponentState) then
// see if a compiled version already exists, if we are designing
result := FileSearch(AppName, GetEnvPathString + DefaultPath)
else
result := Application.EXEName;
end;

procedure TVersionLabel.SetFileName(const Value: TFileName);
begin
if (CompareText(FFileName, Value) = 0) then exit;
FFileName := GetApplicationName(Value);
SetVersion;
end;

procedure TVersionLabel.SetMask(const Value: string);
begin
if (FMask = Value) then exit;
FMask := Value;
SetVersion;
end;

procedure TVersionLabel.SetVersion;
var
MajorVersion, MinorVersion, Release, Build: string;
Version: string;
begin
Version := GetVersionString(FFileName);
DecodeVersion(Version, MajorVersion, MinorVersion, Release, Build);
Caption := Format(FMask, [MajorVersion, MinorVersion, Release, Build]);
end;

end.
 
非常感谢,通过.
能告诉我为什么吗?或者说是什么原理.
 
API中有详细的说明,一个关键的地方你使用"040904E4"这种语言,能保证每一个程序都
支持此语言吗?
 

Similar threads

后退
顶部