广告合作QQ：76874919

asp.net – Inno安装IIS安装和配置

asp.Net 2020-01-24
我一直试图弄清楚如何使用Inno安装脚本安装和注册IIS,但到目前为止我还没有成功.

我需要创建一个带有.Net版本4的应用程序池和一个虚拟目录,获取机器的IP并继续使用此IP编辑网站的绑定.

到目前为止,我的安装中的所有工作都是检查IIS是否已安装.

如果有人曾经做过这样的事情,我真的很感激你能否分享你的剧本.

谢谢.

解决方法

这是我使用Inno Setup处理IIS(Internet信息服务)的完整代码.
它包含：

>安装.NET Framework 4
>安装/卸载IIS ASP.NET 4
>注册和删除网站/应用程序
>帮助用户帐户运行应用程序池
>帮助者获取网站的物理路径

它已经过以下Windows版本的测试：
XP专业版SP3 x86,2003 R2 x86,2003 R2 x64,Vista Ultimate x64,7家庭高级版x64,2008 R2 x64,2011 x64,8.1 Pro x86,10 Pro x64

一切都尽可能地被动完成,不会破坏任何现有的网站.

重要

这可能需要Inno-Setup的Unicode版本(我使用的是5.5.6(u)).
它还需要在x64机器上强制使用64位模式(否则注册表和文件访问将重定向到32位内容)：

[Setup]
ArchitecturesInstallIn64BitMode=x64

要求助手

>一些常数
> ExpandEnvironmentStrings => https://msdn.microsoft.com/en-us/library/windows/desktop/ms724265%28v=vs.85%29.aspx
> ExecWithResult =>读取写入STDOUT的内容
> IIs7ExecAppCmd =>从Vista / 2008开始,IIS安装是必需的

#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif

const
  // See https://msdn.microsoft.com/en-us/library/windows/desktop/ms681382.aspx
  ERROR_SUCCESS = 0;
  ERROR_INVALID_FUNCTION = 1;
  ERROR_NOT_SUPPORTED = 50;
  ERROR_NOT_FOUND = 1168;
  ERROR_SUCCESS_REBOOT_required = 3010;

function ExpandEnvironmentStrings(lpSrc: String; lpDst: String; nSize: DWORD): DWORD;
  external 'ExpandEnvironmentStrings{#AW}@kernel32.dll stdcall';
function ExpandEnvVars(const Input: String): String;
var
  Buf: String;
  BufSize: DWORD;
begin
  BufSize := ExpandEnvironmentStrings(Input,#0,0);
  if BufSize > 0 then
  begin
    SetLength(Buf,BufSize);
    if ExpandEnvironmentStrings(Input,Buf,BufSize) = 0 then
      RaiseException(Format('Expanding env. strings Failed. %s',[SysErrorMessage(DLLGetLastError)]));
#if AW == "A"
    Result := Copy(Buf,1,BufSize - 2);
#else
    Result := Copy(Buf,BufSize - 1);
#endif
  end
  else
    RaiseException(Format('Expanding env. strings Failed. %s',[SysErrorMessage(DLLGetLastError)]));
end;

// Exec with output stored in result. ResultString will only be altered if True is returned.
function ExecWithResult(const Filename,Params,WorkingDir: String; const ShowCmd: Integer; const Wait: TExecWait; var ResultCode: Integer; var ResultString: String): Boolean;
var
  TempFilename: String;
  TempAnsiStr: AnsiString;
  Command: String;
begin
  TempFilename := ExpandConstant('{tmp}\~execwithresult.txt');
  // Exec via cmd and redirect output to file. Must use special string-behavior to work.
  Command := Format('"%s" /S /C ""%s" %s > "%s""',[ExpandConstant('{cmd}'),Filename,TempFilename]);
  Result := Exec(ExpandConstant('{cmd}'),Command,WorkingDir,ShowCmd,Wait,ResultCode);
  if not Result then
    Exit;
  LoadStringFromFile(TempFilename,TempAnsiStr);  // Cannot fail
  ResultString := String(TempAnsiStr);
  DeleteFile(TempFilename);
  // Remove new-line at the end
  if (Length(ResultString) >= 2) and (ResultString[Length(ResultString) - 1] = #13) and (ResultString[Length(ResultString)] = #10) then
    Delete(ResultString,Length(ResultString) - 1,2);
end;

function IIs7ExecAppCmd(Params: String; var ResultString: String; var ResultCode: Integer): Boolean;
var
  AppCmdFilePath: String;
  Command: String;
begin
  AppCmdFilePath := ExpandConstant('{sys}\inetsrv\appcmd.exe');
  Result := ExecWithResult(AppCmdFilePath,'',SW_HIDE,ewWaitUntilTerminated,ResultCode,ResultString);
end;

.NET 4安装

将为Win XP / 2003安装.NET 4.0.适用于Vista / 2008及更高版本的.NET 4.6.
如果系统已包含.NET 4(Win 8/2012/10),则无效.
以下文件是必需的,必须包含在设置中：

> .NET 4.0 Web安装程序“dotNetFx40_Full_setup.exe”=> https://www.microsoft.com/en-US/download/details.aspx?id=17851
> .NET 4.6 Web安装程序“NDP46-KB3045560-Web.exe”=> https://www.microsoft.com/de-de/download/details.aspx?id=48130
> WIC x64“wic_x64_enu.exe”=> https://www.microsoft.com/de-de/download/details.aspx?id=1385
> WIC x86“wic_x86_enu.exe”=> https://www.microsoft.com/de-de/download/details.aspx?id=32

– 

[Files]
Source: "dotNetFx40_Full_setup.exe"; DestDir: "{tmp}"; Flags: ignoreversion dontcopy
Source: "NDP46-KB3045560-Web.exe"; DestDir: "{tmp}"; Flags: ignoreversion dontcopy
Source: "wic_x64_enu.exe"; DestDir: "{tmp}"; Flags: ignoreversion dontcopy
Source: "wic_x86_enu.exe"; DestDir: "{tmp}"; Flags: ignoreversion dontcopy

由于我使用的是Web安装程序,因此在安装过程中可能需要连接互联网.

// Checks if .NET 4 "Full" is installed
function IsDotNet4FullInstalled(): Boolean;
var
  Success: Boolean;
  Install: Cardinal;
begin
  try
    ExpandConstant('{dotnet40}');  // This will throw an exception if .NET 4 is not installed at all
    Success := RegQueryDWordValue(HKLM,'SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full','Install',Install);  // Check for "Full" version
    Result := Success and (Install = 1);
  except
    Result := False;
  end;
end;

// Returns True if a restart is required.
function InstallDotNet4(): Boolean;
var
  Version: TWindowsVersion;
  ResultCode: Integer;
  Success: Boolean;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major <= 5) then  // 4.0 for XP,2003
    ExtractTemporaryFile('dotNetFx40_Full_setup.exe')
  else  // 4.6
    ExtractTemporaryFile('NDP46-KB3045560-Web.exe');
  if (Version.Major <= 5) then  // XP,2003: Install .NET 4.0
  begin
    Success := Exec(ExpandConstant('{tmp}\dotNetFx40_Full_setup.exe'),'/passive',ResultCode);
    if Success and (ResultCode = 5100) then  // Indicates that "Windows Imaging Component" is missing (probably 2003)
    begin
      if IsWin64 then
      begin
        ExtractTemporaryFile('wic_x64_enu.exe');
        if not Exec(ExpandConstant('{tmp}\wic_x64_enu.exe'),ResultCode) or (ResultCode <> ERROR_SUCCESS) then
          RaiseException('Failed to install "Windows Imaging Component": ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
        // Retry .NET
        Success := Exec(ExpandConstant('{tmp}\dotNetFx40_Full_setup.exe'),ResultCode);
      end
      else
      begin
        ExtractTemporaryFile('wic_x86_enu.exe');
        if not Exec(ExpandConstant('{tmp}\wic_x86_enu.exe'),ResultCode);
      end;
    end
  end
  else  // Vista / 2008 or later: Install .NET 4.6
    Success := Exec(ExpandConstant('{tmp}\NDP46-KB3045560-Web.exe'),ResultCode);
  // Check for errors
  if not Success or ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_SUCCESS_REBOOT_required)) then
    RaiseException('Failed to install .NET: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
  Result := ResultCode = ERROR_SUCCESS_REBOOT_required;
end;

IIS安装/卸载

使用ASP.NET安装IIS 4.将激活相同(默认)功能,就像通过GUI激活一样.
安装完成后,ASP.NET(重新)在IIS中注册.

注意：对于Win XP / 2003,需要“Windows安装CD”.

// Returns True if a restart is required. Throws exceptions.
function InstallIIs(): Boolean;
var
  Version: TWindowsVersion;
  Success: Boolean;
  ResultCode: Integer;
  IIS56IniFile: String;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major <= 5) then  // XP / 2003: Use "sysocmgr"
  begin
    IIS56IniFile := ExpandConstant('{tmp}\~iis56.ini');
    SaveStringToFile(IIS56IniFile,'[Components]' + #13#10 + 'iis_common = ON' + #13#10 + 'iis_www = ON' + #13#10 + 'iis_inetmgr = ON',False);
    Success := Exec('sysocmgr',ExpandConstant('/i:"{win}\inf\sysoc.inf" /u:"' + IIS56IniFile + '"'),SW_SHOW,ResultCode);
    DeleteFile(IIS56IniFile);
  end
  else if (Version.Major = 6) and (Version.Minor = 0) then  // Vista / 2008: Use "pkgmgr"
  begin
    Success := Exec('pkgmgr','/iu:' +
      // Enables everything a fresh install would also (implicitly) enable.
      // This is important in case IIS was already installed and some features manually disabled.
      'WAS-WindowsActivationService;WAS-ProcessModel;WAS-NetFxEnvironment;WAS-ConfigurationAPI' +
      ';IIS-WebServerRole' +
      ';IIS-WebServerManagementTools;IIS-ManagementConsole' +
      ';IIS-WebServer' +
      ';IIS-ApplicationDevelopment;IIS-NetFxExtensibility;IIS-ASPNET;IIS-ISAPIExtensions;IIS-ISAPIFilter' +
      ';IIS-CommonHttpFeatures;IIS-HttpErrors;IIS-DefaultDocument;IIS-StaticContent;IIS-DirectoryBrowsing' +
      ';IIS-Performance;IIS-HttpCompressionStatic' +
      ';IIS-Security;IIS-RequestFiltering' +
      ';IIS-HealthAndDiagnostics;IIS-RequestMonitor;IIS-HttpLogging',ResultCode);
  end
  else if (Version.Major = 6) and (Version.Minor = 1) then  // 7 / 2008 R2 / 2011: Use "Dism"
  begin
    Success := Exec('Dism','/Online /Enable-Feature' +
      // Enables everything a fresh install would also (implicitly) enable.
      // This is important in case IIS was already installed and some features manually disabled.
      // "Parent fetaures" are NOT automatically enabled by "Dism".
      ' /FeatureName:WAS-WindowsActivationService /FeatureName:WAS-ProcessModel /FeatureName:WAS-NetFxEnvironment /FeatureName:WAS-ConfigurationAPI' +
      ' /FeatureName:IIS-WebServerRole' +
      ' /FeatureName:IIS-WebServerManagementTools /FeatureName:IIS-ManagementConsole' +
      ' /FeatureName:IIS-WebServer' +
      ' /FeatureName:IIS-ApplicationDevelopment /FeatureName:IIS-NetFxExtensibility /FeatureName:IIS-ASPNET /FeatureName:IIS-ISAPIExtensions /FeatureName:IIS-ISAPIFilter' +
      ' /FeatureName:IIS-CommonHttpFeatures /FeatureName:IIS-HttpErrors /FeatureName:IIS-DefaultDocument /FeatureName:IIS-StaticContent /FeatureName:IIS-DirectoryBrowsing' +
      ' /FeatureName:IIS-Performance /FeatureName:IIS-HttpCompressionStatic' +
      ' /FeatureName:IIS-Security /FeatureName:IIS-RequestFiltering' +
      ' /FeatureName:IIS-HealthAndDiagnostics /FeatureName:IIS-RequestMonitor /FeatureName:IIS-HttpLogging',ResultCode);
  end
  else  // 8 / 2012 and later: Use "Dism"
  begin
    Success := Exec('Dism','/Online /Enable-Feature' +
      // Enables everything a fresh install would also (implicitly) enable.
      // This is important in case IIS was already installed and some features manually disabled.
      ' /FeatureName:WAS-WindowsActivationService /FeatureName:WAS-ProcessModel /FeatureName:WAS-NetFxEnvironment /FeatureName:WAS-ConfigurationAPI' +
      ' /FeatureName:IIS-ManagementConsole' +
      ' /FeatureName:IIS-HttpErrors /FeatureName:IIS-DefaultDocument /FeatureName:IIS-StaticContent /FeatureName:IIS-DirectoryBrowsing' +
      ' /FeatureName:IIS-ASPNET45' +
      ' /FeatureName:IIS-HttpCompressionStatic' +
      ' /FeatureName:IIS-RequestFiltering' +
      ' /FeatureName:IIS-HttpLogging' +
      ' /All',// Implicitly enables dependent features
      '',ResultCode);
  end;
  if not Success or ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_SUCCESS_REBOOT_required)) then
    RaiseException('Cannot install IIS: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
  Result := ResultCode = ERROR_SUCCESS_REBOOT_required;
  // Register ASP.NET 4 with IIS. This is required since .NET 4 was probably installed before IIS.
  // This will NOT change existing web-sites (which might be using other ASP.NET versions already)
  if not Exec(ExpandConstant('{dotnet40}') + '\aspnet_regiis.exe','-iru -enable',ResultCode) or
    (ResultCode <> ERROR_SUCCESS) then
    RaiseException('Cannot register ASP.NET: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
end;

// Returns True if a restart is required. Throws exceptions.
function UninstallIIs(): Boolean;
var
  Version: TWindowsVersion;
  Success: Boolean;
  ResultCode: Integer;
  IIS56IniFile: String;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major <= 5) then  // XP / 2003: Use "sysocmgr"
  begin
    IIS56IniFile := ExpandConstant('{tmp}\~iis56.ini');
    SaveStringToFile(IIS56IniFile,'[Components]' + #13#10 + 'iis_common = OFF' + #13#10 + 'iis_www = OFF' + #13#10 + 'iis_inetmgr = OFF',ResultCode);
    DeleteFile(IIS56IniFile);
  end
  else if (Version.Major = 6) and (Version.Minor = 0) then  // Vista / 2008: Use "pkgmgr"
    Success := Exec('pkgmgr','/norestart /uu:IIS-WebServerRole',ResultCode)
  else  // 7 / 2008 R2 and later: Use "Dism"
    Success := Exec('Dism','/NoRestart /Online /Disable-Feature /FeatureName:IIS-WebServerRole',ResultCode);
  if not Success or ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_SUCCESS_REBOOT_required)) then
    RaiseException('Cannot uninstall IIS: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
  Result := ResultCode = ERROR_SUCCESS_REBOOT_required;
end;

网站/应用程序注册和删除

创建虚拟目录和ASP.NET 4应用程序池.

注意：IIsServerNumber是实际的网站,通常默认为1(=>“默认网站”).

用法：

RegisterAppAtIIs('MyAppName','MyAppAppPoolName');
DeleteAppFromIIs('MyAppName','MyAppAppPoolName');
// Throws exceptions.
procedure RegisterAppAtIIs(const IIsAppName: String; const IIsServerNumber: Integer; const IIsApplicationPoolName: String);
var
  Version: TWindowsVersion;
  // IIS 5.1 - 6.0
  IIS,WebService,WebSite,WebRoot,vDir,AppPools,AppPool: Variant;
  // IIS 7 and later
  ResultCode: Integer;
  ExecResult: String;
  WebSiteName: String;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major = 5) and (Version.Minor <= 2) then  // XP,2003: IIS 5.1 - 6.0
  begin
    try
      // Create the main IIS COM Automation object
      IIS := CreateOleObject('IISNamespace');
      WebService := IIS.GetObject('IIsWebService','localhost/W3SVC');
      // Get web site
      WebSite := WebService.GetObject('IIsWebServer',IntToStr(IIsServerNumber));
      WebRoot := WebSite.GetObject('IIsWebVirtualDir','Root');
    except
      RaiseException(Format('Web-site #%d not found: ',[IIsServerNumber]) + GetExceptionMessage());
    end;
    // Delete the virtual dir if it already exists
    try
      WebRoot.Delete('IIsWebVirtualDir',IIsAppName);
      WebRoot.SetInfo();
    except
    end;
    if (Version.Minor = 1) then  // XP: IIS 5.1
    begin
      // Create the virtual directory
      try
        vDir := WebRoot.Create('IIsWebVirtualDir',IIsAppName);
        vDir.AccessRead := True;
        vDir.AccessScript := True;
        vDir.AppFriendlyName := IIsAppName;
        vDir.Path := ExpandConstant('{app}');
        vDir.AppCreate(True);  // Create in "InProc" mode (don't really know why though)
        vDir.SetInfo();
      except
        RaiseException('Cannot create virtual directory: ' + GetExceptionMessage());
      end;
    end
    else if (Version.Minor = 2) then  // 2003: IIS 6.0
    begin
      // Application pool stuff
      AppPools := WebService.GetObject('IIsApplicationPools','AppPools');
      try
        // Check if the application pool already exists
        AppPool := AppPools.GetObject('IIsApplicationPool',IIsApplicationPoolName);
      except
        AppPool := Null;
      end;
      if VarIsNull(AppPool) then
      begin
        // Create the application pool
        try
          AppPool := AppPools.Create('IIsApplicationPool',IIsApplicationPoolName);
          AppPool.SetInfo();
        except
          RaiseException('Cannot add application pool: ' + GetExceptionMessage());
        end;
      end;
      // Create the virtual directory
      try
        vDir := WebRoot.Create('IIsWebVirtualDir',IIsAppName);
        vDir.AccessRead := True;
        vDir.AccessScript := True;
        vDir.AppFriendlyName := IIsAppName;
        vDir.Path := ExpandConstant('{app}');
        vDir.AppCreate(True);  // Create in "InProc" mode
        vDir.AppPoolId := IIsApplicationPoolName;
        vDir.SetInfo();
      except
        RaiseException('Cannot create virtual directory: ' + GetExceptionMessage());
      end;
    end;
    // Register handlers for ASP.NET 4 (important if other ASP.NET versions are present)
    if not ExecWithResult(ExpandConstant('{dotnet40}') + '\aspnet_regiis.exe',Format('-s "W3SVC/%d/ROOT/%s"',[IIsServerNumber,IIsAppName]),ExecResult) or (ResultCode <> ERROR_SUCCESS) then
      RaiseException('Cannot set ASP.NET version: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
  end
  else if (Version.Major >= 6) then  // Vista / 2008 or later : IIS 7 or later
  begin
    // Get name of web-site
    if not IIs7ExecAppCmd(Format('list site /id:%d /text:name',[IIsServerNumber]),ExecResult,ResultCode) then
      RaiseException(Format('Cannot get name of web-site #%d: ',[IIsServerNumber]) + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
    if (Length(Trim(ExecResult)) = 0) then
      RaiseException(Format('Web-site #%d not found.',[IIsServerNumber]));
    WebSiteName := ExecResult;
    // Delete the application if it already exists
    if not IIs7ExecAppCmd(Format('delete app "%s/%s"',[WebSiteName,ResultCode) or
      ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_NOT_FOUND) and (ResultCode <> ERROR_NOT_SUPPORTED)) then
      RaiseException('Cannot delete application: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
    // Check if the application pool already exists (we don't delete it,since another GVS instance might be using it too)
    if not IIs7ExecAppCmd(Format('list apppool "%s" /text:name',[IIsApplicationPoolName]),ResultCode) or
      ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_INVALID_FUNCTION)) then
      RaiseException('Cannot list application pools: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
    // Create the application pool
    if (ExecResult <> IIsApplicationPoolName) then
    begin
      if not IIs7ExecAppCmd(Format('add apppool /name:"%s" /managedRuntimeVersion:v4.0',ResultCode) or (ResultCode <> ERROR_SUCCESS) then
        RaiseException('Cannot add application pool: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
    end;
    // Create the application
    if not IIs7ExecAppCmd(Format('add app /site.name:"%s" /path:"/%s" /physicalPath:"%s" /applicationPool:"%s"',IIsAppName,ExpandConstant('{app}'),IIsApplicationPoolName]),ResultCode) or
      (ResultCode <> ERROR_SUCCESS) then
      RaiseException('Cannot add application: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
  end
  else
    RaiseException('Cannot register web-site: Unknown OS version.');
end;

// Throws exceptions.
procedure DeleteAppFromIIs(const IIsAppName: String; const IIsServerNumber: Integer; const IIsApplicationPoolName: String);
var
  Version: TWindowsVersion;
  // IIS 5.1 - 6.0
  IIS,AppPools: Variant;
  // IIS 7 and later
  ResultCode: Integer;
  ExecResult: String;
  WebSiteName: String;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major = 5) and (Version.Minor <= 2) then  // XP,[IIsServerNumber]) + GetExceptionMessage());
    end;
    // Delete the virtual dir
    try
      WebRoot.Delete('IIsWebVirtualDir',IIsAppName);
      WebRoot.SetInfo();
    except
    end;
    if (Version.Minor = 2) then  // 2003: IIS 6.0
    begin
      // Application pool stuff
      AppPools := WebService.GetObject('IIsApplicationPools','AppPools');
      try
        // Delete the application pool
        AppPools.Delete('IIsApplicationPool',IIsApplicationPoolName);
      except
      end;
    end;
  end
  else if (Version.Major >= 6) then  // Vista / 2008 or later : IIS 7 or later
  begin
    // Get name of web-site
    if not IIs7ExecAppCmd(Format('list site /id:%d /text:name',[IIsServerNumber]));
    WebSiteName := ExecResult;
    // Delete the application
    if not IIs7ExecAppCmd(Format('delete app "%s/%s"',ResultCode) or
      ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_NOT_FOUND) and (ResultCode <> ERROR_NOT_SUPPORTED)) then
      RaiseException('Cannot delete application: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
    // Delete the application pool
    if not IIs7ExecAppCmd(Format('delete apppool "%s"',ResultCode) or
      ((ResultCode <> ERROR_SUCCESS) and (ResultCode <> ERROR_NOT_FOUND)) then
      RaiseException('Cannot delete application pool: ' + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
  end
  else
    RaiseException('Cannot delete web-site: Unknown OS version.');
end;

有用的助手

查找ASP.NET用于读取/写入虚拟目录中的文件的Windows用户帐户.用于设置“App_Data”的权限.

// Throws exceptions.
function GetIIsAppPoolIdentity(const IIsApplicationPoolName: String): String;
var
  Version: TWindowsVersion;
  ResultCode: Integer;
  ExecResult: String;
  IIS,AppPool: Variant;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major = 5) and (Version.Minor = 1) then  // XP: IIS 5.1
  begin
    // TODO: Should be read from "[.NET 4]\Config\machine.config" -> system.web.processModel.userName
    // - "System"
    // - "Machine" -> "ASPNET" (default)
    // - A custom user account
    // See https://msdn.microsoft.com/en-us/library/dwc1xthy.aspx
    Result := 'ASPNET';
  end
  else if (Version.Major = 5) and (Version.Minor = 2) then  // 2003: IIS 6.0
  begin
    try
      IIS := CreateOleObject('IISNamespace');
      AppPool := IIS.GetObject('IIsApplicationPool','localhost/W3SVC/AppPools/' + IIsApplicationPoolName);
      if (AppPool.AppPoolIdentityType = 0) then
        Result := 'NT AUTHORITY\SYSTEM'
      else if (AppPool.AppPoolIdentityType = 1) then
        Result := 'NT AUTHORITY\LOCAL SERVICE'
      else if (AppPool.AppPoolIdentityType = 2) then
        Result := 'NT AUTHORITY\NETWORKSERVICE'
      else if (AppPool.AppPoolIdentityType = 3) then
        Result := AppPool.WAMUserName
      else
        RaiseException('Cannot get application pool identity: Unknown identity type (' + IntToStr(AppPool.AppPoolIdentityType) + ')');
    except
      RaiseException('Cannot get application pool identity: Unable to get object');
    end;
  end
  else if (Version.Major >= 6) then  // Vista / 2008 or later
  begin
    if not IIs7ExecAppCmd(Format('list apppool "%s" /text:processModel.identityType',ResultCode) or
      (ResultCode <> ERROR_SUCCESS) then
      RaiseException('Cannot get application pool identity.');
    if (ExecResult = 'LocalSystem') then
      Result := 'NT AUTHORITY\SYSTEM'
    else if (ExecResult = 'LocalService') then
      Result := 'NT AUTHORITY\LOCAL SERVICE'
    else if (ExecResult = 'NetworkService') then
      Result := 'NT AUTHORITY\NETWORKSERVICE'
    else if (ExecResult = 'ApplicationPoolIdentity') then
      Result := 'IIS AppPool\' + IIsApplicationPoolName
    else
      RaiseException('Cannot get application pool identity: Unknown identity type "' + ExecResult + '"');
  end
  else
    RaiseException('Cannot get application pool identity: Unknown OS version: ' + IntToStr(Version.Major) + '.' + IntToStr(Version.Minor));
end;

返回Web站点的物理路径.用于找到安装文件的正确位置很有用.

// Throws exceptions.
function IIsGetPhysicalPath(const IIsServerNumber: Integer): String;
var
  Version: TWindowsVersion;
  IIS,WebRoot: Variant;
  ResultCode: Integer;
  ExecResult: String;
  WebSiteName: String;
  PhysPath: String;
begin
  GetWindowsVersionEx(Version);
  if (Version.Major = 5) then
  begin
    try
      // Create the main IIS COM Automation object
      IIS := CreateOleObject('IISNamespace');
      WebService := IIS.GetObject('IIsWebService',[IIsServerNumber]) + GetExceptionMessage());
    end;
    PhysPath := WebRoot.Path;
  end
  else if (Version.Major >= 6) then  // Vista / 2008 or later
  begin
    // Get name of web-site
    if not IIs7ExecAppCmd(Format('list site /id:%d /text:name',[IIsServerNumber]));
    WebSiteName := ExecResult;
    // Get physical path
    if not IIs7ExecAppCmd(Format('list vdir /app.name:"%s"/ /text:physicalPath',[WebSiteName]),ResultCode) or
      (ResultCode <> ERROR_SUCCESS) then
      RaiseException(Format('Cannot get physical path to web-site "%s": ',[WebSiteName]) + SysErrorMessage(ResultCode) + ' (' + IntToStr(ResultCode) + ')');
    PhysPath := ExecResult;
  end
  else
    RaiseException('Cannot get physical path to web-site root: Unknown OS version: ' + IntToStr(Version.Major) + '.' + IntToStr(Version.Minor));
  // Expand environment variables in path (e.g. "%SystemDrive%")
  Result := ExpandEnvVars(PhysPath);
end;

相关文章

.NetCore+WebUploader实现大文件分片上传
项目要求通过网站上传大文件，比如视频文件，通过摸索实现了文件分片来上传，然后后台进行合并。 使用了...
CentOS7下让Asp.Net Core的网站自动运行
安装新版本的Nginx（vim /etc/yum.repos.d/nginx.repo） [nginx-stable] name=nginx stable repo baseu...
使用SignalR ASP.NET Core来简单实现一个后台实时推送数据给Echarts展示图表的功能
什么是 SignalR&#160;ASP.NET Core ASP.NET Core SignalR 是一种开放源代码库，可简化将实时 web 功...
.NETCore项目在Windows下构建Docker镜像并本地导出分发到CentOS系统下
在Windows下使用Docker，我们选择Docker Desktop这个软件，非常方便。 ## Docker Desktop介绍及安装 Do...
C#编写运行在Linux环境下的采用Mediainfo来获取多媒体文件信息的代码
项目开始设计的是运行在windows下，所以一开始采用的是windows服务模式来获取多媒体文件信息，后来要求...
银河麒麟V10安装ASP.NET Core并配置Supervisor让网站开机自动运行
银河麒麟高级服务器操作系统V10是针对企业级关键业务，适应虚拟化、云计算、大数据、工业互联网时代对主...