Related
I have to encode an array of bytes to a base64 string (and decode this string) on an old Delphi 2007.
How could I do?
Further Informations:
I've tried synapse (As suggested here Binary to Base64 (Delphi)).
Indy ships with Delphi, and has TIdEncoderMIME and TIdDecoderMIME classes for handling base64. For example:
uses
..., IdCoder, IdCoderMIME;
var
Bytes: TIdBytes;
Base64String: String;
begin
//...
Bytes := ...; // array of bytes
//...
Base64String := TIdEncoderMIME.EncodeBytes(Bytes);
//...
Bytes := TIdDecoderMIME.DecodeBytes(Base64String);
//...
end;
There are also methods for encoding/decoding String and TStream data as well.
Update: alternatively, if your version does not have the class methods shown above:
// TBytesStream was added in D2009, so define it manually for D2007
uses
..., IdCoder, IdCoderMIME
{$IF RTLVersion < 20)
, RTLConsts
{$IFEND}
;
{$IF RTLVersion < 20)
type
TBytesStream = class(TMemoryStream)
private
FBytes: TBytes;
protected
function Realloc(var NewCapacity: Longint): Pointer; override;
public
constructor Create(const ABytes: TBytes); overload;
property Bytes: TBytes read FBytes;
end;
constructor TBytesStream.Create(const ABytes: TBytes);
begin
inherited Create;
FBytes := ABytes;
SetPointer(Pointer(FBytes), Length(FBytes));
FCapacity := FSize;
end;
const
MemoryDelta = $2000; // Must be a power of 2
function TBytesStream.Realloc(var NewCapacity: Integer): Pointer;
begin
if (NewCapacity > 0) and (NewCapacity <> FSize) then
NewCapacity := (NewCapacity + (MemoryDelta - 1)) and not (MemoryDelta - 1);
Result := Pointer(FBytes);
if NewCapacity <> FCapacity then
begin
SetLength(FBytes, NewCapacity);
Result := Pointer(FBytes);
if NewCapacity = 0 then
Exit;
if Result = nil then raise EStreamError.CreateRes(#SMemoryStreamError);
end;
end;
{$IFEND}
var
Bytes: TBytes;
BStrm: TBytesStream;
Encoder: TIdEncoderMIME;
Decoder: TIdDecoderMIME;
Base64String: String;
begin
//...
Bytes := ...; // array of bytes
//...
BStrm := TBytesStream.Create(Bytes);
try
Encoder := TIdEncoderMIME.Create;
try
Base64String := Encoder.Encode(BStrm);
finally
Encoder.Free;
end;
finally
BStrm.Free;
end;
//...
BStrm := TBytesStream.Create;
try
Decoder := TIdDecoderMIME.Create;
try
Decoder.DecodeBegin(BStrm);
Decoder.Decode(Base64String);
Decoder.DecodeEnd;
finally
Decoder.Free;
end;
Bytes := BStrm.Bytes;
finally
BStrm.Free;
end;
//...
end;
Contrary to what you state in the question, the EncdDecd unit is included in Delphi 2007. You can simply use that.
David Heffernan responded very well!
Add in your uses the class "EncdDecd", it will have the procedures:
function DecodeString (const Input: string): string;
function DecodeBase64 (const Input: string): TBytes;
Testing with https://www.base64encode.org/
The String "Working" in both Delphi and the site resulted in: "V29ya2luZw =="
ShowMessage ('Working =' + EncodeString ('Working'));
ShowMessage ('Working =' + DecodeString ('V29ya2luZw =='));
Here goes EncodeToBase64:
uses
classes, sysutils;
function EncodeToBase64(var Buffer: TBytes): Longint;
const
EncodingTable: PChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
var
WriteBuf: array[0..3] of Byte;
Buf: array[0..2] of Byte;
Dest: TMemoryStream;
i, j, Count: Integer;
begin
Result := 0;
Count := Length(Buffer);
j := Count div 3;
if j > 0 then
begin
Dest:= TMemoryStream.Create();
try
Dest.Position := 0;
for i := 0 to j - 1 do
begin
Move(Buffer[i * 3], Buf[0], 3);
WriteBuf[0] := Ord(EncodingTable[Buf[0] shr 2]);
WriteBuf[1] := Ord(EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)]);
WriteBuf[2] := Ord(EncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)]);
WriteBuf[3] := Ord(EncodingTable[Buf[2] and 63]);
Dest.Write(WriteBuf, 4);
Inc(Result, 4);
Dec(Count, 3);
end;
if Count in [1, 2] then
begin
Move(Buffer[i * 3], Buf[0], Count);
WriteBuf[0] := Ord(EncodingTable[Buf[0] shr 2]);
WriteBuf[1] := Ord(EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)]);
if Count = 1 then
WriteBuf[2] := Ord('=')
else
WriteBuf[2] := Ord(EncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)]);
WriteBuf[3] := Ord('=');
Dest.Write(WriteBuf, 4);
Inc(Result, 4);
Dec(Count, Count);
end;
if Result > 0 then
begin
SetLength(Buffer, Result);
Dest.Position := 0;
Dest.Read(Buffer[0], Result);
end;
finally
Dest.Free;
end;
end;
end;
And this should work without any special units or components.
For OLDER versions of Delphi (before of Delphi XE7), use:
uses
Soap.EncdDecd
procedure DecodeFile(const Base64: AnsiString; const FileName: string);
var
BStream: TBytesStream;
begin
BStream := TBytesStream.Create(DecodeBase64(Base64));
try
BStream.SaveToFile(Filename);
finally
BStream.Free;
end;
end;
For NEWS versions of Delphi, use:
uses
System.NetEncoding;
procedure DecodeFile(const Base64: String; const FileName: string);
var
BStream: TBytesStream;
begin
BStream:= TBytesStream.Create(TNetEncoding.Base64.DecodeStringToBytes(Base64));
try
BStream.SaveToFile(Filename);
finally
BStream.Free;
end;
end;
I have been working on a project in Lazarus and have decided to move it to Delphi XE for the time being (due to some limitations).
A brief overview of what is going on:
At runtime I am loading external files and adding them to streams. The streams belong to several different classes that descend from one main object (TObject). These classes are added to a TList from the main object, basically each class has its own stream property and the class is child to the main object.
In this main object I have a save and load procedure:
When saving the object it also saves all the stream data from the other classes to file by using string to stream. The output string here must be base64 encoded as I am saving to XML.
When opening the file, the idea is to decode the base64 string and move it back into the streams just as if it were the original file before it was base64 encoded.
In Lazarus it works, and here is the important code (note, some of it was not written by me).
const
Keys64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
function Encode64String(S: string): string;
function Decode64String(S: string): string;
function Encode64StringToStream(const Input: TStream; var Output: string): Boolean;
procedure Decode64StringToStream(const Input: string; Output: TStream);
procedure StringToStream(Stream: TStream; const S: string);
function StreamToString(MS: TMemoryStream): string;
implementation
function Encode64String(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Ord(s[i]);
b := b * 256 + x;
a := a + 8;
while a >= 6 do
begin
a := a - 6;
x := b div (1 shl a);
b := b mod (1 shl a);
Result := Result + Keys64[x + 1];
end;
end;
if a > 0 then
begin
x := b shl (6 - a);
Result := Result + Keys64[x + 1];
end;
end;
function Decode64String(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Pos(s[i], Keys64) - 1;
if x >= 0 then
begin
b := b * 64 + x;
a := a + 6;
if a >= 8 then
begin
a := a - 8;
x := b shr a;
b := b mod (1 shl a);
x := x mod 256;
Result := Result + chr(x);
end;
end
else
Exit;
end;
end;
function Encode64StringToStream(const Input: TStream; var Output: string): Boolean;
var
MS: TMemoryStream;
begin
Result := False;
MS := TMemoryStream.Create;
try
Input.Seek(0, soFromBeginning);
MS.CopyFrom(Input, Input.Size);
MS.Seek(0, soFromBeginning);
Output := Encode64String(StreamToString(MS));
finally
MS.Free;
end;
Result := True;
end;
procedure Decode64StringToStream(const Input: string; Output: TStream);
var
MS: TMemoryStream;
begin
try
MS := TMemoryStream.Create;
try
StringToStream(MS, Decode64String(Input));
MS.Seek(0, soFromBeginning);
Output.CopyFrom(MS, MS.Size);
Output.Position := 0;
finally
MS.Free;
end;
except on E: Exception do
raise Exception.Create('stream decode error - ' + E.Message);
end;
end;
procedure StringToStream(Stream: TStream; const S: string);
begin
Stream.Write(Pointer(S)^, Length(S));
end;
function StreamToString(MS: TMemoryStream): string;
begin
SetString(Result, PChar(MS.Memory), MS.Size div SizeOf(Char));
end;
I am 99% sure the problem here is going to be unicode related. It's a shame because I believe Lazarus/Freepascal has always been unicode but not Delphi and so uses different string types making it almost impossible for the less professional users like myself to solve!
To be honest I think all the code above is a bit of a mess, and it feels like I am just trying to guess what to change the strings to without really knowing what I am doing.
My first thought was to change everything from String to AnsiString. This nearly worked one time but when trying to use Decode64StringToStream I got zero data back. Other times the data was not properly saving as base64 encoded format, and sometimes I even got errors like TStream.Seek not implemented or something.
PS, I have read the guides and there is plenty around such as the whitepapers etc on how to migrate old Delphi projects to newer unicode versions and to be honest I am still at a loss with it. I thought replacing string to AnsiString would have been enough, but it seems it isn't.
Any tips, pointers or general advice or clues would be greatly appreciated thanks.
I think what you want to do is:
Convert the Unicode string to UTF-8 encoding. This is often the most space efficient format for Unicode text.
Encode the string using base64.
Then to decode you just reverse the steps.
The code looks like this:
function Encode(const Input: string): AnsiString;
var
utf8: UTF8String;
begin
utf8 := UTF8String(Input);
Result := EncdDecd.EncodeBase64(PAnsiChar(utf8), Length(utf8));
end;
function Decode(const Input: AnsiString): string;
var
bytes: TBytes;
utf8: UTF8String;
begin
bytes := EncdDecd.DecodeBase64(Input);
SetLength(utf8, Length(bytes));
Move(Pointer(bytes)^, Pointer(utf8)^, Length(bytes));
Result := string(utf8);
end;
Situation: a whole number saved as hex in a byte array(TBytes). Convert that number to type integer with less copying, if possible without any copying.
here's an example:
array = ($35, $36, $37);
This is '5', '6', '7' in ansi. How do I convert it to 567(=$273) with less trouble?
I did it by copying twice. Is it possible to be done faster? How?
You can use LookUp Table instead HexToInt...
This procedure works only with AnsiChars and of course no error checking is provided!
var
Table :array[byte]of byte;
procedure InitLookupTable;
var
n: integer;
begin
for n := 0 to Length(Table) do
case n of
ord('0')..ord('9'): Table[n] := n - ord('0');
ord('A')..ord('F'): Table[n] := n - ord('A') + 10;
ord('a')..ord('f'): Table[n] := n - ord('a') + 10;
else Table[n] := 0;
end;
end;
function HexToInt(var hex: TBytes): integer;
var
n: integer;
begin
result := 0;
for n := 0 to Length(hex) -1 do
result := result shl 4 + Table[ord(hex[n])];
end;
function BytesToInt(const bytes: TBytes): integer;
var
i: integer;
begin
result := 0;
for i := 0 to high(bytes) do
result := (result shl 4) + HexToInt(bytes[i]);
end;
As PA pointed out, this will overflow with enough digits, of course. The implementation of HexToInt is left as an exercise to the reader, as is error handling.
You can do
function CharArrToInteger(const Arr: TBytes): integer;
var
s: AnsiString;
begin
SetLength(s, length(Arr));
Move(Arr[0], s[1], length(s));
result := StrToInt(s);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
a: TBytes;
begin
a := TBytes.Create($35, $36, $37);
Caption := IntToStr(CharArrToInteger(a));
end;
If you know that the string is null-terminated, that is, if the final character in the array is 0, then you can just do
function CharArrToInteger(const Arr: TBytes): integer;
begin
result := StrToInt(PAnsiChar(#Arr[0]));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
a: TBytes;
begin
a := TBytes.Create($35, $36, $37, 0);
Caption := IntToStr(CharArrToInteger(a));
end;
The most natural approach, however, is to use an array of characters instead of an array of bytes! Then the compiler can do some tricks for you:
procedure TForm1.FormCreate(Sender: TObject);
var
a: TCharArray;
begin
a := TCharArray.Create(#$35, #$36, #$37);
Caption := IntToStr(StrToInt(string(a)));
end;
It cannot be any faster than that ;-)
function HexToInt(num:pointer; size:Cardinal): UInt64;
var i: integer;
inp: Cardinal absolute num;
begin
if(size > SizeOf(Result)) then Exit;
result := 0;
for i := 0 to size-1 do begin
result := result shl 4;
case(PByte(inp+i)^) of
ord('0')..ord('9'): Inc(Result, PByte(inp+i)^ - ord('0'));
ord('A')..ord('F'): Inc(Result, PByte(inp+i)^ - ord('A') + 10);
ord('a')..ord('f'): Inc(Result, PByte(inp+i)^ - ord('a') + 10);
end;
end;
end;
function fHexToInt(b:TBytes): UInt64; inline;
begin
Result:=HexToInt(#b[0], Length(b));
end;
...
b:TBytes = ($35, $36, $37);
HexToInt(#b[0], 3);
fHexToInt(b);
I developed the following function to convert strings to hex values.
function StrToHex(const S: String): String;
const
HexDigits: array[0..15] of Char = '0123456789ABCDEF';
var
I: Integer;
P1: PChar;
P2: PChar;
B: Byte;
begin
SetLength(Result, Length(S) * 2);
P1 := #S[1];
P2 := #Result[1];
for I := 1 to Length(S) do
begin
B := Byte(P1^);
P2^ := HexDigits[B shr 4];
Inc(P2);
P2^ := HexDigits[B and $F];
Inc(P1);
Inc(P2);
end;
end;
Now I was wondering whether there is a more efficient way to convert the strings?
Depending on your Delphi version:
D5-D2007
uses classes;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], #result[1], Length(Buffer));
end;
D2009+
uses classes;
function String2Hex(const Buffer: Ansistring): string;
begin
SetLength(result, 2*Length(Buffer));
BinToHex(#Buffer[1], PWideChar(#result[1]), Length(Buffer));
end;
Try this one
function String2Hex(const Buffer: Ansistring): string;
var
n: Integer;
begin
Result := '';
for n := 1 to Length(Buffer) do
Result := LowerCase(Result + IntToHex(Ord(Buffer[n]), 2));
end;
I know this is a very old topic, but I feel like I kinda need to share my code regarding the question. For years I use my own HexEncode, very similar with Forlan's code up there, but just today I found a faster way to encode Hex. With my old HexEncode, encoding a 180kb binary file took about 50 seconds, while with this function it took up 6 seconds.
function getHexEncode(txt : AnsiString) : AnsiString;
var
a : integer ;
st : TStringStream;
buf : array [0..1] of AnsiChar;
tmp : ShortString;
begin
st := TStringStream.Create;
st.Size := Length(txt)*2;
st.Position := 0;
for a:=1 to Length(txt) do
begin
tmp := IntToHex(Ord(txt[a]),2);
buf[0] := tmp[1];
buf[1] := tmp[2];
st.Write(buf,2);
end;
st.Position := 0;
Result := st.DataString;
st.Free;
//Result := ''; //my old code
//for a:=1 to Length(txt) do Result := Result+IntToHex(Ord(txt[a]),2); //my old code
end;
It seems good enough, you could always have a byte->2 hex digits lookup table, but that (and similar optimizations) seems like overkill to me in most cases.
// StrToInt('$' + MyString);
Oops, did not read the question very good...
Want to obtain Delphi Application build number and post into title bar
Here is how I do it. I put this in almost all of my small utilities:
procedure GetBuildInfo(var V1, V2, V3, V4: word);
var
VerInfoSize, VerValueSize, Dummy: DWORD;
VerInfo: Pointer;
VerValue: PVSFixedFileInfo;
begin
VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
if VerInfoSize > 0 then
begin
GetMem(VerInfo, VerInfoSize);
try
if GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo) then
begin
VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
with VerValue^ do
begin
V1 := dwFileVersionMS shr 16;
V2 := dwFileVersionMS and $FFFF;
V3 := dwFileVersionLS shr 16;
V4 := dwFileVersionLS and $FFFF;
end;
end;
finally
FreeMem(VerInfo, VerInfoSize);
end;
end;
end;
function GetBuildInfoAsString: string;
var
V1, V2, V3, V4: word;
begin
GetBuildInfo(V1, V2, V3, V4);
Result := IntToStr(V1) + '.' + IntToStr(V2) + '.' +
IntToStr(V3) + '.' + IntToStr(V4);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Caption := Form1.Caption + ' - v' + GetBuildInfoAsString;
end;
I most strongly recommend not to use GetFileVersion when you want to know the version of the executable that is currently running! I have two pretty good reasons to do this:
The executable may be unaccessible (disconnected drive/share), or changed (.exe renamed to .bak and replaced by a new .exe without the running process being stopped).
The version data you're trying to read has actually already been loaded into memory, and is available to you by loading this resource, which is always better than to perform extra (relatively slow) disk operations.
To load the version resource in Delphi I use code like this:
uses Windows,Classes,SysUtils;
var
verblock:PVSFIXEDFILEINFO;
versionMS,versionLS:cardinal;
verlen:cardinal;
rs:TResourceStream;
m:TMemoryStream;
p:pointer;
s:cardinal;
begin
m:=TMemoryStream.Create;
try
rs:=TResourceStream.CreateFromID(HInstance,1,RT_VERSION);
try
m.CopyFrom(rs,rs.Size);
finally
rs.Free;
end;
m.Position:=0;
if VerQueryValue(m.Memory,'\',pointer(verblock),verlen) then
begin
VersionMS:=verblock.dwFileVersionMS;
VersionLS:=verblock.dwFileVersionLS;
AppVersionString:=Application.Title+' '+
IntToStr(versionMS shr 16)+'.'+
IntToStr(versionMS and $FFFF)+'.'+
IntToStr(VersionLS shr 16)+'.'+
IntToStr(VersionLS and $FFFF);
end;
if VerQueryValue(m.Memory,PChar('\\StringFileInfo\\'+
IntToHex(GetThreadLocale,4)+IntToHex(GetACP,4)+'\\FileDescription'),p,s) or
VerQueryValue(m.Memory,'\\StringFileInfo\\040904E4\\FileDescription',p,s) then //en-us
AppVersionString:=PChar(p)+' '+AppVersionString;
finally
m.Free;
end;
end;
Thanks to the posts above, I made my own library for this purpose.
I believe that it is a little bit more correct than all other solutions here, so I share it - feel free to reuse it...
unit KkVersion;
interface
function FileDescription: String;
function LegalCopyright: String;
function DateOfRelease: String; // Proprietary
function ProductVersion: String;
function FileVersion: String;
implementation
uses
Winapi.Windows, System.SysUtils, System.Classes, Math;
(*
function GetHeader(out AHdr: TVSFixedFileInfo): Boolean;
var
BFixedFileInfo: PVSFixedFileInfo;
RM: TMemoryStream;
RS: TResourceStream;
BL: Cardinal;
begin
Result := False;
RM := TMemoryStream.Create;
try
RS := TResourceStream.CreateFromID(HInstance, 1, RT_VERSION);
try
RM.CopyFrom(RS, RS.Size);
finally
FreeAndNil(RS);
end;
// Extract header
if not VerQueryValue(RM.Memory, '\\', Pointer(BFixedFileInfo), BL) then
Exit;
// Prepare result
CopyMemory(#AHdr, BFixedFileInfo, Math.Min(sizeof(AHdr), BL));
Result := True;
finally
FreeAndNil(RM);
end;
end;
*)
function GetVersionInfo(AIdent: String): String;
type
TLang = packed record
Lng, Page: WORD;
end;
TLangs = array [0 .. 10000] of TLang;
PLangs = ^TLangs;
var
BLngs: PLangs;
BLngsCnt: Cardinal;
BLangId: String;
RM: TMemoryStream;
RS: TResourceStream;
BP: PChar;
BL: Cardinal;
BId: String;
begin
// Assume error
Result := '';
RM := TMemoryStream.Create;
try
// Load the version resource into memory
RS := TResourceStream.CreateFromID(HInstance, 1, RT_VERSION);
try
RM.CopyFrom(RS, RS.Size);
finally
FreeAndNil(RS);
end;
// Extract the translations list
if not VerQueryValue(RM.Memory, '\\VarFileInfo\\Translation', Pointer(BLngs), BL) then
Exit; // Failed to parse the translations table
BLngsCnt := BL div sizeof(TLang);
if BLngsCnt <= 0 then
Exit; // No translations available
// Use the first translation from the table (in most cases will be OK)
with BLngs[0] do
BLangId := IntToHex(Lng, 4) + IntToHex(Page, 4);
// Extract field by parameter
BId := '\\StringFileInfo\\' + BLangId + '\\' + AIdent;
if not VerQueryValue(RM.Memory, PChar(BId), Pointer(BP), BL) then
Exit; // No such field
// Prepare result
Result := BP;
finally
FreeAndNil(RM);
end;
end;
function FileDescription: String;
begin
Result := GetVersionInfo('FileDescription');
end;
function LegalCopyright: String;
begin
Result := GetVersionInfo('LegalCopyright');
end;
function DateOfRelease: String;
begin
Result := GetVersionInfo('DateOfRelease');
end;
function ProductVersion: String;
begin
Result := GetVersionInfo('ProductVersion');
end;
function FileVersion: String;
begin
Result := GetVersionInfo('FileVersion');
end;
end.
Pass the full file name of your EXE to this function, and it will return a string like:
2.1.5.9, or whatever your version # is.
function GetFileVersion(exeName : string): string;
const
c_StringInfo = 'StringFileInfo\040904E4\FileVersion';
var
n, Len : cardinal;
Buf, Value : PChar;
begin
Result := '';
n := GetFileVersionInfoSize(PChar(exeName),n);
if n > 0 then begin
Buf := AllocMem(n);
try
GetFileVersionInfo(PChar(exeName),0,n,Buf);
if VerQueryValue(Buf,PChar(c_StringInfo),Pointer(Value),Len) then begin
Result := Trim(Value);
end;
finally
FreeMem(Buf,n);
end;
end;
end;
After defining that, you can use it to set your form's caption like so:
procedure TForm1.FormShow(Sender: TObject);
begin
//ParamStr(0) is the full path and file name of the current application
Form1.Caption := Form1.Caption + ' version ' + GetFileVersion(ParamStr(0));
end;
We do this for all our apps but we use a Raize component RzVersioninfo.
works quite well just need to use the following code
on form create
Caption := RzVersioninfo1.filedescripion + ': ' + RzVersionInfo1.FileVersion;
obviously if you don't want any of the other components from raize use one of the options above as there is a cost to the raize components.
From http://www.martinstoeckli.ch/delphi/delphi.html#AppVersion
With this function you can get the version of a file, which contains a
version resource. This way you can display the version number of your
application in an information dialog. To include a version resource to
your Delphi application, set the "Versioninfo" in the project options.
My code:
uses unit Winapi.Windows;
function GetModuleVersion(Instance: THandle; out iMajor, iMinor, iRelease, iBuild: Integer): Boolean;
var
fileInformation: PVSFIXEDFILEINFO;
verlen: Cardinal;
rs: TResourceStream;
m: TMemoryStream;
begin
result := false;
m := TMemoryStream.Create;
try
try
rs := TResourceStream.CreateFromID(Instance, 1, RT_VERSION);
try
m.CopyFrom(rs, rs.Size);
finally
rs.Free;
end;
except
exit;
end;
m.Position:=0;
if not VerQueryValue(m.Memory, '\', Pointer(fileInformation), verlen) then
begin
iMajor := 0;
iMinor := 0;
iRelease := 0;
iBuild := 0;
Exit;
end;
iMajor := fileInformation.dwFileVersionMS shr 16;
iMinor := fileInformation.dwFileVersionMS and $FFFF;
iRelease := fileInformation.dwFileVersionLS shr 16;
iBuild := fileInformation.dwFileVersionLS and $FFFF;
finally
m.Free;
end;
Result := True;
end;
Usage:
if GetModuleVersion(HInstance, iMajor, iMinor, iRelease, iBuild) then
ProgramVersion := inttostr(iMajor)+'.'+inttostr(iMinor)+'.'+inttostr(iRelease)+'.'+inttostr(iBuild);