paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 04:29:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

corrected by Michalis:

Browse Source 
* VerQueryValue parameters (last parameter should be dwBytes instead of
    @dwBytes; you can call
      VerQueryValue(...,pp,dwBytes) or
      VerQueryValue(...,@pp,@dwBytes) but NOT
      VerQueryValue(...,pp,@dwBytes) (and that was the case) )
  * corrected
      if not VerQueryValue(p,a,pp,dwBytes) then Exit;
    to
      if not VerQueryValue(p,a,pp,dwBytes) then Continue;
    (when some info is missing the code should skip to the next info,
    not exit)
  + added destructor to Free FmyVersionStrings and FmyVersionCategories objects
    to avoid memory leaks
  + added ts.Free (and embedded some code in try..finally..end clause)
    to avoid memory leaks
  * inherited Create should be called at the beginning of constructor
    (it's just a good coding practice)
  * getVersionSetting re-written, optimised a little (LowerCase(inp) only once;
    this function is not supposed to be really "optimised" but this little
    improvement was so simple...) (note: when TStringList.CaseSensitive will
    be implemented in FPC, this function can be implemented even simpler,
    just by calling FmyVersionCategories.IndexOf)
This commit is contained in:
michael 2003-07-26 16:23:05 +00:00
parent 28ef3fa9d1
commit e89c99f6a7
1 changed files with 94 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

155
fcl/win32/fileinfo.pp
View File

@ -50,9 +50,9 @@ type
procedure SetFileName (inp : string); procedure SetFileName (inp : string);
procedure readVersionFromFile; procedure readVersionFromFile;
protected protected
{ Protected-Deklarationen}
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function getVersionSetting(inp : string): String; function getVersionSetting(inp : string): String;
published published
property fileName : string read FFileName write SetFileName; property fileName : string read FFileName write SetFileName;
@ -66,10 +66,17 @@ implementation
{ initialize everything } { initialize everything }
constructor TFileVersionInfo.Create(AOwner: TComponent); constructor TFileVersionInfo.Create(AOwner: TComponent);
begin begin
FmyVersionStrings := TStringList.Create; inherited Create(AOwner);
FmyVersionCategories := TStringList.Create; FmyVersionStrings := TStringList.Create;
FFileName := ''; FmyVersionCategories := TStringList.Create;
inherited create(Aowner); FFileName := '';
end;
destructor TFileVersionInfo.Destroy;
begin
FmyVersionCategories.Free;
FmyVersionStrings.Free;
inherited;
end; end;
{ Get filename, check if file exists and read info from file } { Get filename, check if file exists and read info from file }
@ -102,73 +109,99 @@ var struSize : Dword;
s : string; s : string;
ts : TStringList; ts : TStringList;
begin begin
ts := TStringList.Create; ts := TStringList.Create;
ts.add('CompanyName'); try
ts.add('FileDescription'); ts.add('CompanyName');
ts.add('FileVersion'); ts.add('FileDescription');
ts.add('InternalName'); ts.add('FileVersion');
ts.add('LegalCopyright'); ts.add('InternalName');
ts.add('OriginalFilename'); ts.add('LegalCopyright');
ts.add('ProductName'); ts.add('OriginalFilename');
ts.add('ProductVersion'); ts.add('ProductName');
ts.add('ProductVersion');
strPCopy(a,FFileName);
{ get size of data } strPCopy(a,FFileName);
struSize := GetFileVersionInfoSize(a,@someDummy); { get size of data }
if struSize=0 then exit; struSize := GetFileVersionInfoSize(a,@someDummy);
p := NIL; if struSize=0 then exit;
try p := NIL;
{ get memory } try
GetMem(p,struSize+10); { get memory }
{ get data } GetMem(p,struSize+10);
if not GetFileVersionInfo(a,0,struSize,p) then exit; { get data }
{ get root info } if not GetFileVersionInfo(a,0,struSize,p) then exit;
if not VerQueryValue(p,'\',pp,@dwBytes) then exit; { get root info }
move(pp^,theFixedInfo,dwBytes); if not VerQueryValue(p,'\',pp,dwBytes) then exit;
move(pp^,theFixedInfo,dwBytes);
{ get translation info }
if not VerQueryValue(p,'\VarFileInfo\Translation',pp,@dwBytes) then { get translation info }
exit; if not VerQueryValue(p,'\VarFileInfo\Translation',pp,dwBytes) then
move(pp^,theTrans,dwBytes); exit;
move(pp^,theTrans,dwBytes);
{ iterate over defined items }
for i:=0 to ts.count-1 do { iterate over defined items }
begin for i:=0 to ts.count-1 do
s := '\StringFileInfo\'+inttohex(theTrans.langID,4)+inttohex(theTrans.charset,4)+'\'+ts[i]; begin
StrPCopy(a,s); s := '\StringFileInfo\'+inttohex(theTrans.langID,4)+inttohex(theTrans.charset,4)+'\'+ts[i];
if not VerQueryValue(p,a,pp,@dwBytes) then exit; StrPCopy(a,s);
if dwBytes>0 then if not VerQueryValue(p,a,pp,dwBytes) then Continue;
begin if dwBytes>0 then
move(pp^,txt,dwBytes); begin
FmyVersionCategories.add(ts[i]); move(pp^,txt,dwBytes);
FmyVersionStrings.add(StrPas(txt)); FmyVersionCategories.add(ts[i]);
end FmyVersionStrings.add(StrPas(txt));
end; end
finally end;
{ release memory } finally
FreeMem(p); { release memory }
end; FreeMem(p);
end;
finally ts.Free end;
end; end;
{ get single version string } { get single version string }
function TFileVersionInfo.getVersionSetting(inp : string): String; function TFileVersionInfo.getVersionSetting(inp : string): String;
var i : integer; var i : integer;
begin begin
result := ''; inp:=LowerCase(inp);
for i:= 0 to FmyVersionCategories.Count -1 do for i:= 0 to FmyVersionCategories.Count -1 do
begin if LowerCase(FmyVersionCategories[i])=inp then
if lowercase(FmyVersionCategories[i])=lowercase(inp) then begin
begin result := FmyVersionStrings[i];
result := FmyVersionStrings[i]; Exit;
break; end;
end; result := '';
end;
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2002-09-07 15:15:29 peter Revision 1.5 2003-07-26 16:23:05 michael
corrected by Michalis:
* VerQueryValue parameters (last parameter should be dwBytes instead of
@dwBytes; you can call
VerQueryValue(...,pp,dwBytes) or
VerQueryValue(...,@pp,@dwBytes) but NOT
VerQueryValue(...,pp,@dwBytes) (and that was the case) )
* corrected
if not VerQueryValue(p,a,pp,dwBytes) then Exit;
to
if not VerQueryValue(p,a,pp,dwBytes) then Continue;
(when some info is missing the code should skip to the next info,
not exit)
+ added destructor to Free FmyVersionStrings and FmyVersionCategories objects
to avoid memory leaks
+ added ts.Free (and embedded some code in try..finally..end clause)
to avoid memory leaks
* inherited Create should be called at the beginning of constructor
(it's just a good coding practice)
* getVersionSetting re-written, optimised a little (LowerCase(inp) only once;
this function is not supposed to be really "optimised" but this little
improvement was so simple...) (note: when TStringList.CaseSensitive will
be implemented in FPC, this function can be implemented even simpler,
just by calling FmyVersionCategories.IndexOf)
Revision 1.4 2002/09/07 15:15:29 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
} }