~
Specifying which files or directories to copy to, update, or create on the target PC is as easy as listing the appropriate paths in an Inno Setup script. But if you want to define more detailed custom actions, eventually you'll want to take a look at the scripting capabilities that are built into the Inno Setup development environment.
If
you recall, Inno Setup uses Pascal Script as its lingua franca
for coding duties (also available for free with full source code as a
stand-alone download from software developer Rem Objects). And also
that Pascal Script is a fully-featured implementation of the Pascal
programming language, with most of the classes and functions
available from the world of its binary-compiled big brothers, like
Delphi.
Inno
Setup comes supplied with a host of code samples for common scripting
tasks, and the Help file is another useful source of worked examples.
You can also find Pascal Script documentation on the Rem Objects
website, and there are several other enthusiast sites that carry
extra useful code listings and libraries – most notably the InnoSetup Extensions Knowledgebase.
But
I've amassed quite a collection of little functions and procedures of
my own over time, and so I'll be adding some of them here and in
subsequent posts as they come to light (I'll be dredging through past
projects to haul them out for public consumption/ridicule).
Many
of these are trivially simple, but you plug the holes where you finds
'em. Lots more to come.
In all instances, where a call is made to a routine that is not part of the stock Pascal Script library, the listing for the routine can be found elsewhere in this or another of the "Code Bank" posts.
All references to "Common.iss" refer to the unit from which these functions are taken. Modify this in your own script to match the name of the unit in which you use it (e.g., for debugging purposes).
Boolean
routines
//------------------------------------------------------------------------------
// Convert a Boolean value to a String
//
function BoolToStr(const Value: Boolean): String;
begin
Result := 'True';
if not Value then
Result := 'False';
end;
//------------------------------------------------------------------------------
// Convert a String to a Boolean (see previous Code Bank post for StrIndex)
//
function StrToBool(const Value: String): Boolean;
begin
if StrIndex(Value, False, ['true', 't', '1', 'yes', 'y']) >= 0 then
Result := True
else if StrIndex(Value, False, ['false', 'f', '0', 'no', 'n']) >= 0 then
Result := False
else
RaiseException('Invalid String/Boolean representation');
end;
Character
test routines
//------------------------------------------------------------------------------
// Returns True if "AChar", a single character, is a number
//
function IsDigit(const AChar: Char): Boolean;
begin
Result := (Ord(AChar) >= 48) and (Ord(AChar) <= 57);
end;
//------------------------------------------------------------------------------
// Returns True if "AChar", a single character, is a letter
// n.b., Roman/Latin alphabet only!
//
function IsAlpha(const AChar: Char): Boolean;
begin
Result := ((Ord(AChar) >= 65) and (Ord(AChar) <= 90)) or ((Ord(AChar) >= 97) and (Ord(AChar) <= 122));
end;
Debug
routines
//------------------------------------------------------------------------------
// Show a message if 'DebugMode' is active
//
procedure DebugMsg(const UnitName, MethodName, LineNo, Msg: String);
var
MsgOut: String;
begin
if FDebugMode then begin
MsgOut := 'Unit: ' + UnitName + #13 + 'Method: ' + MethodName + #13 + 'Line number: ' + LineNo + #13 + 'Message: ' + Msg;
MsgBox(MsgOut, mbInformation, MB_OK);
end;
end;
var
FDebugMode: Boolean;
//------------------------------------------------------------------------------
// Sets global variable "FDebugMode" to True if a parameter is passed to Setup
// from the command line in the forum "/debug=true"
//
procedure CheckForDebugMode;
var
About: String;
begin
// Show Debug messages?
FDebugMode := ExpandConstant('{param:debug|false}') = 'true';
if FDebugMode then
DebugMsg('Common.iss', 'CheckForDebugMode', '-1', 'Debug mode enabled');
else
DebugMsg('Common.iss', 'CheckForDebugMode', '-1', 'Debug mode NOT enabled');
end;
Math
routines
//------------------------------------------------------------------------------
// Silly-simple implementation of the Delphi 'Inc' function - just adds 'Amount'
// to a passed in value
//
procedure Inc(var Value: Integer; const Amount: Integer);
begin
Value := Value + Amount;
end;
//------------------------------------------------------------------------------
// Compare two Integers, return the higher
//
function Max(const Value1, Value2: Integer): Integer;
begin
Result := Value1;
if Value2 > Value1 then
Result := Value2;
end;
//------------------------------------------------------------------------------
// Compare two Integers, return the lower
//
function Min(const Value1, Value2: Integer): Integer;
begin
Result := Value1;
if Value2 < Value1 then
Result := Value2;
end;
Registry
routines
//------------------------------------------------------------------------------
// Extract a value from the Registry
// This function specifically deals with values stored under the "Uninstall" key
// entry created by an Inno Setup installer. This includes useful information
// such as the "DisplayName", "InstallDate" and "InstallLocation" - the folder to
// which the application was copied.
//
function GetRegistryKeyValue(const KeyValueName, AppName: String; var FoundValue: String): Boolean;
var
RootKeyName: Integer;
SubKeyName, ValueName: String;
begin
Result := False;
FoundValue := '';
RootKeyName := HKEY_LOCAL_MACHINE;
SubKeyName := 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + AppName + '_is1';
ValueName := KeyValueName;
try
Result := RegQueryStringValue(RootKeyName, SubKeyName, ValueName, FoundValue);
except
end;
end;
ActiveX
routines
type
TMSXMLVersion = (msxOne, msxTwo, msxThree, msxFour, msxFive, msxSix);
const
MSXMLOneProgID = 'MSXML.DOMFreeThreadedDocument';
MSXMLTwoProgID = 'MSXML.DOMDocument';
MSXMLThreeProgID = 'MSXML2.DOMDocument';
MSXMLFourProgID = 'Msxml2.DOMDocument.4.0';
MSXMLFiveProgID = 'Msxml2.DOMDocument.5.0';
MSXMLSixProgID = 'Msxml2.DOMDocument.6.0';
//------------------------------------------------------------------------------
// Generic method for assessing success in attempts to create a named OLE object class
function OLEObjectTest(const ClassName: String): Boolean;
begin
Result := False;
try
CreateOLEObject(ClassName);
Result := True;
except
end;
end;
//------------------------------------------------------------------------------
// Test whether a given MSXML version is installed: note, later versions are backward-compatible,
// so a later revision implies the availability of functionality in an earlier edition
function MSXMLVerInstalled(const Version: TMSXMLVersion): Boolean;
begin
Result := OLEObjectTest(MSXMLSixProgID) and (Integer(Version) <= Integer(MemberToMSXMLVersion(msxSix)));
if (Result) or (not Result and (Integer(Version) = Integer(MemberToMSXMLVersion(msxSix)))) then
Exit;
Result := OLEObjectTest(MSXMLFiveProgID) and (Integer(Version) <= Integer(MemberToMSXMLVersion(msxFive)));
if (Result) or (not Result and (Integer(Version) = Integer(MemberToMSXMLVersion(msxFive)))) then
Exit;
Result := OLEObjectTest(MSXMLFourProgID) and (Integer(Version) <= Integer(MemberToMSXMLVersion(msxFour)));
if (Result) or (not Result and (Integer(Version) = Integer(MemberToMSXMLVersion(msxFour)))) then
Exit;
Result := OLEObjectTest(MSXMLThreeProgID) and (Integer(Version) <= Integer(MemberToMSXMLVersion(msxThree)));
if (Result) or (not Result and (Integer(Version) = Integer(MemberToMSXMLVersion(msxThree)))) then
Exit;
Result := OLEObjectTest(MSXMLTwoProgID) and (Integer(Version) <= Integer(MemberToMSXMLVersion(msxTwo)));
if (Result) or (not Result and (Integer(Version) = Integer(MemberToMSXMLVersion(msxTwo)))) then
Exit;
Result := OLEObjectTest(MSXMLOneProgID) and (Integer(Version) <= Integer(MemberToMSXMLVersion(msxOne)));
end;
System
routines
// These record types, the DLL function prototypes and the GetNativeSystemInfo,
// CharArrayToString and GetWindowsVersion functions are all related.
// The function of interest here is "GetWindowsVersion" (the others are all
// helpers); this is copied from the JEDI JCL JCLSysInto.pas unit, and modified
// for Pascal Script compatibility.
// When called it returns an enumerated value representing the version of Windows
// reported by the operating system - wvWin95 for Windows 95, wvWin2000 for Windows
// 2000 and so on.
//
type
TOSVersionInfoExA = record
dwOSVersionInfoSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformId: DWORD;
szCSDVersion: array [0..127] of Char;
wServicePackMajor: WORD;
wServicePackMinor: WORD;
wSuiteMask: WORD;
wProductType: BYTE;
wReserved: BYTE;
end;
TSystemInfo = record
wProcessorArchitecture: Word;
wReserved: Word;
dwPageSize: DWORD;
lpMinimumApplicationAddress: Integer;
lpMaximumApplicationAddress: Integer;
dwActiveProcessorMask: DWORD;
dwNumberOfProcessors: DWORD;
dwProcessorType: DWORD;
dwAllocationGranularity: DWORD;
wProcessorLevel: Word;
wProcessorRevision: Word;
end;
TCharArray = array of Char;
TWinVersion = (wvUnknown, wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME,
wvWinNT31, wvWinNT35, wvWinNT351, wvWinNT4, wvWin2000, wvWinXP,
wvWin2003, wvWinXP64, wvWin2003R2, wvWinVista, wvWinServer2008,
wvWin7, wvWinServer2008R2);
function DLL_GetVersionEx(var VersionInformation: TOSVersionInfoExA): Integer;
external 'GetVersionExA@kernel32.dll stdcall';
procedure DLL_GetNativeSystemInfo(var SystemInfo: TSystemInfo);
external 'GetNativeSystemInfo@kernel32.dll stdcall delayload';
procedure DLL_GetSystemInfo(var SystemInfo: TSystemInfo);
external 'GetSystemInfo@kernel32.dll stdcall delayload';
function GetSystemMetrics(nIndex: Integer): Integer;
external 'GetSystemMetrics@user32.dll stdcall';
//------------------------------------------------------------------------------
function GetNativeSystemInfo(var SystemInfo: TSystemInfo): Boolean;
var
SysInfo: TSystemInfo;
begin
Result := False;
SysInfo.wProcessorArchitecture := 0;
SysInfo.wReserved := 0;
try
DLL_GetNativeSystemInfo(SysInfo);
except
// GetNativeSystemInfo is only available in Window XP and later - so trying to
// call the function will fail on earlier OS'.
// Note that WE only use it to distinguish between XP and 2003, so this shouldn't
// be an issue, but if this function were ever needed elsewhere...
// Note also that GetSystemInfo is NOT available on Windows 95
DLL_GetSystemInfo(SysInfo);
end;
end;
//------------------------------------------------------------------------------
function CharArrayToString(const CharArray: TCharArray): String;
var
i: Integer;
begin
SetLength(Result, GetArrayLength(CharArray));
for i := 1 to Length(Result) do
Result[i] := CharArray[i - 1];
end;
//------------------------------------------------------------------------------
const
PROCESSOR_ARCHITECTURE_INTEL = 0;
VER_PLATFORM_WIN32_WINDOWS = 1;
VER_PLATFORM_WIN32_NT = 2;
SM_SERVERR2 = 89;
function GetWindowsVersion: TWinVersion;
var
TrimmedWin32CSDVersion: string;
OSVersionInfoExA: TOSVersionInfoExA;
SystemInfo: TSystemInfo;
KernelVersionHi: Cardinal;
KernelDLLPath: String;
VersionMS, VersionLS: Cardinal;
begin
Result := wvUnknown;
OSVersionInfoExA.dwOSVersionInfoSize := SizeOf(OSVersionInfoExA);
DLL_GetVersionEx(OSVersionInfoExA);
TrimmedWin32CSDVersion := CharArrayToString(OSVersionInfoExA.szCSDVersion);
TrimmedWin32CSDVersion := Trim(TrimmedWin32CSDVersion);
KernelDLLPath := AddBackslash(GetSystemDir) + 'kernel32.dll';
GetVersionNumbers(KernelDLLPath, VersionMS, VersionLS);
case OSVersionInfoExA.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS:
case OSVersionInfoExA.dwMinorVersion of
0, 1, 2, 3, 4, 5, 6, 7, 8, 9:
if (TrimmedWin32CSDVersion = 'B') or (TrimmedWin32CSDVersion = 'C') then
Result := wvWin95OSR2
else
Result := wvWin95;
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51,
52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72,
73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89:
// On Windows ME Win32MinorVersion can be 10 (indicating Windows 98
// under certain circumstances (image name is setup.exe). Checking
// the kernel version is one way of working around that.
if VersionMS = $0004005A then // 4.90.x.x
Result := wvWinME
else
if (TrimmedWin32CSDVersion = 'A') or (TrimmedWin32CSDVersion = 'B') then
Result := wvWin98SE
else
Result := wvWin98;
90:
Result := wvWinME;
end;
VER_PLATFORM_WIN32_NT:
case OSVersionInfoExA.dwMajorVersion of
3:
case OSVersionInfoExA.dwMinorVersion of
1:
Result := wvWinNT31;
5:
Result := wvWinNT35;
51:
Result := wvWinNT351;
end;
4:
Result := wvWinNT4;
5:
case OSVersionInfoExA.dwMinorVersion of
0:
Result := wvWin2000;
1:
Result := wvWinXP;
2:
begin
OSVersionInfoExA.dwOSVersionInfoSize := SizeOf(OSVersionInfoExA);
SystemInfo.wProcessorArchitecture := 0;
SystemInfo.wReserved := 0;
GetNativeSystemInfo(SystemInfo);
if GetSystemMetrics(SM_SERVERR2) <> 0 then
Result := wvWin2003R2
else if (SystemInfo.wProcessorArchitecture <> PROCESSOR_ARCHITECTURE_INTEL) and (DLL_GetVersionEx(OSVersionInfoExA) <> 0) and (OSVersionInfoExA.wProductType = VER_NT_WORKSTATION) then
Result := wvWinXP64
else
Result := wvWin2003;
end;
end;
6:
case OSVersionInfoExA.dwMinorVersion of
0:
begin
OSVersionInfoExA.dwOSVersionInfoSize := SizeOf(OSVersionInfoExA);
if (DLL_GetVersionEx(OSVersionInfoExA) <> 0) and (OSVersionInfoExA.wProductType = VER_NT_WORKSTATION) then
Result := wvWinVista
else
Result := wvWinServer2008;
end;
1:
begin
OSVersionInfoExA.dwOSVersionInfoSize := SizeOf(OSVersionInfoExA);
if (DLL_GetVersionEx(OSVersionInfoExA) <> 0) and (OSVersionInfoExA.wProductType = VER_NT_WORKSTATION) then
Result := wvWin7
else
Result := wvWinServer2008R2;
end;
end;
end;
end;
end;
//------------------------------------------------------------------------------
// Pascal Script doesn't like casting from an enumerated member to Integer, but will allow casting
// from an anonymous enumerated value to Integer
//
function MemberToMSXMLVersion(const Value: TMSXMLVersion): TMSXMLVersion;
begin
Result := Value;
end;
//------------------------------------------------------------------------------
function MemberToWinVersion(const Value: TWinVersion): TWinVersion;
begin
Result := Value;
end;
//------------------------------------------------------------------------------
// Returns TRUE if the version of Windows reported by the OS matches one of the
// values in the "WinVersionSet" set, e.g., if the installer is running on Windows
// 2000, and "WinVersionSet" contains [wvWin98, wvWin98SE, wvWinME, wvWin2000] then
// the function would return TRUE.
//
function IsGivenWindowsVersion(const WinVersionSet: TWinVersionSet): Boolean;
begin
Result := GetWindowsVersion in WinVersionSet;
end;
//------------------------------------------------------------------------------
// Returns TRUE if the version of Windows reported by the OS is the same as or
// later (more recent) than the value passed in through "WinVersion".
// e.g., if the installer is running on Windows 2000, and "WinVersion" contains
// wvWinXP, the function would return TRUE.
//
function IsGivenWindowsVersionOrLater(const WinVersion: TWinVersion): Boolean;
var
ActualOSVer, TargetOSVer: Integer;
begin
ActualOSVer := Integer(GetWindowsVersion);
TargetOSVer := Integer(MemberToWinVersion(WinVersion));
Result := ActualOSVer >= TargetOSVer;
end;
//------------------------------------------------------------------------------
// Returns TRUE if the version of Windows reported by the OS is the same as or
// earlier than the value passed in through "WinVersion".
// e.g., if the installer is running on Windows 2000, and "WinVersion" contains
// wvWin98, the function would return TRUE.
//
function IsGivenWindowsVersionOrEarlier(const WinVersion: TWinVersion): Boolean;
var
ActualOSVer, TargetOSVer: Integer;
begin
ActualOSVer := Integer(GetWindowsVersion);
TargetOSVer := Integer(MemberToWinVersion(WinVersion));
Result := ActualOSVer <= TargetOSVer;
end;
//------------------------------------------------------------------------------
// Returns True if: 1) the operating system is Windows 95; 2) no web-browser is installed
//
function IsBrowserlessOS: Boolean;
var
sVersion: String;
begin
try
sVersion := '';
RegQueryStringValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Internet Explorer', 'Version', sVersion);
except
end;
Result := (sVersion = '') and (GetWindowsVersion = wvWin95);
end;
//------------------------------------------------------------------------------
// Unregister a DLL file, displaying an error message if procedure fails
//
function UnregisterDLL(const FileName: String): Boolean;
var
DLLLongName, DLLShortName: String;
SUnRegOK, LUnRegOK: Boolean;
begin
DLLLongName := GetLongName(FileName);
DLLShortName := GetShortNameEx(FileName);
if not FileExists(FileName) then begin
DebugMsg('Common.iss', 'UnregisterDLL', '-1', 'DLL file not found: ' + FileName);
Exit;
end;
SUnRegOK := UnRegisterServer(Is64BitInstallMode, DLLShortName, False);
if not SUnRegOK then
LUnRegOK := UnRegisterServer(Is64BitInstallMode, DLLLongName, False);
Result := SUnRegOK or LUnRegOK;
if not Result then
MsgBox(FormatStringForVistaMsgBox(CRLFFormat('{#AppUnregisterDLLError}', True)) + FileName, mbError, MB_OK);
end;
File
routines
//------------------------------------------------------------------------------
// Remove the final file extension part from a file path
// e.g., "test.txt" becomes "test"
//
function TrimFileExt(const FileName: String): String;
var
FileExt: String;
i: Integer;
begin
Result := FileName;
if Length(FileName) > 0 then begin
FileExt := ExtractFileExt(FileName);
i := Length(FileExt);
if i > 0 then begin
if i < Length(FileName) then
Result := Copy(FileName, 1, Length(FileName) - i)
else
Result := '';
end;
end;
end;
//------------------------------------------------------------------------------
// "ADir" is a file path - the Result is the parent directory of this path
// e.g., "C:\Temp\Test" becomes "C:\Temp"
//
function UpOneDirectory(const ADir: String): String;
var
SlashPos: Integer;
begin
Result := ADir;
if (Result = '') or (IsDriveRoot(ADir)) then
Exit;
if Result[Length(Result)] = '\' then
Result := RemoveBackslash(Result)
else
Result := Copy(Result, 1, RPos('\', Result, False) - 1);
SlashPos := RPos('\', Result, False);
Result := Copy(Result, 1, SlashPos);
end;
//------------------------------------------------------------------------------
// Returns True if "ADir" represents the "root" of a drive
// "C:" returns True
// "C:\" returns True
// "C:\test" returns False
//
function IsDriveRoot(const ADir: String): Boolean;
var
Drive, DriveAndPath: String;
begin
// UNC/drive letter root?
Drive := ExtractFileDrive(ADir); // Returns 'C:' or '\\server\share'
DriveAndPath := Drive;
if Drive <> '' then
DriveAndPath := AddBackslash(Drive);
Result := (ADir = Drive) or (ADir = DriveAndPath);
end;
//------------------------------------------------------------------------------
// Enumerates files in a named directory, and saves the results in a passed-in
// StringList
//
procedure EnumDirFiles(const FileList: TStringList; const Directory: String; const ClearList: Boolean);
var
PathD: String;
FileD: String;
FindRec: TFindRec;
begin
if (FileList <> nil) and (ClearList) then
FileList.Clear;
if (FileList = nil) or not DirExists(Directory) then
Exit;
PathD := AddBackslash(Directory)
if FindFirst(PathD + '*.*', FindRec) then begin
try
repeat
// Only add files, not directories
if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
// We found one file that matches our wildcards
// FindFirst returns the name of the file with no path so must account for that
FileD := PathD + FindRec.Name
if FileExists(FileD) then
FileList.Add(FileD);
end;
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end;
end;
//------------------------------------------------------------------------------
// Enumerates all sub-directories in a named directory (StartDir), and all child
// directories of those directories - and so on - until all directories in the
// hierarchy added to DirList
//
procedure EnumDirectories(const DirList: TStringList; const StartDir: String; const ClearList: Boolean);
var
PathD: String;
FindRec: TFindRec;
Index, Count: Integer;
begin
if (DirList <> nil) and (ClearList) then
DirList.Clear;
if (DirList = nil) or not DirExists(StartDir) then
Exit;
DirList.Add(AddBackslash(StartDir));
Index := 0;
try
repeat
PathD := DirList[Index];
Count := 0;
if FindFirst(PathD + '*.*', FindRec) then begin
repeat
// Only add directories - and don't RE-add the name of the directory we're searching through (e.g., when Count = 0)
if (FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and (Count > 0) and (FindRec.Name <> '.') and (FindRec.Name <> '..') then
// Find* returns names without path parts so we must account for that
DirList.Add(AddBackslash(PathD + FindRec.Name));
Inc(Count, 1);
until not FindNext(FindRec);
end;
Inc(Index, 1);
until Index > DirList.Count - 1;
finally
FindClose(FindRec);
end;
end;
//------------------------------------------------------------------------------
// Pascal Script version of JCLFileUtils function of same name - find a file name
// that does not correspond to any existing file.
// If 'Simple' is true, returns the first available free name in a numbered
// sequence, e.g., if:
// test0.txt, test1.txt, test3.txt exist, would return test2.txt
// If 'Simple' is false, returns the the next available free name beyond the last
// existing name in a numbered sequence, e.g., if:
// test0.txt, test1.txt, test3.txt exist, would return test4.txt
//
function FindUnusedFileName(const FileName, FileExt, Suffix: String; const Simple: Boolean): String;
var
I: Integer;
TempString, NoSuffix, sSuffix: String;
iSuffix: Integer;
begin
I := 0;
if Simple then begin
Result := FileName + '.' + FileExt;
while FileExists(Result) do begin
Result := FileName + Suffix + IntToStr(I) + '.' + FileExt;
Inc(I, 1);
end;
end else begin
TempString := GetMostRecentBackup(FileName + Suffix + '.' + FileExt);
if CompareText(TempString, FileName + Suffix + '.' + FileExt) = 0 then
Result := FileName + Suffix + IntToStr(I) + '.' + FileExt
else begin
NoSuffix := StripSuffix(TempString, sSuffix);
iSuffix := StrToIntDef(sSuffix, -1);
if iSuffix < 0 then begin
if FDebugMode then
Log('Common.iss->FindUnusedFileName->NonSimple->Error extracting suffix from filename: ' + TempString);
iSuffix := 0;
end;
Inc(iSuffix, 1);
Result := FileName + Suffix + IntToStr(iSuffix) + '.' + FileExt;
end;
end;
end;
//------------------------------------------------------------------------------
function GetAllUsersAppDataFolder(Param: String): String;
var
WinVer: TWinVersion;
begin
Result := '';
WinVer := GetFriendlyWindowsVersion;
// Windows 95:
// Windows 98/ME: C:\Program Files\Common Files
// WindowsNT: C:\WINNT\Profiles\All Users\Application Data
// Windows2000/XP: C:\Documents and Settings\All Users\Application Data
case WinVer of
wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME: Result := ExpandConstant('{cf}');
wvWinNT31, wvWinNT35, wvWinNT351, wvWin2000, wvWinXP, wvWin2003, wvWinXP64, wvWin2003R2, wvWinVista, wvWinServer2008, wvWin7, wvWinServer2008R2: Result := ExpandConstant('{commonappdata}');
end;
DebugMsg('Common.iss', 'GetAllUsersAppDataFolder', '-1', 'All Users Application Data folder determined to be: ' + Result);
end;
//------------------------------------------------------------------------------
// Copied from JEDI JCLFileUtils.pas PathGetLongName2 (with some small modifications to make it
// PascalScript compatible)
//
function GetLongName(const Path: String): String;
var
LPath: String;
I: Integer;
FindData: TFindRec;
IsBackSlash: Boolean;
begin
LPath := ExpandFileName(Path);
Result := ExtractFileDrive(LPath);
i := Length(Result);
if Length(LPath) <= i then
Exit; // only drive
if LPath[i + 1] = '\' then begin
Result := AddBackslash(Result);
Inc(i, 1);
end;
Delete(LPath, 1, i);
repeat
i := Pos('\', LPath);
IsBackSlash := i > 0;
if not IsBackSlash then
i := Length(LPath) + 1;
if FindFirst(Result + Copy(LPath, 1, i - 1), FindData) then begin
try
Result := Result + FindData.Name;
if IsBackSlash then
Result := AddBackslash(Result);
finally
FindClose(FindData);
end;
end else begin
Result := Result + LPath;
Break;
end;
Delete(LPath, 1, i);
until Length(LPath) = 0;
end;
//------------------------------------------------------------------------------
function GetShortNameEx(const Path: String): String;
var
TempFile: String;
TempFileShort: String;
begin
Result := Path;
TempFile := AddBackslash(GetTempDir) + ExtractFileName(Path);
if not FileExists(TempFile) then
if not SaveStringToFile(TempFile, '', False) then
Exit;
TempFileShort := GetShortName(TempFile);
Result := AddBackslash(GetShortName(ExtractFilePath(Path))) + ExtractFileName(TempFileShort);
DeleteFile(TempFile);
end;
//------------------------------------------------------------------------------
// Retrieve the registry-stored location of the directory within which the name application resides
//
const
scInstallLocation = 'InstallLocation';
function GetAppInstallDir(const AppName: String): String;
var
AppPath: String;
KeyName: String;
begin
Result := '';
KeyName := AppName;
if not GetRegistryKeyValue(scInstallLocation, KeyName, AppPath) then
RaiseException('Error retrieving ' + AppName + ' install location from registry: Common.iss->GetAppInstallDir');
Result := AddBackslash(AppPath);
DebugMsg('Common.iss', 'GetAppInstallDir', '-1', 'App install directory determined to be: ' + Result);
end;
//------------------------------------------------------------------------------
// Return an appropriate Help File name (personal convention means that a Help File is always
// labelled 'HelpFile' (to make its purpose obvious); where Internet Explorer is available on the
// client PC, add a 'CHM' extension. Where Internet Explorer is unavailable, fall-back to WinHelp
// and add a 'HLP' file extension
//
const
scCHM = 'chm';
scHLP = 'hlp';
scHelpFileName = 'HelpFile';
function GetHelpFileName(Param: String): String;
var
sVersion: String;
RegLookupOK: Boolean;
begin
// Default to Compiled HTML HelpFile name
Result := scHelpFileName + '.' + scCHM;
RegLookupOK := False;
try
sVersion := '';
RegLookupOK := RegQueryStringValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Internet Explorer', 'Version', sVersion);
except
end;
if (not RegLookupOK) or (RegLookupOK and (sVersion = '')) then begin
if GetWindowsVersion = wvWin95 then
Result := scHelpFileName + '.' + scHLP;
end;
end;
No comments:
Post a Comment