; -- CodeAutomation.iss -- ; ; This script shows how to use IDispatch based COM Automation objects. [Setup] AppName=My Program AppVersion=1.5 WizardStyle=modern dynamic DisableWelcomePage=no CreateAppDir=no Uninstallable=no DisableProgramGroupPage=yes DefaultGroupName=My Program OutputDir=userdocs:Inno Setup Examples Output [Code] {--- IIS ---} const IISServerName = 'localhost'; IISServerNumber = '1'; IISURL = 'http://127.0.0.1'; procedure IISButtonOnClick(Sender: TObject); var IIS, WebSite, WebServer, WebRoot, VDir: Variant; ErrorCode: Integer; begin if MsgBox('Setup will now connect to Microsoft IIS Server ''' + IISServerName + ''' and create a virtual directory. Do you want to continue?', mbInformation, mb_YesNo) = idNo then Exit; { Create the main IIS COM Automation object } try IIS := CreateOleObject('IISNamespace'); except RaiseException('Please install Microsoft IIS first.'#13#13'(Error ''' + GetExceptionMessage + ''' occurred)'); end; { Connect to the IIS server } WebSite := IIS.GetObject('IIsWebService', IISServerName + '/w3svc'); WebServer := WebSite.GetObject('IIsWebServer', IISServerNumber); WebRoot := WebServer.GetObject('IIsWebVirtualDir', 'Root'); { (Re)create a virtual dir } try WebRoot.Delete('IIsWebVirtualDir', 'innosetup'); WebRoot.SetInfo(); except end; VDir := WebRoot.Create('IIsWebVirtualDir', 'innosetup'); VDir.AccessRead := True; VDir.AppFriendlyName := 'Inno Setup'; VDir.Path := 'C:\inetpub\innosetup'; VDir.AppCreate(True); VDir.SetInfo(); MsgBox('Created virtual directory ''' + VDir.Path + '''.', mbInformation, mb_Ok); { Write some html and display it } if MsgBox('Setup will now write some HTML and display the virtual directory. Do you want to continue?', mbInformation, mb_YesNo) = idNo then Exit; ForceDirectories(VDir.Path); SaveStringToFile(VDir.Path + '/index.htm', 'Inno Setup rocks!', False); if not ShellExecAsOriginalUser('open', IISURL + '/innosetup/index.htm', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode) then MsgBox('Can''t display the created virtual directory: ''' + SysErrorMessage(ErrorCode) + '''.', mbError, mb_Ok); end; {--- MSXML ---} const XMLURL = 'https://jrsoftware.github.io/issrc/ISHelp/isxfunc.xml'; XMLFileName = 'isxfunc.xml'; XMLFileName2 = 'isxfuncmodified.xml'; procedure MSXMLButtonOnClick(Sender: TObject); var XMLHTTP, XMLDoc, NewNode, RootNode: Variant; Path: String; begin if MsgBox('Setup will now use MSXML to download XML file ''' + XMLURL + ''' and save it to the source folder.'#13#13'Setup will then load, modify and save this XML file. Do you want to continue?', mbInformation, mb_YesNo) = idNo then Exit; { Create the main MSXML COM Automation object } try XMLHTTP := CreateOleObject('MSXML2.ServerXMLHTTP'); except RaiseException('Please install MSXML first.'#13#13'(Error ''' + GetExceptionMessage + ''' occurred)'); end; { Download the XML file } XMLHTTP.Open('GET', XMLURL, False); XMLHTTP.Send(); Path := ExpandConstant('{src}\'); XMLHTTP.responseXML.Save(Path + XMLFileName); MsgBox('Downloaded the XML file and saved it as ''' + XMLFileName + '''.', mbInformation, mb_Ok); { Load the XML File } XMLDoc := CreateOleObject('MSXML2.DOMDocument'); XMLDoc.async := False; XMLDoc.resolveExternals := False; XMLDoc.load(Path + XMLFileName); if XMLDoc.parseError.errorCode <> 0 then RaiseException('Error on line ' + IntToStr(XMLDoc.parseError.line) + ', position ' + IntToStr(XMLDoc.parseError.linepos) + ': ' + XMLDoc.parseError.reason); MsgBox('Loaded the XML file.', mbInformation, mb_Ok); { Modify the XML document } NewNode := XMLDoc.createElement('isxdemo'); RootNode := XMLDoc.documentElement; RootNode.appendChild(NewNode); RootNode.lastChild.text := 'Hello, World'; { Save the XML document } XMLDoc.Save(Path + XMLFileName2); MsgBox('Saved the modified XML as ''' + XMLFileName2 + '''.', mbInformation, mb_Ok); end; {--- Word ---} procedure WordButtonOnClick(Sender: TObject); var Word: Variant; begin if MsgBox('Setup will now check whether Microsoft Word is running. Do you want to continue?', mbInformation, mb_YesNo) = idNo then Exit; { Try to get an active Word COM Automation object } try Word := GetActiveOleObject('Word.Application'); except end; if VarIsEmpty(Word) then MsgBox('Microsoft Word is not running.', mbInformation, mb_Ok) else MsgBox('Microsoft Word is running.', mbInformation, mb_Ok) end; {--- Windows Firewall ---} const NET_FW_IP_VERSION_ANY = 2; NET_FW_SCOPE_ALL = 0; procedure FirewallButtonOnClick(Sender: TObject); var Firewall, Application: Variant; begin if MsgBox('Setup will now add itself to Windows Firewall as an authorized application for the current profile (' + GetUserNameString + '). Do you want to continue?', mbInformation, mb_YesNo) = idNo then Exit; { Create the main Windows Firewall COM Automation object } try Firewall := CreateOleObject('HNetCfg.FwMgr'); except RaiseException('Please install Windows Firewall first.'#13#13'(Error ''' + GetExceptionMessage + ''' occurred)'); end; { Add the authorization } Application := CreateOleObject('HNetCfg.FwAuthorizedApplication'); Application.Name := 'Setup'; Application.IPVersion := NET_FW_IP_VERSION_ANY; Application.ProcessImageFileName := ExpandConstant('{srcexe}'); Application.Scope := NET_FW_SCOPE_ALL; Application.Enabled := True; Firewall.LocalPolicy.CurrentProfile.AuthorizedApplications.Add(Application); MsgBox('Setup is now an authorized application for the current profile', mbInformation, mb_Ok); end; {--- Unzip ---} const ZipURL = 'https://jrsoftware.org/download.php/iscrypt.zip'; ZipFileName = 'iscrypt.zip'; ZipSHA256 = '0569ffe1677ba699d07063a902d48c2f92c8e88669bdc13118f5808c30e998bc'; SHCONTCH_NOPROGRESSBOX = 4; SHCONTCH_RESPONDYESTOALL = 16; procedure UnzipButtonOnClick(Sender: TObject); var Shell, ZipFolder, TargetFolder: Variant; ZipPath, TargetPath: String; begin if MsgBox('Setup will now download Zip file ''' + ZipURL + ''' and save it to a temporary folder.'#13#13'Setup will then unzip this Zip file to the source folder. Do you want to continue?', mbInformation, mb_YesNo) = idNo then Exit; { Download the Zip file } DownloadTemporaryFile(ZipURL + '?dontcount=1', ZipFileName, ZipSHA256, nil); ZipPath := ExpandConstant('{tmp}\' + ZipFileName); MsgBox('Downloaded the Zip file and saved it as ''' + ZipPath + '''.', mbInformation, mb_Ok); { Unzip the Zip file to the source folder } Shell := CreateOleObject('Shell.Application'); ZipFolder := Shell.NameSpace(ZipPath); if VarIsClear(ZipFolder) then RaiseException(Format('Zip file ''%s'' does not exist or cannot be opened', [ZipPath])); TargetPath := ExpandConstant('{src}'); TargetFolder := Shell.NameSpace(TargetPath); if VarIsClear(TargetFolder) then RaiseException(Format('Target ''%s'' does not exist', [TargetPath])); TargetFolder.CopyHere(ZipFolder.Items, SHCONTCH_NOPROGRESSBOX or SHCONTCH_RESPONDYESTOALL); MsgBox('Unzipped the Zip file to ''' + TargetPath + '''.', mbInformation, mb_Ok); end; {---} procedure CreateButton(ALeft, ATop: Integer; ACaption: String; ANotifyEvent: TNotifyEvent); begin with TNewButton.Create(WizardForm) do begin Left := ALeft; Top := ATop; Width := WizardForm.CancelButton.Width; Height := WizardForm.CancelButton.Height; Caption := ACaption; OnClick := ANotifyEvent; Parent := WizardForm.WelcomePage; end; end; procedure InitializeWizard(); var Left, Top, TopInc: Integer; begin WizardForm.WelcomeLabel2.AdjustHeight; Top := WizardForm.WelcomeLabel2.Top + WizardForm.WelcomeLabel2.Height + ScaleY(8); Left := WizardForm.WelcomeLabel2.Left; TopInc := WizardForm.CancelButton.Height + ScaleY(8); CreateButton(Left, Top, '&Firewall...', @FirewallButtonOnClick); Top := Top + TopInc; CreateButton(Left, Top, '&IIS...', @IISButtonOnClick); Top := Top + TopInc; CreateButton(Left, Top, '&MSXML...', @MSXMLButtonOnClick); Top := Top + TopInc; CreateButton(Left, Top, '&Word...', @WordButtonOnClick); Top := Top + TopInc; CreateButton(Left, Top, '&Unzip...', @UnzipButtonOnClick); end;