I am trying to query the version details of a file that the installer installs and compare it against the version details of the same file present in the installer being executed. The details are not in the FileVersion or ProductVersion field but can be in other fields like InternalName etc.
I see Win32 APIs for solving this and also some sample code like :
http://delphidabbler.com/articles?article=20
How can I read details of file?
However, some of the data types used in those code samples do not work with Inno Setup. Further, some samples and description seem to indicate that the language and codepage itself will be an array but some samples use it assuming only one entry for language and codepage.
I was stuck at trying to find the language and codepage and based on comments below, I hard coded it for en-us.
I do see this answer which has a code sample for Inno Setup Pascal but the language and codepage calculation not being based on the lplpBufferCP variable makes me doubt its correctness.
Is it possible to read generic version info properties from Inno Setup Pascal script ? If so, please help around how to find the language and code page values.
The code I have written based on the aforesaid solutions is listed below with in-line comments for the problematic portions.
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
function GetFileVersionInfoSize(lptstrFilename: String; lpdwHandle: Integer): Integer;
external 'GetFileVersionInfoSize{#AW}#version.dll stdcall delayload';
function GetFileVersionInfo(lptstrFilename: String; dwHandle, dwLen: Integer; var lpData: Byte): Boolean;
external 'GetFileVersionInfo{#AW}#version.dll stdcall delayload';
function VerQueryValue(var pBlock: Byte; lpSubBlock: String; var lplpBuffer: Byte; var puLen: Integer): Boolean;
external 'VerQueryValue{#AW}#version.dll stdcall delayload';
function GetFileVersionProperty(const FileName, PropertyName: String): String;
var
VerSize: Integer;
VerInfo: array of Byte;
Dummy: Integer;
InternalNameArr: array of Byte;
begin
Result := '';
if not FileExists(FileName) then
begin
Log('File ' + FileName + ' does not exist');
Exit;
end;
VerSize := GetFileVersionInfoSize(FileName, 0);
if not VerSize > 0 then
begin
Log('File ' + FileName + ' has no version information');
Exit;
end;
SetArrayLength(VerInfo, VerSize);
if not GetFileVersionInfo(FileName, 0, VerSize, VerInfo[0]) then
begin
Log('Failed to get version info for ' + FileName);
Exit;
end;
if not GetFileVersionInfo(FileName, 0, VerSize, VerInfo[0]) then
begin
Log('Failed to get version info for ' + FileName);
Exit;
end;
{ Getting 'Version size = 2156' }
Log(Format('Version size = %d', [VerSize]));
{ Hard coded value just for testing }
SetArrayLength(InternalNameArr, 512);
{ 040904E4 hard coded for en-us }
{ Is this the correct way of querying the details ? }
{ If not, what needs to be done here }
{ TODO : InternalName hard coded. Use parameter PropertyName }
if VerQueryValue(VerInfo[0], '\StringFileInfo\040904E4\InternalName', InternalNameArr[0], Dummy) then
begin
Log('Failed to query internal name of ' + FileName);
Exit;
end
else
begin
{ What needs to be done here to convert an array of byte to string ? }
{ Do I need to iterate over the array and do the conversion ?}
{ The following does not work because of SetString() being unavailable : }
{ InternalName = SetString(AnsiStr, PAnsiChar(#InternalNameArr[0]), Len);}
{ Getting 'ProductName = 0000' and 'Dummy = 0' }
Log(Format('ProductName = %d%d', [InternalNameArr[0], InternalNameArr[1], InternalNameArr[2], InternalNameArr[3]]));
Log(Format('Dummy = %d', [Dummy]));
end;
{ TODO : Populate Result with appropriate value }
end;
An alternate approach could be to save the file properties of the installed file in registry (I am interested in 1 property of 1 of the files) and have the property available in the installer statically for the new file.
The correct code to retrieve a string from the first language of a file version info is below. The code builds on an answer by #Jens A. Koch to How to write data to an installer on the server?
The code requires Unicode version of Inno Setup.
function GetFileVersionInfoSize(
lptstrFilename: String; lpdwHandle: Integer): Integer;
external 'GetFileVersionInfoSizeW#version.dll stdcall delayload';
function GetFileVersionInfo(
lptstrFilename: String; dwHandle, dwLen: Integer; var lpData: Byte): Boolean;
external 'GetFileVersionInfoW#version.dll stdcall delayload';
function VerQueryValue(
var pBlock: Byte; lpSubBlock: String; var lplpBuffer: DWord;
var Len: Integer): Boolean;
external 'VerQueryValueW#version.dll stdcall delayload';
procedure RtlMoveMemoryAsString(Dest: string; Source: DWord; Len: Integer);
external 'RtlMoveMemory#kernel32.dll stdcall';
procedure RtlMoveMemoryAsBytes(Dest: array of Byte; Source: DWord; Len: Integer);
external 'RtlMoveMemory#kernel32.dll stdcall';
function GetFileVerInfo(FileName, VerName: String): String;
var
Len: Integer;
FileVerInfo: array of Byte;
Lang: array of Byte;
Buffer: DWord;
LangCodepage: string;
SubBlock: string;
begin
Result := '';
if FileExists(FileName) then
begin
Len := GetFileVersionInfoSize(FileName, 0);
if Len > 0 then
begin
SetArrayLength(FileVerInfo, Len);
if GetFileVersionInfo(FileName, 0, Len, FileVerInfo[0]) then
begin
if VerQueryValue(
FileVerInfo[0], '\VarFileInfo\Translation', Buffer, Len) then
begin
if Len >= 4 then
begin
SetArrayLength(Lang, 4);
RtlMoveMemoryAsBytes(Lang, Buffer, 4);
LangCodepage :=
Format('%.2x%.2x%.2x%.2x', [Lang[1], Lang[0], Lang[3], Lang[2]]);
SubBlock :=
Format('\%s\%s\%s', ['StringFileInfo', LangCodepage, VerName]);
if VerQueryValue(FileVerInfo[0], SubBlock, Buffer, Len) then
begin
SetLength(Result, Len - 1);
RtlMoveMemoryAsString(Result, Buffer, (Len - 1) * 2);
end;
end;
end;
end;
end;
end;
end;
Related
Please have a look at my CharArrayToString() below.
What is the correct way to declare RtlMoveMemory function for this purpose, and how to call it?
[Setup]
AppName=EmptyProgram
AppVerName=EmptyProgram 1
UsePreviousAppDir=false
DefaultDirName={pf}\EmptyProgram
Uninstallable=false
OutputBaseFilename=HelloWorld
PrivilegesRequired=lowest
[Messages]
SetupAppTitle=My Title
[Code]
function lstrlen(lpString: array of Char
): Integer; external 'lstrlenW#kernel32.dll stdcall';
procedure RtlMoveMemory_ToString(
Dest : String;
Source: PAnsiChar;
Length: Integer
); external 'RtlMoveMemory#kernel32.dll stdcall';
//-------------------------------------------------------------------------------------------------
// This function is provided only for demonstration
//-------------------------------------------------------------------------------------------------
procedure StringToCharArray(const sStr: String; var aCharArray: array of Char);
var
iLenStr: Integer;
iIdx : Integer;
begin
iLenStr := Length(sStr);
if iLenStr = 0 then Exit;
SetArrayLength(aCharArray, iLenStr + 1); // Include a room for the null terminator
for iIdx := 1 to iLenStr do begin
aCharArray[iIdx - 1] := sStr[iIdx];
end;
aCharArray[iIdx - 1] := #0;
end; // ==> StringToCharArray()
//=================================================================================================
//-------------------------------------------------------------------------------------------------
// This function is an obvious solution to convert a char array to String.
// I do not want to use this function if possible.
//-------------------------------------------------------------------------------------------------
function CharArrayToString_deprecated(const aCharArray: array of Char): String;
var
iLenCharArray: Integer;
iIdx : Integer;
begin
iLenCharArray := lstrlen(aCharArray);
if iLenCharArray = 0 then Exit;
SetLength(Result, iLenCharArray);
for iIdx := 0 to iLenCharArray - 1 do
Result[iIdx + 1] := aCharArray[iIdx];
end; // ==> CharArrayToString_deprecated()
//=================================================================================================
//-------------------------------------------------------------------------------------------------
// I want to use RtlMoveMemory() to achieve this, but currently it does not work.
// What is the correct way to declare RtlMoveMemory() for this purpose, and how to call it?
//-------------------------------------------------------------------------------------------------
function CharArrayToString(const aCharArray: array of Char): String;
var
iLenCharArray: Integer;
iIdx : Integer;
begin
iLenCharArray := lstrlen(aCharArray); // This length is not including the null terminator
if iLenCharArray = 0 then Exit;
SetLength(Result, iLenCharArray);
RtlMoveMemory_ToString(Result, aCharArray[0], iLenCharArray * 2);
end; // ==> CharArrayToString()
//=================================================================================================
//-------------------------------------------------------------------------------------------------
procedure Test();
var
aCharArray: array of Char;
sDummy : String;
sResult : String;
begin
sDummy := '1234567';
StringToCharArray(sDummy, aCharArray);
// Let's assume aCharArray is returned by a Windows API function
// Of course, this one succeeds
// sResult := CharArrayToString_deprecated(aCharArray);
// I need an advice to make this one works
sResult := CharArrayToString(aCharArray);
// Report the resultant string from the char array
MsgBox('String: ' + sResult + #13#10 +
'Length: ' + IntToStr(Length(sResult)),
mbInformation, MB_OK);
end; // ==> Test()
//=================================================================================================
function InitializeSetup(): Boolean;
begin
Test();
Result := FALSE;
end;
Thanks in advance.
Gladly, after trying several possible combinations by trial and error, I finally managed to copy data from an array of char to a String using RtlMoveMemory function:
procedure RtlMM_CharArrayToStr(
sDest : String; // in
var achSource: Char; // in
const iLength: Integer // in
); external 'RtlMoveMemory#kernel32.dll stdcall';
function CharArrayToString(const aCharArray: array of Char): String;
var
iLenCharArray: Integer;
begin
iLenCharArray := lstrlen(aCharArray); // This length is not including the null terminator
if iLenCharArray = 0 then Exit;
SetLength(Result, iLenCharArray);
RtlMM_CharArrayToStr(Result, aCharArray[0], iLenCharArray * 2);
end; // ==> CharArrayToString()
Thanks to Martin Prikryl for the hints.
Updates
For completeness, here is my function to copy data from a String to an array of char using RtlMoveMemory function:
procedure RtlMM_StrToCharArray(
sDest : array of Char; // in
const sSource: String; // in
const iLength: Integer // in
); external 'RtlMoveMemory#kernel32.dll stdcall';
procedure StringToCharArray(const sStr: String; out aCharArray: array of Char);
var
iLenStr: Integer;
begin
iLenStr := Length(sStr);
if iLenStr = 0 then Exit;
SetArrayLength(aCharArray, iLenStr + 1); // Include a room for a null terminator
RtlMM_StrToCharArray(aCharArray, sStr, iLenStr * 2);
aCharArray[iLenStr] := #0;
end; // ==> StringToCharArray
How does one write to a binary file in Inno Setup script? It's a configuration file I want to edit in the PrepareToInstall step. The problem is that I'm looking at the support functions:
TStream = class(TObject)
function Read(Buffer: String; Count: Longint): Longint;
function Write(Buffer: String; Count: Longint): Longint;
function Seek(Offset: Longint; Origin: Word): Longint;
procedure ReadBuffer(Buffer: String; Count: Longint);
procedure WriteBuffer(Buffer: String; Count: Longint);
function CopyFrom(Source: TStream; Count: Longint): Longint;
property Position: Longint; read write;
property Size: Longint; read write;
end;
And it seems even the most basic write function writes strings. Should I just do it in a batch script?
Consider the string in the TStream interface as a buffer of chars/bytes.
It's bit more complicated with Unicode version of Inno Setup, where the string is an array of 2-byte chars (comparing to legacy Ansi version, as there one byte equals one char – Though as of Inno Setup 6, Unicode is actually the only version available anyway).
See also Read bytes from file at desired position with Inno Setup.
To convert a hex string to the actual binary data, you can use the CryptStringToBinary Windows API function.
The following code works both in Ansi and Unicode version of Inno Setup.
#ifndef Unicode
const CharSize = 1;
#define AW "A"
#else
const CharSize = 2;
#define AW "W"
#endif
function CryptStringToBinary(
sz: string; cch: LongWord; flags: LongWord; binary: string; var size: LongWord;
skip: LongWord; flagsused: LongWord): Integer;
external 'CryptStringToBinary{#AW}#crypt32.dll stdcall';
const
CRYPT_STRING_HEX = $04;
procedure WriteHexToFile(Hex: string; FileName: string);
var
Stream: TFileStream;
Buffer: string;
Size: LongWord;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
SetLength(Buffer, (Length(Hex) div 2*CharSize) + CharSize - 1);
Size := Length(Hex) div 2;
if (CryptStringToBinary(
Hex, Length(Hex), CRYPT_STRING_HEX, Buffer, Size, 0, 0) = 0) or
(Size <> Length(Hex) div 2) then
begin
RaiseException('Error decoding hex string');
end;
Stream.WriteBuffer(Buffer, Size);
finally
Stream.Free;
end;
end;
Use it like:
procedure WriteHexToFileTest;
var
Hex: string;
begin
Hex :=
'000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f' +
'202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f' +
'404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f' +
'606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f' +
'808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9f' +
'a0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebf' +
'c0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedf' +
'e0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff';
WriteHexToFile(Hex, 'my_binary_file.dat');
end;
I am trying to return the size of a file using the Public Domain code from ISXKB at vincenzo.net.
function CloseHandle (hHandle: THandle): Boolean;
external 'CloseHandle#kernel32.dll stdcall';
const
{ Some constants for CreateFile (). }
GENERIC_READ = $80000000;
GENERIC_WRITE = $40000000;
GENERIC_EXECUTE = $20000000;
GENERIC_ALL = $10000000;
FILE_SHARE_READ = 1;
FILE_SHARE_WRITE = 2;
FILE_SHARE_DELETE = 4;
CREATE_NEW = 1;
CREATE_ALWAYS = 2;
OPEN_EXISTING = 3;
OPEN_ALWAYS = 4;
TRUNCATE_EXISTING = 5;
FILE_READ_ATTRIBUTES = $80;
FILE_WRITE_ATTRIBUTES = $100;
{ General Win32. }
INVALID_HANDLE_VALUE = -1;
function CreateFile (
lpFileName : String;
dwDesiredAccess : Cardinal;
dwShareMode : Cardinal;
lpSecurityAttributes : Cardinal;
dwCreationDisposition : Cardinal;
dwFlagsAndAttributes : Cardinal;
hTemplateFile : Integer
): Integer;
external 'CreateFileA#kernel32.dll stdcall';
function GetFileSize (hFile: THandle; var lpFileSizeHigh: Integer): Integer;
external 'GetFileSize#kernel32.dll stdcall';
function GetTheFileSize (FileName: String): Integer;
var
hFile: THandle;
iSize: Integer;
hSize: Integer;
begin
hFile := CreateFile (FileName,
GENERIC_READ,// Desired access.
FILE_SHARE_READ + FILE_SHARE_WRITE,
0, { Security attributes. }
OPEN_EXISTING,
FILE_ATTRIBUTE_TEMPORARY,
0);
if (INVALID_HANDLE_VALUE = hFile) then
begin
Result := 0;
Exit;
end;
iSize := GetFileSize (hFile, hSize);
CloseHandle (hFile);
Result := iSize;
end;
However, this does not appear to work as intended and is returning 0, which I believe is because it is exiting at if (INVALID_HANDLE_VALUE = hFile) then Result := 0. The file I am passing to it exists and is accessible. Can anyone shed some light on why this is failing or suggest an alternate method? Note that I cannot use the built in FileSize function as this has a 2GB limit, which is not enough for my purposes.
I assume you are using an Unicode version of Inno Setup.
So you must use an Unicode version of CreateFile, the CreateFileW, not CreateFileA:
external 'CreateFileW#kernel32.dll stdcall';
Anyway, the GettheFileSize implementation (from now defunct ISXKB) has 2 GB limit too:
This declaration works with files up to 2 GB.
...
... retrieves its low 32 bit part of the file size as an integer, and closes the file again.
To support 64-bit sizes, change it like:
function GetTheFileSize (FileName: String): Int64;
...
begin
...
Result := Int64(Cardinal(iSize)) + (Int64(Cardinal(hSize)) shl 32);
end;
Anyway, it's somewhat overkill. And as you have found it does not work if another application has the file opened without allowing others applications to at least read the file (it has not specified FILE_SHARE_READ in its call to CreateFile).
Note that the FileSize won't work either in this case, as it has basically the same implementation as ISXKB's GetTheFileSize.
There's an easy solution using FindFirst support function:
function GetTheFileSize(FileName: String): Int64;
var
FindRec: TFindRec;
begin
if FindFirst(FileName, FindRec) then
begin
Result := Int64(FindRec.SizeHigh) shl 32 + FindRec.SizeLow;
FindClose(FindRec);
end
else
begin
Result := -1;
end;
end;
I'm having an issue here with the following:
function InitializeSetup(): Boolean;
var
ResultCode:Integer;
begin
Result := true;
if MsgBox('Wanna help?',mbConfirmation, MB_YESNO )= IDYES then
begin
CreateBatch();
Exec('cmd.exe', '/c "' +ExpandConstant('{tmp}\batch.bat'),'',SW_HIDE, ewWaitUntilTerminated, ResultCode);
Result:= false;
end;
end;
in the batch file i got the following :
#ECHO OFF
D:
cd D:\_INSTALLER\Output
"installer.exe" /SAVEINF="opt.txt"
So it basically re-open the installer , over and over again ... ( infinite loop )
Is there any way to ask : Wanna help? only for the 1st time ? and if the user clicked yes, the batch should be executed , else if the user clicked no it should continue the install normally.
Thanks in advance for the support ,
BeGiN.
With the help of TLama and his post i achieved my goal by using the following script:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
type
HINSTANCE = THandle;
procedure ExitProcess(exitCode:integer);external 'ExitProcess#kernel32.dll stdcall';
function ShellExecute(hwnd: HWND; lpOperation: string; lpFile: string;lpParameters: string; lpDirectory: string; nShowCmd: Integer): HINSTANCE;
external 'ShellExecute{#AW}#shell32.dll stdcall';
var
withINF: Boolean;
function CmdLineParamExists(const Value: string): Boolean;
var
I: Integer;
begin
Result := False;
for I := 1 to ParamCount do
if CompareText(ParamStr(I), Value) = 0 then
begin
Result := True;
Break;
end;
end;
//Initialize setup
function InitializeSetup(): Boolean;
var
ResultCode:Integer;
Params: string;
RetVal: HINSTANCE;
begin
Result := true;
withINF := CmdLineParamExists('/SAVEINF=opt.txt');
if not withINF then
begin
Params := '/SAVEINF=opt.txt';
ShellExecute(0, 'open',ExpandConstant('{srcexe}'), Params, '', SW_SHOW);
ExitProcess(0);
end;
end;
L.E: A shorter code for doing the same thing also made by TLama(multilingual support added):
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
ShowLanguageDialog = yes
[Languages]
Name: "en"; MessagesFile: "compiler:Default.isl"
Name: "nl"; MessagesFile: "compiler:Languages\Dutch.isl"
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
type
HINSTANCE = THandle;
function ShellExecute(hwnd: HWND; lpOperation: string; lpFile: string;lpParameters: string; lpDirectory: string; nShowCmd: Integer): HINSTANCE;
external 'ShellExecute{#AW}#shell32.dll stdcall';
function CmdLineParamExists(const Value: string): Boolean;
var
I: Integer;
begin
Result := False;
for I := 1 to ParamCount do
if CompareText(ParamStr(I), Value) = 0 then
begin
Result := True;
Break;
end;
end;
function InitializeSetup: Boolean;
var
Params: string;
begin
// prepare Params variable for reusing
if ExpandConstant('{language}') = 'en' then begin
Params := '/SAVEINF=opt.txt /LANG=en';
end;
if ExpandConstant('{language}') = 'nl' then begin
Params := '/SAVEINF=opt.txt /LANG=nl';
end;
// allow this setup to run if the expected parameter is specified; or, if it is not, allow to run it
// when ShellExecute fails; it works like this - first evaluates the CmdLineParamExists function and
// if that returns True, the second part of the statement (ShellExecute) won't run (evaluate); when
// the parameter is not found, the CmdLineParamExists returns False and statement evaluation goes on,
// ShellExecute attempts to run the setup and to the Result returns True (allow this instance to run)
// when the function fails for some reason (the returned value <= 32); in other words, you will allow
// this setup instance to run if executing of the new setup instance fails
Result := CmdLineParamExists('/SAVEINF=opt.txt') or (ShellExecute(0, '', ExpandConstant('{srcexe}'), Params, '', SW_SHOW) <= 32);
end;
Regards,
BeGiN
I see not reason for this but you can simply solve this by creating temp file.
If user clicks Yes (first time) then create some file (any file with some random content) just before CreateBatch() is called.
Then simply check for existence of this file - if it exists user already clicked Yes (once) and do what ever you want.
Innosetup is killing me. I am getting a RUNTIME 'Type Mismatch' error, where it is, to me, quite unexpected. I am using Inno-setup 5.5.3 (u)
(where the 'u' means the unicode version)
I am attempting to pass a two dimensional array into a method.
Here is my complete example.
[Setup]
AppName=EmptyProgram
AppVerName=EmptyProgram 1
UsePreviousAppDir=false
DefaultDirName={pf}\EmptyProgram
Uninstallable=false
OutputBaseFilename=HelloWorld
PrivilegesRequired=none
[Messages]
SetupAppTitle=My Title
[Code]
var
langMap : array[0..3] of array[0..1] of String;
function getMapVal(map : array of array[0..1] of String; key: String ) : String;
begin
Result:='not testing the body of the method';
end;
function InitializeSetup(): Boolean;
begin
MsgBox('Hello world.', mbInformation, MB_OK);
getMapVal(langMap, 'hello'); // this line here fails with type mismatch! Why?
Result := FALSE;
end;
This example would run, but for the invokation of the method:
getMapVal(langMap, 'hello');
It compiles, and therefore is happy with the declaration. But on invokation, mismatch error. What am I doing wrong?
First of all, you're not making a hash map, but a pure key value list. There's currently no way to make a real generics hash map in InnoSetup at this time. Anyway, your current code needs a complete refactor. I'd rather write it this way:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
[Code]
type
TKey = string;
TValue = string;
TKeyValue = record
Key: TKey;
Value: TValue;
end;
TKeyValueList = array of TKeyValue;
function TryGetValue(const KeyValueList: TKeyValueList; const Key: TKey;
var Value: TValue): Boolean;
var
I: Integer;
begin
Result := False;
for I := 0 to GetArrayLength(KeyValueList) - 1 do
if KeyValueList[I].Key = Key then
begin
Result := True;
Value := KeyValueList[I].Value;
Exit;
end;
end;
procedure InitializeWizard;
var
I: Integer;
Value: TValue;
KeyValueList: TKeyValueList;
begin
SetArrayLength(KeyValueList, 3);
for I := 0 to 2 do
begin
KeyValueList[I].Key := 'Key' + IntToStr(I);
KeyValueList[I].Value := 'Value' + IntToStr(I);
end;
if TryGetValue(KeyValueList, 'Key2', Value) then
MsgBox('Value: ' + Value, mbInformation, MB_OK);
end;