Python detection code for InnoSetup

Mon Sep 29 13:19:00 CDT 2003

and a different version that uses enumeration of the pythoncore key to find 
all of 'em.

--bob

At 10:31 AM 9/29/2003 -0500, Robert Olson wrote:
>Sending this off for future reference since it doesn't belong in the .iss 
>I'm working on at the moment.
>
>--bob
>
-------------- next part --------------
var
  PythonPaths, PythonNames, PythonKeyNames : TArrayOfString;
  PythonPathVals: TArrayOfString;
  MultiplePythonInstalls: Boolean;

// External functions:
// InnoSetup 2 versions:
//function RegOpenKeyEx(RootKey : Integer;subkey : string;options: integer;sec:integer;valu:integer): integer; external 'advapi32' name 'RegOpenKeyExA'; stdcall;
//function RegCloseKey(valu:integer): integer; external 'advapi32' name 'RegCloseKey'; stdcall;
//function RegEnumKeyEx(hKey: Integer;dwIndex: Integer; lpName : Pchar; lpcbName: PChar;lpReserved: Integer;lpClass: Pchar;lpcbClass: Integer;lpFTLWT: Integer): Integer; external 'advapi32' name 'RegEnumKeyExA'; stdcall;
// InnoSetup 3 versions:
function RegOpenKeyEx(RootKey : Integer;SubKey: String;Options: Integer;Sec: Integer; Valu: Integer): Integer; external 'RegOpenKeyExA at advapi32.dll stdcall';
function RegCloseKey(Valu: Integer): Integer; External 'RegCloseKey at advapi32.dll stdcall';
function RegEnumKeyEx(hKey: Integer;dwIndex: Integer; lpName : Pchar; lpcbName: PChar;lpReserved: Integer;lpClass: Pchar;lpcbClass: Integer;lpFTLWT: Integer): Integer; external 'RegEnumKeyExA at advapi32.dll stdcall';
function RegQueryInfoKey(hKey: Integer;lpClass: Integer; var lpcClass: Integer; lpReserved: Integer; var lpcSubKeys: Integer; var lpcMaxSubkeyLen: Integer; var lpcMaxClassLen: Integer; var lpcValues: Integer; var lpcMaxValueNameLen: Integer; var lpcMaxValueLen: Integer; var lpcbSecurityDescriptor: Integer; lpftLastWriteTime: Integer): Integer; external 'RegQueryInfoKeyA at advapi32.dll stdcall';
// End external functions

// From winerror.h/windows.pas:
Const KEY_QUERY_VALUE = $1;
Const KEY_ENUMERATE_SUB_KEYS = $8;
Const ERROR_SUCCESS = 0;
Const ERROR_MORE_DATA = 234;
Const ERROR_NO_MORE_ITEMS = 259;

//**********************************************************
// What this is all about:
// Created by Ton Huisman, Aug 2002 ath at ath.myweb.nl
// Freeware, no claims, no f(l)ames, use at your own risk, test before releasing to public!!
//////////////////////////////////////////////////////////////////////////////////////////////
// RegKeyExists: Query for the existence of some Keyvalue in the registry
// -> Function RegKeyExists(RootKey : Integer; SubKey : String) : Boolean;
// Input : RootKey : A predefined value for the registryhive we want to query, like HKLM etc.
//   SubKey  : The full path to the queried key
// Output: Boolean: True if found, False if not found.
// Queried by trying to open the key for read access, True if successful
// Uses: RegOpenKeyEx, CastPtrToInt, RegCloseKey
//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// RegOpenKey: Open a Keyvalue in the registry
// -> Function RegOpenKey(RootKey : Integer; SubKey : String;Sam: Integer) : Integer;
// Input : RootKey : A predefined value for the registryhive we want to query, like HKLM etc.
//   SubKey  : The full path to the queried key
//   Sam   : The Security Acces Mask, If 0 then KEY_QUERY_VALUE
// Output: Integer (HKey): Handle for registry key, 0 if not Ok
// Uses: RegOpenKeyEx
//////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////
// RegKeyNames: Query for a string of all SubKeys of a SubKey in the registry
// -> Function RegKeyNames(RootKey: Integer; SubKey : String) : String;
// Input : RootKey : A predefined value for the registryhive we want to query, like HKLM etc.
//   SubKey  : The full path to the queried key
// Output: String: Comma-separated list of all subkeys found
// Uses: RegOpenKey, CastIntToPtrStr, RegEnumKeyEx, RegCloseKey
//////////////////////////////////////////////////////////////////////////////////////////////

//**********************************************************
// Supporting function

procedure MsgShow(c:string);
begin
  MsgBox(c,mbConfirmation,MB_OK);
end;

Function CastPtrToInt(PtrStr: String) : Integer;
Begin
	Result := Ord(StrGet(PtrStr,1)) + (Ord(StrGet(PtrStr,2)) * 256) + (Ord(StrGet(PtrStr,3))*256*256) + (Ord(StrGet(PtrStr,4))*256*256*256);
End; { CastPtrToInt }

// Supporting function
// Cast Integer to PointerString
Function CastIntToPtrStr(Inte: Cardinal) : String;
Var n : Integer;
r : Cardinal;
t : Cardinal;
Begin
Result := StringOfChar(#0,4);
r := Inte;
n := 4;
If r >= (256*256*256) then
Begin
t := r / (256*256*256);
StrSet(Chr(t),n,Result);
r := r - (t * (256*256*256));
End;
n := n - 1;
If r >= (256*256) then
Begin
t := r / (256*256);
StrSet(Chr(t),n,Result);
r := r - (t * (256*256));
End;
n := n - 1;
If r >= (256) then
Begin
t := r / (256);
StrSet(Chr(t),n,Result);
r := r - (t * (256));
End;
n := n - 1;
If r > 0 then
Begin
t := r;
StrSet(Chr(t),n,Result);
r := r - t;
End;
End; { CastIntToPtrStr }

//////////////////////////////////////////////////////////////////////////////////////////////
// RegKeyExists: Query for the existence of some Keyvalue in the registry
// Input : RootKey : A predefined value for the registryhive we want to query, like HKLM etc.
//   SubKey  : The full path to the queried key
// Output: Boolean: True if found, False if not found.
// Queried by trying to open the key for read access, True if successful
// Uses: RegOpenKeyEx, CastPtrToInt, RegCloseKey
//////////////////////////////////////////////////////////////////////////////////////////////
Function RegKeyExists(RootKey : Integer; SubKey : String) : Boolean;
Var l : Integer;
ls : String;
hKey : Integer;
Begin
	ls := StringOfChar(#0,4);
	l := CastStringToInteger(ls);
	Result := (RegOpenKeyEx(RootKey,SubKey,0,KEY_QUERY_VALUE,l) = 0);
	hKey := CastPtrToInt(ls);
	RegCloseKey(hKey);
End; { RegKeyExists }

//////////////////////////////////////////////////////////////////////////////////////////////
// RegOpenKey: Open a Keyvalue in the registry
// Input : RootKey : A predefined value for the registryhive we want to query, like HKLM etc.
//   SubKey  : The full path to the queried key
//   Sam   : The Security Acces Mask, If 0 then KEY_QUERY_VALUE
// Output: Integer (HKey): Handle for registry key, 0 if not Ok
// Uses: RegOpenKeyEx
//////////////////////////////////////////////////////////////////////////////////////////////
Function RegOpenKey(RootKey : Integer; SubKey : String;Sam: Integer) : Integer;
Var l : Integer;
ls : String;
Begin
	ls := StringOfChar(#0,4);
	l := CastStringToInteger(ls);
	If Sam = 0 then Sam := KEY_QUERY_VALUE;
	Result := 0;
	If (RegOpenKeyEx(RootKey,SubKey,0,Sam,l) = 0) then
		Result := CastPtrToInt(ls);
End; { RegOpenKey }

//////////////////////////////////////////////////////////////////////////////////////////////
// RegKeyNames: Query for a string of all SubKeys of a SubKey in the registry
// Input : RootKey : A predefined value for the registryhive we want to query, like HKLM etc.
//   SubKey  : The full path to the queried key
// Output: String: Comma-separated list of all subkeys found
// Uses: RegOpenKey, CastIntToPtrStr, RegEnumKeyEx, RegCloseKey
//////////////////////////////////////////////////////////////////////////////////////////////

Const Key_Separator = ',';// Default to comma, change as needed, could be #9 or ';'?
Const Key_MaxLength = 255;// Usually this (255) is way to large, 64 could do niceley, but just be safe. Longer keys than this length will be ignored!

Function RegKeyNames(RootKey: Integer; SubKey : String) : String;
Var hKey : Integer;// HKey is not directly supported...
	wdIndex : Integer;
	s : String;
	ss : Integer;
	st : String;
	r : Integer;
Begin
	wdIndex := 0;
	Result := '';
	s := StringOfChar(#0,Key_MaxLength);
	ss := Key_MaxLength;
	st := CastIntToPtrStr(ss);
	hKey := RegOpenKey(RootKey,SubKey,KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS);
	If hKey <> 0 then
	Begin
		ss := Key_MaxLength;
		st := CastIntToPtrStr(ss);
		r := RegEnumKeyEx(hKey,wdIndex,s,st,0,'',0,0);
		MsgBox('got ' + InttoStr(r), mbInformation, MB_OK);
		While ((r = ERROR_SUCCESS) or (r = ERROR_MORE_DATA)) do
		Begin
			ss := CastPtrToInt(st);
			If ss > 0 then begin
				MsgBox(s, mbInformation, MB_OK);
				Result := Result + Copy(s,1,ss) + Key_Separator;
			end;
			wdIndex := wdIndex + 1;
			ss := Key_MaxLength;
			st := CastIntToPtrStr(ss);
			r := RegEnumKeyEx(hKey,wdIndex,s,st,0,'',0,0);
		End;
		If Result <> '' then
			Result := Copy(Result,1,Length(Result) - 1);// remove extra separator ;-)
		RegCloseKey(hKey);
	End;
End; { RegKeyNames }

Function RegKeyNamesArray(RootKey: Integer; SubKey : String) : TArrayOfString;
Var hKey : Integer;	// HKey is not directly supported...

	SubKeys 			: Integer;
	MaxSubkeyLen		: Integer;
	ActSubkeyLen		: Integer;

	ClassBufferSize		: Integer;
	MaxClassLen		: Integer;
	NumValues		: Integer;
	MaxValueNameLen	: Integer;
	MaxValueLen		: Integer;
	SecDescrLen		: Integer;

	SubkeyName, st		: String;
	ii				: Integer;
	jj				: Integer;
	Flag				: Integer;

	Res : TArrayOfString;
	r, l : Integer;

Begin
	SubKeys := 0;
	MaxSubkeyLen := 0;
	ClassBufferSize := 0;
	MaxClassLen := 0;
	NumValues := 0;
	MaxValuenameLen := 0;
	MaxValueLen := 0;
	SecDescrLen := 0;
	Flag := 0;

	SetArrayLength(Res,0);

	hKey := RegOpenKey(RootKey,SubKey,KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS);
	If hKey <> 0 then
	Begin
		// String zum Empfang der Subkey Anzahl vorbereiten
		SubKeys := 0;
		MaxSubkeyLen := 0;
		r := RegQueryInfoKey(hKey,0,ClassBufferSize,0,SubKeys,MaxSubkeyLen,MaxClassLen,NumValues,MaxValuenameLen,MaxValueLen,SecDescrLen,0);

		// MsgShow('RegQueryInfoKey: SubKeys = ' + IntToStr(SubKeys) + ' MaxSubkeylen = ' + IntToStr(MaxSubkeyLen));

		SetArrayLength(Res,SubKeys);

		for ii:=0 to (SubKeys-1) do
		begin
			ActSubkeyLen := MaxSubkeyLen + 1;
			SubkeyName := StringOfChar(#0,ActSubkeyLen);
			st := CastIntToPtrStr(ActSubkeyLen);
			r := RegEnumKeyEx(hKey,ii,SubkeyName,st,0,'',0,0);
			l := CastPtrToInt(st)
			Res[ii] := Copy(SubkeyName, 0, l);
			// MsgShow('RegEnumKeyEx returns SubkeyName = ' + Res[ii] + ' len is ' + IntToStr(l));
		end;
	End;

	Result := Res;
End; { RegKeyNamesArray }

function InitializeSetup(): Boolean;
var
	numPythons, i : Integer;
	base, val : String;
begin

	PythonKeyNames := RegKeyNamesArray(HKLM, 'Software\Python\PythonCore');

	numPythons := GetArrayLength(PythonKeyNames);
	//MsgShow('numpys ' + IntToStr(numPythons));
	if numPythons > 1 then
		MultiplePythonInstalls := true
	else
		MultiplePythonInstalls := false;

	SetArrayLength(PythonPaths, numPythons);
	SetArrayLength(PythonNames, numPythons);
	SetArrayLength(PythonPathVals, numPythons);

	for i := 0 to numPythons - 1 do
	begin
		base := 'Software\Python\PythonCore\' + PythonKeyNames[i] + '\InstallPath'
		// MsgShow('base is <' + base+ '>');

		RegQueryStringValue(HKLM, base, '', val)
		PythonPaths[i] := val
		RegQueryStringValue(HKLM, base + '\InstallGroup', '', val)
		PythonNames[i] := val
	end

	{ Default to the latest one. }
	PythonPathVals[numPythons - 1] := '1';

	Result := true;
end;

function ScriptDlgPages(CurPage: Integer; BackClicked: Boolean): Boolean;
var
  I, CurSubPage: Integer;
  Nextt, NextOk: Boolean;
  pythonPath: String;
begin
    if (not BackClicked and (CurPage = wpSelectDir)) or (BackClicked and (CurPage = wpSelectProgramGroup)) then begin
		{ Insert a custom wizard page between two non custom pages }
		{ First open the custom wizard page }
		ScriptDlgPageOpen();
		{ Set some captions }
		ScriptDlgPageSetCaption('Choose python version.');
		ScriptDlgPageSetSubCaption1('Multiple versions of Python are installed on this system.');
		ScriptDlgPageSetSubCaption2('Select the version you wish to use for the Access Grid Toolkit, and click Next.');

		Nextt := InputOptionArray(PythonNames, PythonPathVals, True, False);

		for i := 0 to GetArrayLength(PythonPathVals) - 1 do begin
			if (PythonPathVals[i] = '1') then begin
				pythonPath := PythonPaths[i];
				break
			end;
		end;

		MsgBox(pythonPath, mbInformation, MB_OK);

		if not BackClicked then
			Result := Nextt
		else
			Result := not Nextt;
		ScriptDlgPageClose(not Result);
    end	else begin
		Result := true
	end;
end;

function NextButtonClick(CurPage: Integer): Boolean;
begin
  if MultiplePythonInstalls then
	  Result := ScriptDlgPages(CurPage, False)
  else
	Result := True
end;

function BackButtonClick(CurPage: Integer): Boolean;
begin
  if MultiplePythonInstalls then
	  Result := ScriptDlgPages(CurPage, True)
  else
	Result := True
end;