I want to see the drives combobox so users can choose which drive to install on.
But when I run install I don't see the combobox at all?
Maybe someone can see what's wrong with this code? I copied it from another website but it just doesn't show the drive combobox therefore I can't select the drive to install on.
Here is my code:
var
// combo box for drives
cbDrive : TComboBox ;
// array fo string that keep the drive letters
DrvLetters: array of String;
function GetDriveType( lpDisk: String ): Integer;
external 'GetDriveTypeA#kernel32.dll stdcall';
function GetLogicalDriveStrings( nLenDrives: LongInt; lpDrives: String ): Integer;
external 'GetLogicalDriveStringsA#kernel32.dll stdcall';
const
DRIVE_UNKNOWN = 0; // The drive type cannot be determined.
DRIVE_NO_ROOT_DIR = 1; // The root path is invalid. For example, no volume is mounted at the path.
DRIVE_REMOVABLE = 2; // The disk can be removed from the drive.
DRIVE_FIXED = 3; // The disk cannot be removed from the drive.
DRIVE_REMOTE = 4; // The drive is a remote (network) drive.
DRIVE_CDROM = 5; // The drive is a CD-ROM drive.
DRIVE_RAMDISK = 6; // The drive is a RAM disk.
// function to convert disk type to string
function DriveTypeString( dtype: Integer ): String ;
begin
case dtype of
DRIVE_NO_ROOT_DIR : Result := 'Root path invalid';
DRIVE_REMOVABLE : Result := 'Removable';
DRIVE_FIXED : Result := 'Fixed';
DRIVE_REMOTE : Result := 'Network';
DRIVE_CDROM : Result := 'CD-ROM';
DRIVE_RAMDISK : Result := 'Ram disk';
else
Result := 'Unknown';
end;
end;
// change folder accordigly to the drive letter selected
procedure cbDriveOnClick(Sender: TObject);
begin
WizardForm.DirEdit.Text := DrvLetters[ cbDrive.ItemIndex ] + UpperCase(ExpandConstant('{#MyAppName}'));
end;
procedure FillCombo();
var
n: Integer;
drivesletters: String; lenletters: Integer;
drive: String;
disktype, posnull: Integer;
sd: String;
begin
//get the system drive
sd := UpperCase(ExpandConstant('{sd}'));
//get all drives letters of system
drivesletters := StringOfChar( ' ', 64 );
lenletters := GetLogicalDriveStrings( 63, drivesletters );
SetLength( drivesletters , lenletters );
drive := '';
n := 0;
while ( (Length(drivesletters) > 0) ) do
begin
posnull := Pos( #0, drivesletters );
if posnull > 0 then
begin
drive:= UpperCase( Copy( drivesletters, 1, posnull - 1 ) );
// get number type of disk
disktype := GetDriveType( drive );
// add it only if it is not a floppy
if ( not ( disktype = DRIVE_REMOVABLE ) ) then
begin
cbDrive.Items.Add( drive + ' [' + DriveTypeString( disktype ) + ']' )
SetArrayLength(DrvLetters, N+1);
DrvLetters[n] := drive;
// default select C: Drive
//if ( Copy(drive,1,2) = 'C:' ) then cbDrive.ItemIndex := n;
// or default to system drive
if ( Copy(drive,1,2) = sd ) then cbDrive.ItemIndex := n;
n := n + 1;
end
drivesletters := Copy( drivesletters, posnull+1, Length(drivesletters));
end
end;
cbDriveOnClick( cbDrive );
end;
procedure InitializeWizard();
begin
// create the combo box for drives
cbDrive:= TComboBox.Create(WizardForm.SelectDirPage);
with cbDrive do
begin
Parent := WizardForm.DirEdit.Parent;
Left := WizardForm.DirEdit.Left;
Top := WizardForm.DirEdit.Top + WizardForm.DirEdit.Height * 2;
Width := WizardForm.DirEdit.Width;
Style := csDropDownList;
end;
// hide the Browse button
WizardForm.DirBrowseButton.Visible := true;
// Edit box for folder don't have to be editable
WizardForm.DirEdit.Enabled := true;
// fill combo box with Drives
FillCombo;
// set the event on combo change
cbDrive.OnClick := #cbDriveOnClick ;
end;
procedure MyAfterInstall2(FileName: String);
begin
MsgBox('Just installed ' + FileName + ' as ' + CurrentFileName + '.', mbInformation, MB_OK);
end;
Works for me. At least in Unicode version of Inno Setup, once I make the code compatible with the Unicode version by:
Adding missing ; after end before drivesletters := Copy( drivesletters, posnull+1, Length(drivesletters));
Using Unicode version of GetDriveType and GetLogicalDriveStrings by replacing A# with W#.
Related
I have Inno Setup code to show error message when installing a setup developed using Inno Setup. The error message will shown when date of expire happens.
The code is as follows:
const MY_EXPIRY_DATE_STR = '20171112'; // Date format: yyyymmdd
function InitializeSetup(): Boolean;
begin
// If current date exceeds MY_EXPIRY_DATE_STR then return false and
// exit Installer.
Result :=
CompareStr(GetDateTimeString('yyyymmdd', #0,#0), MY_EXPIRY_DATE_STR) <= 0;
if not Result then
MsgBox('Due to some problem', mbError, MB_OK);
end;
Now my question is that I want verify the date using internet, not by local system date.
Use some online service to retrieve the time (or build your own service).
See Free Rest API to retrieve current datetime as string (timezone irrelevant).
Make sure, you use HTTPS, so that it not easy to bypass the check.
The following example uses TimeZoneDB service.
You have to set your own API key (that you get after a free registration).
const
TimezoneDbApiKey = 'XXXXXXXXXXXX';
function GetOnlineTime: string;
var
Url: string;
XMLDocument: Variant;
XMLNodeList: Variant;
WinHttpReq: Variant;
S: string;
P: Integer;
begin
try
// Retrieve XML from with current time in London
// See https://timezonedb.com/references/get-time-zone
WinHttpReq := CreateOleObject('WinHttp.WinHttpRequest.5.1');
Url :=
'https://api.timezonedb.com/v2/get-time-zone?key=' + TimezoneDbApiKey +
'&format=xml&by=zone&zone=Europe/London';
WinHttpReq.Open('GET', Url, False);
WinHttpReq.Send('');
if WinHttpReq.Status <> 200 then
begin
Log('HTTP Error: ' + IntToStr(WinHttpReq.Status) + ' ' +
WinHttpReq.StatusText);
end
else
begin
Log('HTTP Response: ' + WinHttpReq.ResponseText);
// Parse the XML
XMLDocument := CreateOleObject('Msxml2.DOMDocument.6.0');
XMLDocument.async := False;
XMLDocument.loadXML(WinHttpReq.ResponseText);
if XMLDocument.parseError.errorCode <> 0 then
begin
Log('The XML file could not be parsed. ' + XMLDocument.parseError.reason);
end
else
begin
XMLDocument.setProperty('SelectionLanguage', 'XPath');
XMLNodeList := XMLDocument.selectNodes('/result/formatted');
if XMLNodeList.length > 0 then
begin
S := Trim(XMLNodeList.item[0].text);
// Remove the time portion
P := Pos(' ', S);
if P > 0 then
begin
S := Copy(S, 1, P - 1);
// Remove the dashes to get format yyyymmdd
StringChange(S, '-', '');
if Length(S) <> 8 then
begin
Log('Unexpected date format: ' + S);
end
else
begin
Result := S;
end;
end;
end;
end;
end;
except
Log('Error: ' + GetExceptionMessage);
end;
if Result = '' then
begin
// On any problem, fallback to local time
Result := GetDateTimeString('yyyymmdd', #0, #0);
end;
end;
I am trying to use MultiByteToWideChar but i get 'undeclared identifier' . Where is it declared ? which 'uses' ?
I am using Embarcadero Delphi XE8.
The MultiByteToWideChar Windows API function (Win32/Win64) is defined in Delphi or FreePascal in the Windows unit; just add Windows or Winapi.Windows to the uses clause.
You may wish to use wrapper function written in Delphi to convert RawByteString (or AnsiString) to UnicodeString and vice versa, rather than calling the MultiByteToWideChar directly. Calling it directly may be prone to errors due to incorrect calculation of the lengths of the underlying buffers.
Please note that Delphi RawByteString or AnsiString have a property to store the Windows code page value, and it is set by the SetCodePage() call in the code below. The code uses explicit types, PAnsiChar vs PWideChar and RawByteString vs UnicodeString to avoid ambiguity.
uses
Windows;
const
CP_UNICODE_LE = 1200;
function StringToWideStringCP(const S: RawByteString; CP: Integer): UnicodeString;
var
P: PAnsiChar;
pw: PWideChar;
I, J: Integer;
begin
Result := '';
if S = '' then
Exit;
if CP = CP_UTF8 then
begin
// UTF8
Result := UTF8ToUnicodeString(S);
Exit;
end;
P := #S[1];
I := MultiByteToWideChar(CP, 0, P, Length(S), nil, 0);
if I <= 0 then
Exit;
SetLength(Result, I);
pw := #Result[1];
J := MultiByteToWideChar(CP, 0, P, Length(S), pw, I);
if I <> J then
SetLength(Result, Min(I, J));
end;
function WideStringToStringCP(const w: UnicodeString; CP: Integer)
: RawByteString;
var
P: PWideChar;
I, J: Integer;
begin
Result := '';
if w = '' then
Exit;
case CP of
CP_UTF8:
begin
// UTF8
Result := UTF8Encode(w);
Exit;
end;
CP_UNICODE_LE:
begin
// Unicode codepage
CP := CP_ACP;
end;
end;
P := #w[1];
I := WideCharToMultibyte(CP, 0, P, Length(w), nil, 0, nil, nil);
if I <= 0 then
Exit;
SetLength(Result, I);
J := WideCharToMultibyte(CP, 0, P, Length(w), #Result[1], I, nil, nil);
if I <> J then
SetLength(Result, Min(I, J));
SetCodePage(Result, CP, False);
end;
It is a Windows API function, so if you want to call it you must use Winapi.Windows.
If you write cross platform code then call UnicodeFromLocaleChars instead.
I am developing an installer using Inno Setup targeting XP, Win7, 8. I need the app icon to be pinned to taskbar and the startmenu. So far I have been able to do that.
Now, when the user uninstalls this program, the pinned items should be unpinned. I haven't managed to find a solution to this.
Please guide.
You've said that you have used a function from this link. I assume the one from this post:
procedure zylPinAppToTaskbar(strPath, strApp: string);
var
vShell, vFolder, vFolderItem, vItemVerbs: Variant;
vPath, vApp: Variant;
i: Integer;
sItem: String;
h: LongInt;
szPinName: String;
filenameEnd : Integer;
filename : String;
strEnd : String;
begin
SetLength(szPinName, 255);
h := LoadLibrary(ExpandConstant('{sys}\Shell32.dll'));
LoadString(h, 5386, szPinName, 255);
FreeLibrary(h);
strEnd := #0;
filenameEnd := Pos(strEnd, szPinName);
filename := Copy(szPinName, 1, filenameEnd - 1);
if (Length(filename) > 0) then //WinXp or lower, no pin taskbar function
begin
vShell := CreateOleObject('Shell.Application');
vPath := strPath;
vFolder := vShell.NameSpace(vPath);
vApp := strApp;
vFolderItem := vFolder.ParseName(vApp);
vItemVerbs := vFolderItem.Verbs;
for i := 1 to vItemVerbs.Count do
begin
sItem := vItemVerbs.Item(i).Name;
if (sItem = filename) then
begin
// 63 63 72 75 6E 2E 63 6F 6D
vItemVerbs.Item(i).DoIt;
break;
end;
end;
end;
end;
That's really hacky way (which I wouldn't rely on). Let's focus now on what it actually does. The function loads the Shell32.dll library and reads from its string table the caption of the popup menu item that belongs to the Pin this program to taskbar feature (and stores it into the filename variable). Then it connects to Shell and creates the Folder object for the passed folder path (vFolder variable). For this folder object it then creates the FolderItem object (vFolderItem variable) and on this object iterates all the available verbs (vItemVerbs variable) and checks if the Name matches the one read from the Shell32.dll library. If it finds one, it invokes the action by the DoIt method and breaks the iteration.
Now if you know what the above code does, you can guess that the only thing you need to do to perform the unpin action is finding the caption of the popup menu item for that feature. I've looked into the string table of the Shell32.dll library and the Unpin this program from taskbar string has ID 5387, so the only thing to modify the above function for unpinning is changing this line:
// this magical 5386 value is the ID of the "Pin this program to taskbar"
// popup menu caption string in the Shell32.dll string table
LoadString(h, 5386, szPinName, 255);
To this:
// this magical 5387 value is the ID of the "Unpin this program from taskbar"
// popup menu caption string in the Shell32.dll string table
LoadString(h, 5387, szPinName, 255);
But I do not recommend that way. There is no official way to pin program to taskbar because that's been reserved for the user to decide.
As a bonus, I wrote the following wrapper for the above code:
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
const
// these constants are not defined in Windows
SHELL32_STRING_ID_PIN_TO_TASKBAR = 5386;
SHELL32_STRING_ID_PIN_TO_STARTMENU = 5381;
SHELL32_STRING_ID_UNPIN_FROM_TASKBAR = 5387;
SHELL32_STRING_ID_UNPIN_FROM_STARTMENU = 5382;
type
HINSTANCE = THandle;
HMODULE = HINSTANCE;
TPinDest = (
pdTaskbar,
pdStartMenu
);
function LoadLibrary(lpFileName: string): HMODULE;
external 'LoadLibrary{#AW}#kernel32.dll stdcall';
function FreeLibrary(hModule: HMODULE): BOOL;
external 'FreeLibrary#kernel32.dll stdcall';
function LoadString(hInstance: HINSTANCE; uID: UINT;
lpBuffer: string; nBufferMax: Integer): Integer;
external 'LoadString{#AW}#user32.dll stdcall';
function TryGetVerbName(ID: UINT; out VerbName: string): Boolean;
var
Buffer: string;
BufLen: Integer;
Handle: HMODULE;
begin
Result := False;
Handle := LoadLibrary(ExpandConstant('{sys}\Shell32.dll'));
if Handle <> 0 then
try
SetLength(Buffer, 255);
BufLen := LoadString(Handle, ID, Buffer, Length(Buffer));
if BufLen <> 0 then
begin
Result := True;
VerbName := Copy(Buffer, 1, BufLen);
end;
finally
FreeLibrary(Handle);
end;
end;
function ExecVerb(const FileName, VerbName: string): Boolean;
var
I: Integer;
Shell: Variant;
Folder: Variant;
FolderItem: Variant;
begin
Result := False;
Shell := CreateOleObject('Shell.Application');
Folder := Shell.NameSpace(ExtractFilePath(FileName));
FolderItem := Folder.ParseName(ExtractFileName(FileName));
for I := 1 to FolderItem.Verbs.Count do
begin
if FolderItem.Verbs.Item(I).Name = VerbName then
begin
FolderItem.Verbs.Item(I).DoIt;
Result := True;
Exit;
end;
end;
end;
function PinAppTo(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_PIN_TO_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_PIN_TO_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
function UnpinAppFrom(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
And its possible usage, for pinning:
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc has been pinned to the taskbar.', mbInformation, MB_OK);
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc has been pinned to the start menu.', mbInformation, MB_OK);
And for unpinning:
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc is not pinned to the taskbar anymore.', mbInformation, MB_OK);
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc is not pinned to the start menu anymore.', mbInformation, MB_OK);
I was able to do it. Here's the code to pin and unpin from the startmenu and taskbar.
oShell := CreateOleObject('Shell.Application');
objFolder := oShell.Namespace(ExpandConstant('{localappdata}\My_Path'));
objFolderItem := objFolder.ParseName('MyApp.exe');
colVerbs := objFolderItem.Verbs();
for i := 0 to colverbs.count() do
begin
VerbName := lowercase(colverbs.item(i).name);
StringChangeEx(VerbName,'&','',true);
if (CompareText(Verbname, 'Pin to Start Menu') = 0) then
colverbs.item(i).DoIt
if (CompareText(Verbname, 'Pin to Taskbar') = 0) then
colverbs.item(i).DoIt
end;
Change the compare string to 'Unpin from Start Menu' and 'Unpin from Taskbar' at the time of unpinning.
Can I allow the user to only choose the drive in which the software will be installed?
For example they can choose the C or D drive:
C:\Software
D:\Software
But the user can not specify anything else,
Like they can't choose to install the software under Downloads or MyDocumnets … etc.
Is this possible?
How to restrict users to select only drive on which the software will be installed ?
There are hundreds of ways to design this restriction. I chose the one which creates a combo box with available paths that user can choose from. This code as first lists all fixed drives on the machine, and if there's at least one, it creates the combo box which is placed instead of original dir selection controls. It is filled with drive names followed by a fixed directory taken from the DefaultDirName directive value which must not contain a drive portion since it is already concatenated with found fixed drive roots:
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName=My Program
[Messages]
SelectDirBrowseLabel=To continue, click Next.
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
type
TDriveType = (
dtUnknown,
dtNoRootDir,
dtRemovable,
dtFixed,
dtRemote,
dtCDROM,
dtRAMDisk
);
TDriveTypes = set of TDriveType;
function GetDriveType(lpRootPathName: string): UINT;
external 'GetDriveType{#AW}#kernel32.dll stdcall';
function GetLogicalDriveStrings(nBufferLength: DWORD; lpBuffer: string): DWORD;
external 'GetLogicalDriveStrings{#AW}#kernel32.dll stdcall';
var
DirCombo: TNewComboBox;
#ifndef UNICODE
function IntToDriveType(Value: UINT): TDriveType;
begin
Result := dtUnknown;
case Value of
1: Result := dtNoRootDir;
2: Result := dtRemovable;
3: Result := dtFixed;
4: Result := dtRemote;
5: Result := dtCDROM;
6: Result := dtRAMDisk;
end;
end;
#endif
function GetLogicalDrives(Filter: TDriveTypes; Drives: TStrings): Integer;
var
S: string;
I: Integer;
DriveRoot: string;
begin
Result := 0;
I := GetLogicalDriveStrings(0, #0);
if I > 0 then
begin
SetLength(S, I);
if GetLogicalDriveStrings(Length(S), S) > 0 then
begin
S := TrimRight(S) + #0;
I := Pos(#0, S);
while I > 0 do
begin
DriveRoot := Copy(S, 1, I - 1);
#ifdef UNICODE
if (Filter = []) or
(TDriveType(GetDriveType(DriveRoot)) in Filter) then
#else
if (Filter = []) or
(IntToDriveType(GetDriveType(DriveRoot)) in Filter) then
#endif
begin
Drives.Add(DriveRoot);
end;
Delete(S, 1, I);
I := Pos(#0, S);
end;
Result := Drives.Count;
end;
end;
end;
procedure DriveComboChange(Sender: TObject);
begin
WizardForm.DirEdit.Text := DirCombo.Text;
end;
procedure InitializeWizard;
var
I: Integer;
StringList: TStringList;
begin
StringList := TStringList.Create;
try
if GetLogicalDrives([dtFixed], StringList) > 0 then
begin
WizardForm.DirEdit.Visible := False;
WizardForm.DirBrowseButton.Visible := False;
DirCombo := TNewComboBox.Create(WizardForm);
DirCombo.Parent := WizardForm.DirEdit.Parent;
DirCombo.SetBounds(WizardForm.DirEdit.Left, WizardForm.DirEdit.Top,
WizardForm.DirBrowseButton.Left + WizardForm.DirBrowseButton.Width -
WizardForm.DirEdit.Left, WizardForm.DirEdit.Height);
DirCombo.Style := csDropDownList;
DirCombo.OnChange := #DriveComboChange;
for I := 0 to StringList.Count - 1 do
DirCombo.Items.Add(StringList[I] + '{#SetupSetting('DefaultDirName')}');
DirCombo.ItemIndex := 0;
DirCombo.OnChange(nil);
end;
finally
StringList.Free;
end;
end;
And a screenshot:
How to create CustomPage in Inno Setup with Edit Boxes for Serial Number?
E.g. 6x5chars or 7x5chars?
Script should check if all boxes are filled before Next button become available.
It would be also good if there could be Copy/Paste function implemented that would allow to fill up all Edit Boxes if the clipboard content matches the serial number pattern.
Here is one approach that uses the custom page where the separate edit boxes are created. You only need to specify the value for the SC_EDITCOUNT constant where the number of edit boxes is defined and the SC_CHARCOUNT what is the number of characters that can be entered into these edit boxes. If you are in the first edit box you may paste the whole serial number if it's in the format by the pattern delimited by the - char (the TryPasteSerialNumber function here). To get the serial number from the edit boxes it's enough to call GetSerialNumber where you can specify also a delimiter for the output format (if needed).
[Setup]
AppName=Serial number project
AppVersion=1.0
DefaultDirName={pf}\Serial number project
[code]
function SetFocus(hWnd: HWND): HWND;
external 'SetFocus#user32.dll stdcall';
function OpenClipboard(hWndNewOwner: HWND): BOOL;
external 'OpenClipboard#user32.dll stdcall';
function GetClipboardData(uFormat: UINT): THandle;
external 'GetClipboardData#user32.dll stdcall';
function CloseClipboard: BOOL;
external 'CloseClipboard#user32.dll stdcall';
function GlobalLock(hMem: THandle): PAnsiChar;
external 'GlobalLock#kernel32.dll stdcall';
function GlobalUnlock(hMem: THandle): BOOL;
external 'GlobalUnlock#kernel32.dll stdcall';
var
SerialPage: TWizardPage;
SerialEdits: array of TEdit;
const
CF_TEXT = 1;
VK_BACK = 8;
SC_EDITCOUNT = 6;
SC_CHARCOUNT = 5;
SC_DELIMITER = '-';
function IsValidInput: Boolean;
var
I: Integer;
begin
Result := True;
for I := 0 to GetArrayLength(SerialEdits) - 1 do
if Length(SerialEdits[I].Text) < SC_CHARCOUNT then
begin
Result := False;
Break;
end;
end;
function GetClipboardText: string;
var
Data: THandle;
begin
Result := '';
if OpenClipboard(0) then
try
Data := GetClipboardData(CF_TEXT);
if Data <> 0 then
Result := String(GlobalLock(Data));
finally
if Data <> 0 then
GlobalUnlock(Data);
CloseClipboard;
end;
end;
function GetSerialNumber(ADelimiter: Char): string;
var
I: Integer;
begin
Result := '';
for I := 0 to GetArrayLength(SerialEdits) - 1 do
Result := Result + SerialEdits[I].Text + ADelimiter;
Delete(Result, Length(Result), 1);
end;
function TrySetSerialNumber(const ASerialNumber: string; ADelimiter: Char): Boolean;
var
I: Integer;
J: Integer;
begin
Result := False;
if Length(ASerialNumber) = ((SC_EDITCOUNT * SC_CHARCOUNT) + (SC_EDITCOUNT - 1)) then
begin
for I := 1 to SC_EDITCOUNT - 1 do
if ASerialNumber[(I * SC_CHARCOUNT) + I] <> ADelimiter then
Exit;
for I := 0 to GetArrayLength(SerialEdits) - 1 do
begin
J := (I * SC_CHARCOUNT) + I + 1;
SerialEdits[I].Text := Copy(ASerialNumber, J, SC_CHARCOUNT);
end;
Result := True;
end;
end;
function TryPasteSerialNumber: Boolean;
begin
Result := TrySetSerialNumber(GetClipboardText, SC_DELIMITER);
end;
procedure OnSerialEditChange(Sender: TObject);
begin
WizardForm.NextButton.Enabled := IsValidInput;
end;
procedure OnSerialEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Edit: TEdit;
EditIndex: Integer;
begin
Edit := TEdit(Sender);
EditIndex := Edit.TabOrder - SerialEdits[0].TabOrder;
if (EditIndex = 0) and (Key = Ord('V')) and (Shift = [ssCtrl]) then
begin
if TryPasteSerialNumber then
Key := 0;
end
else
if (Key >= 32) and (Key <= 255) then
begin
if Length(Edit.Text) = SC_CHARCOUNT - 1 then
begin
if EditIndex < GetArrayLength(SerialEdits) - 1 then
SetFocus(SerialEdits[EditIndex + 1].Handle)
else
SetFocus(WizardForm.NextButton.Handle);
end;
end
else
if Key = VK_BACK then
if (EditIndex > 0) and (Edit.Text = '') and (Edit.SelStart = 0) then
SetFocus(SerialEdits[EditIndex - 1].Handle);
end;
procedure CreateSerialNumberPage;
var
I: Integer;
Edit: TEdit;
DescLabel: TLabel;
EditWidth: Integer;
begin
SerialPage := CreateCustomPage(wpWelcome, 'Serial number validation',
'Enter the valid serial number');
DescLabel := TLabel.Create(SerialPage);
DescLabel.Top := 16;
DescLabel.Left := 0;
DescLabel.Parent := SerialPage.Surface;
DescLabel.Caption := 'Enter valid serial number and continue the installation...';
DescLabel.Font.Style := [fsBold];
SetArrayLength(SerialEdits, SC_EDITCOUNT);
EditWidth := (SerialPage.SurfaceWidth - ((SC_EDITCOUNT - 1) * 8)) div SC_EDITCOUNT;
for I := 0 to SC_EDITCOUNT - 1 do
begin
Edit := TEdit.Create(SerialPage);
Edit.Top := 40;
Edit.Left := I * (EditWidth + 8);
Edit.Width := EditWidth;
Edit.CharCase := ecUpperCase;
Edit.MaxLength := SC_CHARCOUNT;
Edit.Parent := SerialPage.Surface;
Edit.OnChange := #OnSerialEditChange;
Edit.OnKeyDown := #OnSerialEditKeyDown;
SerialEdits[I] := Edit;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = SerialPage.ID then
WizardForm.NextButton.Enabled := IsValidInput;
end;
procedure InitializeWizard;
begin
CreateSerialNumberPage;
end;
And here is how it looks like:
You can make Inno prompt the user for a serial key by adding an CheckSerial() event function.
If you want more control over the page, you can use one of the stock pages (CreateInput...Page) or a custom page in the setup wizard using CreateCustomPage() and adding controls as you require.
See the codedlg.iss example included with Inno setup.
The simplest way to add a Serial key box, beneath the Name and Organisation text fields, is to add something like the following to your iss file.
[Code]
function CheckSerial(Serial: String): Boolean;
begin
// serial format is XXXX-XXXX-XXXX-XXXX
Serial := Trim(Serial);
if Length(Serial) = 19 then
result := true;
end;
This can be usefully combined with
[Setup]
DefaultUserInfoSerial={param:Serial}
which will fill in the serial if previously entered for the install.