pascal
/
innosetup
peilaus alkaen https://github.com/jrsoftware/issrc.git


			
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266
							; -- 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', '<html><body>Inno Setup rocks!</body></html>', 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;