7451
社区成员
- 主页
用VB怎么创建虚似目录，怎么把SQL数据导入数据库？？大虾求救！！！
用VB怎么创建虚似目录，怎么把SQL数据导入数据库？？大虾求救！！！
...全文
请发表友善的回复…
发表回复
shawls 2003-01-03
[名称] 发布虚拟站点
[数据来源] 未知
[内容简介] 空
[源代码内容]
方法一：
'参数：
' strWebSite 虚拟站点名称
' strFriendlyName 程序名称
' strWebPath 网页文件路径
' strDefaultDoc 默认网站首页
Public Function WebVirtualDir(ByVal strWebSite As String, ByVal strFriendlyName As String, ByVal strWebPath As String, ByVal strDefaultDoc As String) As Boolean
Dim objADSI As Object
Dim objWebVDir As Object
On Error GoTo Lib_Err
Set objADSI = GetObject("IIS://LocalHost/W3SVC/1/Root")
Set objWebVDir = objADSI.Create("IIsWebVirtualDir", strWebSite)
objWebVDir.SetInfo
Set objWebVDir = objADSI.GetObject("IIsWebVirtualDir", strWebSite)
objWebVDir.AppCreate True
objWebVDir.Put "AppFriendlyName", strFriendlyName
objWebVDir.Put "AppRoot", "/LM/W3SVC/1/Root/" & strWebSite
objWebVDir.Put "Path", strWebPath
objWebVDir.Put "AppIsolated", 0
objWebVDir.Put "DefaultDoc", strDefaultDoc
objWebVDir.Put "AccessFlags", 535
objWebVDir.SetInfo
WebVirtualDir = True
Lib_End:
Set objWebVDir = Nothing
Set objADSI = Nothing
Exit Function
Lib_Err:
WebVirtualDir = False
strError = Err.Description
Err.Clear
Resume Lib_End
End Function
方法二：
这是一段VBS脚本，我从LearnBizTalk里面找出来的，用于建立一个IIS虚拟目录。
' Create vdir for IIS
Dim ServObj, VdirObj, TestPath, TestName
' First, open the path to the Web server
Set ServObj = GetObject("IIS://LocalHost/w3svc/1/Root")
PassFail "Open Web server"
' delete old app
Set VdirObj = ServObj.GetObject("IIsWebVirtualDir", "LearnBizTalk")
VdirObj.SetInfo
VdirObj.AppDelete
err.clear
' delete old vdir
ServObj.Delete "IIsWebVirtualDir", "LearnBizTalk"
err.clear
' Second, Create the virtual directory (Vdir) path
Set VdirObj = ServObj.Create("IIsWebVirtualDir", "LearnBizTalk")
VdirObj.SetInfo
PassFail "Create VDir"
' Finally, create a Path variable containing the virtual root path and set the permissions to read, script
VdirObj.AccessRead = True
Testpath = "C:\LearnBizTalk\ASP"
VdirObj.Put "Path", (Testpath)
VdirObj.SetInfo
PassFail "Set VDir Path and permissions"
' create out-of-proc application
vdirObj.AppCreate False
PassFail "Create Web Application"
' Set Friendly Name
TestName = "LearnBizTalk"
vdirObj.Put "AppFriendlyName", (TestName)
VdirObj.SetInfo
PassFail "Set Friendly Name"
Sub PassFail(strScope)
If Err.Number <> 0 Then
Fail strScope & " Error: x" & Hex(Err.Number) & " Description: " & Err.Description & " Source: " & Err.Source
Err.Clear
'Else
'Pass strScope
End If
End Sub
Sub Fail(strScope)
WScript.Echo "[FAIL] " & SetGetEnvVar("PROCESS", "ComputerName", "DEFAULTSERVER", False) & ":" & strScope
MsgBox "Setup did not complete!", 16
WScript.Quit
End Sub
以上代码保存于： SourceCode Explorer(源代码数据库)
复制时间： 2003-1-3 20:00:08
软件版本： 1.0.814
软件作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： ShawFile@163.Net
QQ： 9181729
[数据来源] 未知
[内容简介] 空
[源代码内容]
方法一：
'参数：
' strWebSite 虚拟站点名称
' strFriendlyName 程序名称
' strWebPath 网页文件路径
' strDefaultDoc 默认网站首页
Public Function WebVirtualDir(ByVal strWebSite As String, ByVal strFriendlyName As String, ByVal strWebPath As String, ByVal strDefaultDoc As String) As Boolean
Dim objADSI As Object
Dim objWebVDir As Object
On Error GoTo Lib_Err
Set objADSI = GetObject("IIS://LocalHost/W3SVC/1/Root")
Set objWebVDir = objADSI.Create("IIsWebVirtualDir", strWebSite)
objWebVDir.SetInfo
Set objWebVDir = objADSI.GetObject("IIsWebVirtualDir", strWebSite)
objWebVDir.AppCreate True
objWebVDir.Put "AppFriendlyName", strFriendlyName
objWebVDir.Put "AppRoot", "/LM/W3SVC/1/Root/" & strWebSite
objWebVDir.Put "Path", strWebPath
objWebVDir.Put "AppIsolated", 0
objWebVDir.Put "DefaultDoc", strDefaultDoc
objWebVDir.Put "AccessFlags", 535
objWebVDir.SetInfo
WebVirtualDir = True
Lib_End:
Set objWebVDir = Nothing
Set objADSI = Nothing
Exit Function
Lib_Err:
WebVirtualDir = False
strError = Err.Description
Err.Clear
Resume Lib_End
End Function
方法二：
这是一段VBS脚本，我从LearnBizTalk里面找出来的，用于建立一个IIS虚拟目录。
' Create vdir for IIS
Dim ServObj, VdirObj, TestPath, TestName
' First, open the path to the Web server
Set ServObj = GetObject("IIS://LocalHost/w3svc/1/Root")
PassFail "Open Web server"
' delete old app
Set VdirObj = ServObj.GetObject("IIsWebVirtualDir", "LearnBizTalk")
VdirObj.SetInfo
VdirObj.AppDelete
err.clear
' delete old vdir
ServObj.Delete "IIsWebVirtualDir", "LearnBizTalk"
err.clear
' Second, Create the virtual directory (Vdir) path
Set VdirObj = ServObj.Create("IIsWebVirtualDir", "LearnBizTalk")
VdirObj.SetInfo
PassFail "Create VDir"
' Finally, create a Path variable containing the virtual root path and set the permissions to read, script
VdirObj.AccessRead = True
Testpath = "C:\LearnBizTalk\ASP"
VdirObj.Put "Path", (Testpath)
VdirObj.SetInfo
PassFail "Set VDir Path and permissions"
' create out-of-proc application
vdirObj.AppCreate False
PassFail "Create Web Application"
' Set Friendly Name
TestName = "LearnBizTalk"
vdirObj.Put "AppFriendlyName", (TestName)
VdirObj.SetInfo
PassFail "Set Friendly Name"
Sub PassFail(strScope)
If Err.Number <> 0 Then
Fail strScope & " Error: x" & Hex(Err.Number) & " Description: " & Err.Description & " Source: " & Err.Source
Err.Clear
'Else
'Pass strScope
End If
End Sub
Sub Fail(strScope)
WScript.Echo "[FAIL] " & SetGetEnvVar("PROCESS", "ComputerName", "DEFAULTSERVER", False) & ":" & strScope
MsgBox "Setup did not complete!", 16
WScript.Quit
End Sub
以上代码保存于： SourceCode Explorer(源代码数据库)
复制时间： 2003-1-3 20:00:08
软件版本： 1.0.814
软件作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： ShawFile@163.Net
QQ： 9181729
zhangwh6882 2003-01-03
虚拟目录
先引入类型库(Project|Import Type Library)adsiis.dll、iisext.dll和activeds.tlb
新建一个单元，声明
unit ActiveDs;
interface
function ADsGetObject(const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT; stdcall;
implementation
function ADsGetObject; external ''activeds.dll'' name ''ADsGetObject'';
end.
方法一(参照C++)、
var
I: IADsContainer;
ADs: IADs;
begin
if ADsGetObject(''IIS://localhost/w3svc'', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject(''IIsWebServer'', ''1''));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.GetObject(''IIsWebVirtualDir'', ''Root''));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.Create(''IIsWebVirtualDir'', ''DelphiTest''));
ADs.Put(''AccessRead'', ''True'');
ADs.Put(''Path'', ''c:\Temp'');
ADs.SetInfo;
end;
end;
end;
end;
方法二(使用接口)、
procedure TForm3.BitBtn4Click(Sender: TObject);
var
Disp: IDispatch;
begin
Disp := IISNamespace1.GetObject(''IIsWebService'', ''localhost/w3svc'');
Disp := (Disp as IADsContainer).GetObject(''IIsWebServer'', ''1'');
Disp := (Disp as IADsContainer).GetObject(''IIsWebVirtualDir'', ''Root'');
Disp := (Disp as IADsContainer).Create(''IIsWebVirtualDir'', ''DelphiADSITest'');
(Disp as IADs).Put(''AccessRead'', ''True'');
(Disp as IADs).Put(''Path'', ''c:\ADSITest'');
(Disp as IADs).SetInfo;
end;
方法三(使用Variant，就是类似VB和ASP的方法)、
procedure TForm2.BitBtn1Click(Sender: TObject);
var
WebSite, WebServer, WebRoot, VDir: Variant;
begin
WebSite := CreateOleObject(''IISNamespace'');
WebSite := WebSite.GetObject(''IIsWebService'', ''localhost/w3svc'');
WebServer := WebSite.GetObject(''IIsWebServer'', ''1'');
WebRoot := WebServer.GetObject(''IIsWebVirtualDir'', ''Root'');
VDir := WebRoot.Create(''IIsWebVirtualDir'', ''VariantTest'');
VDir.AccessRead := True;
VDir.Path := ''C:\Test'';
VDir.SetInfo;
end;
先引入类型库(Project|Import Type Library)adsiis.dll、iisext.dll和activeds.tlb
新建一个单元，声明
unit ActiveDs;
interface
function ADsGetObject(const PathName: WideString; const GUID: TGUID; out I: IUnknown): HRESULT; stdcall;
implementation
function ADsGetObject; external ''activeds.dll'' name ''ADsGetObject'';
end.
方法一(参照C++)、
var
I: IADsContainer;
ADs: IADs;
begin
if ADsGetObject(''IIS://localhost/w3svc'', IID_IADsContainer, IUnknown(I)) = S_Ok then
begin
ADs := IADs(I.GetObject(''IIsWebServer'', ''1''));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.GetObject(''IIsWebVirtualDir'', ''Root''));
ShowMessage(ADs.ADsPath);
if ADs.QueryInterface(IID_IADsContainer, I) = S_OK then
begin
ADs := IADs(I.Create(''IIsWebVirtualDir'', ''DelphiTest''));
ADs.Put(''AccessRead'', ''True'');
ADs.Put(''Path'', ''c:\Temp'');
ADs.SetInfo;
end;
end;
end;
end;
方法二(使用接口)、
procedure TForm3.BitBtn4Click(Sender: TObject);
var
Disp: IDispatch;
begin
Disp := IISNamespace1.GetObject(''IIsWebService'', ''localhost/w3svc'');
Disp := (Disp as IADsContainer).GetObject(''IIsWebServer'', ''1'');
Disp := (Disp as IADsContainer).GetObject(''IIsWebVirtualDir'', ''Root'');
Disp := (Disp as IADsContainer).Create(''IIsWebVirtualDir'', ''DelphiADSITest'');
(Disp as IADs).Put(''AccessRead'', ''True'');
(Disp as IADs).Put(''Path'', ''c:\ADSITest'');
(Disp as IADs).SetInfo;
end;
方法三(使用Variant，就是类似VB和ASP的方法)、
procedure TForm2.BitBtn1Click(Sender: TObject);
var
WebSite, WebServer, WebRoot, VDir: Variant;
begin
WebSite := CreateOleObject(''IISNamespace'');
WebSite := WebSite.GetObject(''IIsWebService'', ''localhost/w3svc'');
WebServer := WebSite.GetObject(''IIsWebServer'', ''1'');
WebRoot := WebServer.GetObject(''IIsWebVirtualDir'', ''Root'');
VDir := WebRoot.Create(''IIsWebVirtualDir'', ''VariantTest'');
VDir.AccessRead := True;
VDir.Path := ''C:\Test'';
VDir.SetInfo;
end;
nik_Amis 2003-01-03
记得有个对象来着，还是直接写注册表
记不清了，关注一下吧
记不清了，关注一下吧