BCB调用IADS配置IIS站点

 

 BCB调用IADS配置IIS站点

 

这段时期由于考虑到客户安装的方便,实现IIS网站自动配置。通过网上查找，发现BCB和VC配置IIS网站的方法多，代码也不少，但经过测试发现部分在BCB下编译不通过或得不到想要的设置，此类引用网上的部分代码， 并修改为适合于BCB运行的代码，供BCB程序设计者参考。

 

FCls_IIS_Set.h文件 

#include <vcl.h>
#pragma link "activeds.lib"

//函数包含文件
#include "iads.h"
#include "adssts.h"
#include "adshlp.h"

#ifndef FCls_IIS_SetH
#define FCls_IIS_SetH


struct IIS_DIRACCESS
...{
  bool AccessRead;
  bool AccessWrite;
  bool AccessScript;
  bool AccessBrowse;
};

//---------------------------------------------------------------------------
class CLS_IISSETTING
...{
  public:
    CLS_IISSETTING();
    ~CLS_IISSETTING();


    bool __fastcall CreatSiteCOM(AnsiString SiteName, AnsiString FlagNum, AnsiString TcpPort,  AnsiString FilePath, AnsiString DefaultDoc);
    bool __fastcall CreateWebSiteOLE(AnsiString SiteName, AnsiString FlagNum, AnsiString TcpPort, AnsiString FilePath, AnsiString DefaultDoc);
    bool __fastcall MakeVirtualDir(IIS_DIRACCESS pAccess);

    bool __fastcall Start(); //启动IIS
    bool __fastcall Stop();  //停止IIS

    
  protected:

  private:
    IADsContainer *pCont;
    IADs *Ads;
    IADs *VrAds;
    IADsServiceOperations *SrvOp;
    IDispatch *Disp;
    IDispatch *VrDisp;

    AnsiString gVirtualDirName;
    AnsiString gDiskPath;
    AnsiString WebSiteFlag;

    bool __fastcall CheckWebSite(AnsiString FlagNum);
    void __fastcall DelWebSite(AnsiString FlagNum);
};



#endif

 

FCls_IIS_Set.cpp 文件 

//---------------------------------------------------------------------------


#pragma hdrstop

#include "FCls_IIS_Set.h"
 #include <comdef.h>    //IDispatchPtr
 #include <comobj.hpp> //OleCheck
//---------------------------------------------------------------------------

#pragma package(smart_init)


//---------------------------------------------------------------------------
CLS_IISSETTING::CLS_IISSETTING()
...{
    pCont = NULL;
    Ads = NULL;
    VrAds = NULL;
    SrvOp = NULL;
    Disp = NULL;
    VrDisp = NULL;
}
//---------------------------------------------------------------------------
CLS_IISSETTING::~CLS_IISSETTING()
...{
  if(VrAds != NULL)
    VrAds->Release();

  if(Ads != NULL)
    Ads->Release();

  if(pCont != NULL)
    pCont->Release();

  if(SrvOp != NULL)
    SrvOp->Release();

}
//---------------------------------------------------------------------------
bool __fastcall CLS_IISSETTING::CreatSiteCOM(AnsiString SiteName, AnsiString FlagNum, AnsiString TcpPort,
                                             AnsiString FilePath, AnsiString DefaultDoc)
...{
  /**//******************************************************

  CreateWebSit 参数说明
  SiteName 要建立的新站点的描述（也可以教名字）
  TcpPort 要新站点的TCP端口
  FilePath 新站点的主目录路径
  DefaultDoc 需要在那台机器上建立虚拟站点，本机可以使用localhost

  ** 功能描述:  调用COM方式创建站点

  ******************************************************/


  //*** 获得WebServer ****
  if( ADsGetObject(L"IIS://LocalHost/w3svc", IID_IADsContainer,(void**)&pCont) != S_OK)
  ...{
      Application->MessageBoxA("获得WEB站点信息失败，请检查是否安装IIS！","提示",MB_OK +MB_ICONWARNING);
      return false ;
  }

  if (CheckWebSite(FlagNum))
  ...{
    //询问是否删除
    if (Application->MessageBoxA("网站标识已安装，是否删除！","提示",MB_YESNO     +MB_ICONWARNING) == IDYES    )
    ...{
      DelWebSite(FlagNum);
    }
    else
    ...{
      return false;
    }
  }

  if( pCont->Create(L"IIsWebServer", (wchar_t*)WideString(FlagNum),&Disp) != S_OK)
  ...{
    AnsiString MsgStr = "创建" + SiteName + "标识号为：" + FlagNum + "的站点失败,请检查是否有相同的名称或标识";
    Application->MessageBoxA(MsgStr.c_str(),"提示",MB_OK +MB_ICONWARNING);
    return false;
  }


  gDiskPath = FilePath;
  WebSiteFlag = FlagNum;
  
  tagVARIANT prop;
  VARIANT var;
  VariantInit(&var);


  //注意检查取值，因为没有清空会否将Bool,bast的值一起赋值到函数

  Disp->QueryInterface(IID_IADs, (void**)&Ads);
  Disp->QueryInterface(IID_IADsServiceOperations, (void**)&SrvOp);
  try
  ...{
    //Server Size
    V_BSTR(&var) = SysAllocString((wchar_t*)WideString(1));
    V_VT(&var) = VT_UI4;
    Ads->Put(L"ServerSize", var);
    VariantClear(&var);
    
    //站点名称
    V_BSTR(&var) = SysAllocString((wchar_t*)WideString(SiteName));
    V_VT(&var) = VT_BSTR;
    Ads->Put(L"ServerComment", var);
    VariantClear(&var);

    //端口
    AnsiString TempStr;
    TempStr = ":" + TcpPort+ ":";
    V_BSTR(&var) = SysAllocString((wchar_t*)WideString(TempStr));
    V_VT(&var) = VT_BSTR;
    Ads->Put(L"ServerBindings",var);
    VariantClear(&var);

    //默认访问页
    V_BSTR(&var) = SysAllocString((wchar_t*)WideString(DefaultDoc));
    V_VT(&var) = VT_BSTR;
    Ads->Put(L"DefaultDoc",var);
    Ads->SetInfo();

  }
  catch(...)
  ...{
      AnsiString MsgStr;
      MsgStr = "创建" +  SiteName + " 端口为" +   TcpPort + "失败，请检查端口是否已使用！";
      Application->MessageBoxA(MsgStr.c_str(),"提示",MB_OK +MB_ICONWARNING);
      return false;
  }
  //Ads->SetInfo();
  return true;


}

//---------------------------------------------------------------------------
bool __fastcall CLS_IISSETTING::Start()
...{
  //启动IIS
   if (SrvOp == NULL)
   ...{
     Application->MessageBoxA("对象未创建调用失败！","提示",MB_OK +MB_ICONWARNING);
     return false;
   }

   //启动
   try
   ...{
     SrvOp->Start();
   }
   catch(...)
   ...{
      Application->MessageBoxA("启动失败！","提示",MB_OK +MB_ICONWARNING);
      return false;
   }
   return true;
} 
//---------------------------------------------------------------------------
bool __fastcall CLS_IISSETTING::Stop()
...{
  //停止IIS
   if (SrvOp == NULL)
   ...{
     Application->MessageBoxA("对象未创建调用失败！","提示",MB_OK +MB_ICONWARNING);
     return false;
   }

   //启动
   try
   ...{
     SrvOp->Stop();
   }
   catch(...)
   ...{
      Application->MessageBoxA("停止失败！","提示",MB_OK +MB_ICONWARNING);
      return false;
   }
   return true;
};

//---------------------------------------------------------------------------
bool __fastcall CLS_IISSETTING::MakeVirtualDir(IIS_DIRACCESS pAccess)
...{

  /**//******************************************************
  ** 函数名:
  ** 输入:a,b,c

  ** 输出: x---
  ** x 为1, 表示
  ** x 为0, 表示
  ** 功能描述:  创建虚拟目录
  ** 全局变量:
  ** 调用模块:

  ** 创建:Jason
  ** 日期:2008-4-15 12:08:47

  ******************************************************/
  
  HRESULT Rslt;
  //得到刚才创建的网站

 AnsiString TempStr;
 TempStr = "IIS://LocalHost/W3SVC/" + WebSiteFlag;


 if ( pCont->GetObject(L"IIsWebServer",
                       (wchar_t*)WideString(WebSiteFlag),
                       &Disp)
                       != S_OK)
 ...{
   Application->MessageBoxA("新建站点读取失败！","提示",MB_OK +MB_ICONWARNING);
   return false;
 }

  if (Disp->QueryInterface(IID_IADsContainer, (void**)&pCont) != S_OK)
  ...{
    Application->MessageBoxA("IIS连接创建失败！","提示",MB_OK +MB_ICONWARNING);
    return false;
  }

  //虚拟目录
 Rslt = pCont->Create(L"IIsWebVirtualDir",L"Root",&VrDisp);
 if(Rslt != S_OK)
 ...{
   Application->MessageBoxA("得到虚拟目录路径失败！","提示",MB_OK +MB_ICONWARNING);
   return false;
 }

 
  tagVARIANT prop;
  VARIANT var;
  VariantInit(&var);


  V_BSTR(&var) = SysAllocString(L"True");
  V_VT(&var) = VT_BOOL;


 try
 ...{
   VrDisp->QueryInterface(IID_IADs,(void**)&VrAds);

   if (pAccess.AccessRead)
      VrAds->Put(L"AccessRead",var);

   if (pAccess.AccessScript)
      VrAds->Put(L"AccessScript",var);

   if (pAccess.AccessBrowse)
      VrAds->Put(L"enableDirBrowsing",var); //浏览目录

   if (pAccess.AccessWrite)
      VrAds->Put(L"AccessWrite",var);       //写入权限


   //父目录
   VrAds->Put(L"AspEnableParentPaths",var);
   VariantClear(&var);

   V_BSTR(&var) = SysAllocString((wchar_t*)WideString(gDiskPath));
   V_VT(&var) = VT_BSTR;
   //路径

   
   VrAds->Put(L"Path",var);
   VariantClear(&var);

   V_BSTR(&var) = SysAllocString((wchar_t*)WideString("VSM程序池"));
   V_VT(&var) = VT_BSTR;
   VrAds->Put(L"AppFriendlyName", var);
   VariantClear(&var);

   //默认应用

    V_BSTR(&var) = SysAllocString(L"True");
    V_VT(&var) = VT_BOOL;
    VrAds->Put(L"AppCreate",var);



   // ************ 利用 AppCreate 创建应用程序 Begin************

   HRESULT hresult;
   OLECHAR * arrFunName[]=...{L"AppCreate"};   //定义com的函数名称
   DISPID dispID;

   VrAds->GetIDsOfNames(IID_NULL,arrFunName,1,   // pCont
   LOCALE_SYSTEM_DEFAULT,&dispID);      //取得DISPID值，由dispID返回
   VARIANTARG v[1];
   v[0].vt=VT_BOOL;
   v[0].boolVal=TRUE;    //AppCreate的参数负值,
   DISPPARAMS params=...{v,NULL,1,0};  //定义DISPPARAMS参数
   VARIANT vResult;

   hresult = VrAds->Invoke(dispID,IID_NULL,LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD,&params,&vResult,NULL,NULL);    //开始调用方法
    // ************ 利用 AppCreate 创建应用程序  End ************


 /**//*
     //此行代码执行效果与AppCreate执行的一样，只是调用的命令不同
     // ************ 利用 AppCreate2 创建应用程序 Begin************
     DISPID dispid;
     LPWSTR szDispName = L"AppCreate2";
     HRESULT hresult = VrAds->GetIDsOfNames(IID_NULL,&szDispName,1,     //iAds
         LOCALE_SYSTEM_DEFAULT,&dispid);
     if(hresult == S_OK)
     {
      DISPPARAMS par;
      VARIANTARG vName;
      VariantInit(&vName);
      vName.vt = VT_BOOL;
      vName.boolVal = false;

      par.cArgs = 1;
      par.rgvarg = &vName;
      par.cNamedArgs = 0;
      par.rgdispidNamedArgs = NULL;

      hresult = VrAds->Invoke(dispid,IID_NULL,LOCALE_SYSTEM_DEFAULT,
            DISPATCH_METHOD,&par,NULL, NULL,NULL);
     }
    // ************ 利用 AppCreate2 创建应用程序  End ************
  */
   VrAds->SetInfo();

 }
 catch(...)
 ...{
      Application->MessageBoxA("建立虚拟目录失败！","提示",MB_OK +MB_ICONWARNING);
      return false;
 }


}
//---------------------------------------------------------------------------
bool __fastcall CLS_IISSETTING::CreateWebSiteOLE(AnsiString SiteName, AnsiString FlagNum, AnsiString TcpPort,
                                                 AnsiString FilePath, AnsiString DefaultDoc)
...{



/**//*============================================================================
  CreateWebSit 参数说明
  SiteName 要建立的新站点的描述（也可以教名字）
  TcpPort 要新站点的TCP端口
  FilePath 新站点的主目录路径
  DefaultDoc 需要在那台机器上建立虚拟站点，本机可以使用localhost
  
  ** 功能描述:  调用COM方式创建站点  与CreateWebSiteOLE函数一样
===============================================================================*/

  AnsiString TempStr;
  if (ADsGetObject(L"IIS://LocalHost/w3svc", IID_IADsContainer, (void**)&pCont) != S_OK)
  ...{
      Application->MessageBoxA("获得WEB站点信息失败，请检查是否安装IIS！","提示",MB_OK +MB_ICONWARNING);
      return false;
  }

  if (CheckWebSite(FlagNum))
  ...{
    //询问是否删除
    if (Application->MessageBoxA("网站标识已安装，是否删除！","提示",MB_YESNO     +MB_ICONWARNING) == IDYES    )
    ...{
      DelWebSite(FlagNum);
    }
    else
    ...{
      return false;
    }

  }
  gDiskPath = FilePath;
  WebSiteFlag = FlagNum;

 IDispatchPtr   tmp;
 OleCheck(ADsGetObject(L"IIS://localhost/w3svc",   IID_IDispatch,   (void**)&tmp));
 Variant   vwebserver   =   (IDispatch*)tmp;
 Variant vAds;
 try //如果网站存在，此语句出错
 ...{
    vAds = vwebserver.OleFunction("Create",   "IIsWebServer",   WideString(FlagNum));
 }
 catch(...)
 ...{
    AnsiString MsgStr = "创建" + SiteName + "标识号为：" + FlagNum + "的站点失败,请检查是否有相同的名称或标识";
    Application->MessageBoxA(MsgStr.c_str(),"提示",MB_OK +MB_ICONWARNING);
    return false;
 }

 vAds.OleFunction("Put","ServerSize","1");
 vAds.OleFunction("Put","ServerComment",WideString(SiteName));
 TempStr= ":" + TcpPort+ ":";
 vAds.OleFunction("Put","ServerBindings", WideString(TempStr));
 vAds.OleFunction("Put","DefaultDoc", WideString(DefaultDoc));
 vAds.OleFunction("SetInfo");
}
//---------------------------------------------------------------------------
bool __fastcall CLS_IISSETTING::CheckWebSite(AnsiString FlagNum)
...{
  IADsContainer *vCont;
  IDispatch * vDisp;
  bool bFlag = false;

  if(ADsGetObject(L"IIS://LocalHost/w3svc", IID_IADsContainer, (void **)&vCont) != S_OK)
  ...{
      Application->MessageBoxA("获得WEB站点信息失败，请检查是否安装IIS！","提示",MB_OK +MB_ICONWARNING);
      return false;
  }

  if(vCont->GetObjectA(L"IIsWebServer",(wchar_t *)WideString(FlagNum),&vDisp) == S_OK)
  ...{
    bFlag = true;
  }

  if (vCont != NULL)
  ...{
    vCont->Release();
  }

  if (vDisp != NULL)
  ...{
    vDisp->Release();
  }

  return bFlag;

}
//---------------------------------------------------------------------------
void __fastcall CLS_IISSETTING::DelWebSite(AnsiString FlagNum)
...{
  IADsContainer *vCont;
  IDispatch * vDisp;
  bool bFlag = false;

  if(ADsGetObject(L"IIS://LocalHost/w3svc", IID_IADsContainer, (void **)&vCont) != S_OK)
  ...{
      Application->MessageBoxA("获得WEB站点信息失败，请检查是否安装IIS！","提示",MB_OK +MB_ICONWARNING);
      return ;
  }

  vCont->Delete(L"IIsWebServer",(wchar_t *)WideString(FlagNum));

  vCont->Release();
}

 注意activeds.lib文件必须在类的目录下，需要源文件者可以http://download.csdn.net/source/423743下载。

[Jason]