VB开发IIS虚拟目录建立工具(源代码)
摘要: VB开发IIS虚拟目录建立工具(源代码)，基于Windows上的IIS控制工具，可以设置虚拟目录的名称，路径，端口，默认文档，主机头等信息。为了软件用户能调节相关的公司信息和网站地址，全部信息和图片都存放在ini文件内，这样，软件就有了个性化的设置，下面是软件的运行后的界面：
图（1-1软件运行界面）开发目的: 用ASP或者Asp.Net开发的Web程序,打包很不方便,虽然.Net增加了打包工具,但是要增加20多M的.NET文件,一个2-3M的WEB程序,打包后要变成20多M,这样用户需要下载更多的文件。而且，看到PHP开发的Web程序，打包的时候，能把Apache,MySQL都打包进去，心里很是佩服。于是，本人想开发一个能自己建立相关虚拟目录的软件，能检测系统类型，是否存在IIS，MSSQLSERVER数据库等信息的工具，在使用rar软件打包，解压后运行该程序建立虚拟目录，不需要用户在操作IIS（Internet信息管理器）.
技术摘要: VB 软件开发工具
IIS 我们需要控制的内容
INI 存放配置信息
IP 用VB 获取系统IP信息
对话框 VB调用Window系统Api打开目录对话框（为什么不用VB的对话框，因为系统不能安装，所以减少软件的大小，尽量使软件绿色，不需要注册DLL文件，所以调用Asp函数来打开对话框）
注册表 检测注册表内的IIS版本信息，数据库信息；
图（1-2调用Api打开目录对话框）
图（1-3程序开发的相关工程）设计思路:
1,检测操作系统（Xp/2000/2003 xp系统下只能建立虚拟目录，2000/2003可以建立网站）
2,检测安装了IIS吗（没有IIS就不用运行了）
3,加载图片，图标，字符等信息
4,建立IIS目录
A.判断输入的信息是否合法（调用Api显示目录）
B.判断是否安装了本编号的虚拟目录，如果存在则删除
C.建立虚拟目录或者网站
D.提示成功信息
相关文件:
l IIS.vbw 工程文件
l IIS.vbp 工程文件
l ADSIIIS.frm 窗口文件
l ADSIIIS.frx 窗口文件
l index.bmp 显示的图片
l index.ico 程序的图标
l IIS.ini 非常培植文件
l RegeditOpr.bas 注册表操作
l OpenDialogOpr.bas Api打开对话框
l IpOpr.bas IP操作
l IniOpr.bas INI文件读写
l IIsOpr.bas IIS操作工作
程序代码：
ADSIIIS.frm
" *********************************************************************
" * Programmer Name : caref
" * Web Site : www.caref.cn
" * E-Mail : caref@caref.cn
" * Date : 2008-01-02
" * Time : 10:24
" * Module Filename : FrmIIS.bas
" **********************************************************************
Public MyIIs, MNoteSelectLDir, NoteSelectVDir As String
Public NoteNoIIS, NoteNoServerComment, NoteNoServerBindingsTCP, NoteNoPath, NoteNoDefaultDoc, NoteNoLogFileDirectory, NoteRunXp As String
Public NoteDefaultName, NoteIISHaveWebsite, NoteIIsWebCreateok, NoteIIsOpenView, NoteSystemToolTip, NoteIISHaveWebVdirsite, NoteIIsWebCreateVdirok, NoteIIsOpenVdirView As String
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public MustID As String
Sub Main()
FrmIIS.Show
End Sub
Private Sub BtnLSelect_Click()
Dim path As String
path = Me.TxtLogFileDirectory.Text
path = BrowseForFolder(Me.hWnd, NoteSelectVDir)
If path <> "" Then
Me.TxtLogFileDirectory.Text = path
End If
End Sub
Private Sub CmdVSelect_Click()
Dim path As String
path = Me.TxtPath.Text
path = BrowseForFolder(Me.hWnd, NoteSelectVDir)
If path <> "" Then
Me.TxtPath.Text = path
End If
End Sub
Private Sub CmdExit_Click()
End
End Sub
Private Sub cmdDeleteWebSite_Click()
" DeleteWebSite txtSiteName.Text, txtComputerName.Text
End Sub
Private Function IIsIsHave() As Boolean
Dim A As String
A = GetDWORDValue("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\W3SVC\Parameters", "MajorVersion")
If A = "6" Or A = "5" Then
IIsIsHave = True
Else
IIsIsHave = False
End If
End Function
Private Sub CmdSubmit_Click()
Dim b As Boolean
b = IIsIsHave() " 看有没有IIS
If b = True Then
b = IsSubmit
If b = True Then
If Me.TxtServerBindingsTCP.Enabled = True Then
b = CreateWebSite(Me.TxtServerComment.Text, Me.TxtServerBindingsTCP.Text, Me.TxtPath.Text, Me.TxtServerBindingsHost.Text, "localhost", Me.TxtDefaultDoc.Text, Me.TxtLogFileDirectory.Text, Me.ChkServerBindingsIP.Text, MustID)
Else
b = WebVirtualDir(Me.TxtServerComment.Text, NoteDefaultName, Me.TxtPath.Text, Me.TxtDefaultDoc.Text)
End If
End If
Else
MeMsgbox (NoteNoIIS)
Me.CmdSubmit.Enabled = False
End If
End Sub
Function IsSubmit() As Boolean
IsSubmit = False
If TxtServerComment.Text = "" Then
TxtServerComment.SetFocus
MeMsgbox (NoteNoServerComment)
Exit Function
End If
If TxtServerBindingsTCP.Text = "" Or (Not IsNumeric(TxtServerBindingsTCP.Text)) Then
TxtServerBindingsTCP.SetFocus
MeMsgbox (NoteNoServerBindingsTCP)
Exit Function
End If
If TxtPath.Text = "" Then
TxtPath.SetFocus
MeMsgbox (NoteNoPath)
Exit Function
End If
If TxtDefaultDoc.Text = "" Then
TxtDefaultDoc.SetFocus
MeMsgbox (NoteNoDefaultDoc)
Exit Function
End If
If TxtLogFileDirectory.Text = "" Then
TxtLogFileDirectory.SetFocus
MeMsgbox (NoteNoLogFileDirectory)
Exit Function
End If
IsSubmit = True
End Function
Sub Form_Load()
SocketsInitialize
InitPath
InitText
GoInit
SystemBB
End Sub
Private Sub SystemBB()
Dim OSInfo As OSVERSIONINFO, Pid As String
Me.AutoRedraw = True
OSInfo.dwOSVersionInfoSize = Len(OSInfo)
"Get the Windows version
Ret& = GetVersionEx(OSInfo)
"Chack for errors
If Ret& = 0 Then MsgBox "Error Getting Version Information": Exit Sub
Dim Sok As String
Sok = Str$(OSInfo.dwMajorVersion) + "." + LTrim(Str(OSInfo.dwMinorVersion))
Sok = Trim(Sok)
If Sok = "5.2" Or Sok = "5.0" Then
Me.CmdSubmit.Enabled = True
Else
Me.ChkServerBindingsIP.Enabled = False
Me.TxtLogFileDirectory.Enabled = False
Me.TxtServerBindingsHost.Enabled = False
Me.TxtServerBindingsTCP.Enabled = False
MeMsgbox (NoteRunXp)
Me.CmdSubmit.Enabled = True
End If
End Sub
Private Sub InitPath()
Dim path, X As String
path = App.path
path = Replace(path, "/", "\")
"MeMsgbox (path)
A = Split(path, "\")
X = ""
Dim I, J As Integer
J = UBound(A) - 1
If J < 0 Then
Else
For I = 0 To J
X = X + A(I) + "\"
Next
path = X
End If
path = Trim(path)
Me.TxtLogFileDirectory.Text = path + "LoginFiles\"
Me.TxtPath.Text = path
End Sub
Private Sub Form_Unload(Cancel As Integer)
SocketsCleanup
End Sub
Private Sub GoInit()
Dim hostent_addr As Long
Dim host As HOSTENT
Dim hostip_addr As Long
Dim temp_ip_address() As Byte
Dim I As Integer
Dim ip_address As String
hostent_addr = gethostbyname(Text1)
If hostent_addr = 0 Then
MsgBox "Can"t resolve name."
Exit Sub
End If
RtlMoveMemory host, hostent_addr, LenB(host)
RtlMoveMemory hostip_addr, host.hAddrList, 4
ReDim temp_ip_address(1 To host.hLength)
RtlMoveMemory temp_ip_address(1), hostip_addr, host.hLength
For I = 1 To host.hLength
ip_address = ip_address & temp_ip_address(I) & "."
Next
ip_address = Mid$(ip_address, 1, Len(ip_address) - 1)
"MsgBox ip_address
Me.ChkServerBindingsIP.Text = ip_address
End Sub
Private Sub InitText()
Dim SetName, ID, TMP As String
SetName = "IISSetting"
ID = GetIniStr(SetName, "ID")
MustID = ID
"###################################################################
Me.TxtServerComment = GetIniStr(SetName, "Name")
Me.TxtServerBindingsTCP.Text = GetIniStr(SetName, "Tcp")
TMP = GetIniStr(SetName, "Host")
If TMP <> "#" Then
Me.TxtServerBindingsHost.Text = TMP
End If
TMP = GetIniStr(SetName, "VDir")
If TMP <> "#" Then
Me.TxtPath.Text = TMP
End If
TMP = GetIniStr(SetName, "LogDir")
If TMP <> "#" Then
Me.TxtLogFileDirectory.Text = TMP
End If
TMP = GetIniStr(SetName, "DefaultDoc")
If TMP <> "#" Then
Me.TxtDefaultDoc.Text = TMP
End If
"###################################################################
Me.Caption = GetIniStr(SetName, "InfoTitle")
Me.LabCompnay.Caption = GetIniStr(SetName, "InfoCompany")
Me.LinkURL.Caption = GetIniStr(SetName, "InfoURL")
Me.LabMain.Caption = GetIniStr(SetName, "InfoMain")
"###################################################################
Dim MyIco, MyBmp, IISSoft As String
MyIco = GetIniStr(SetName, "InfoIco")
MyBmp = GetIniStr(SetName, "InfoIMG")
Me.Picture1.Picture = LoadPicture(App.path + "\" + MyBmp)
Me.Icon = LoadPicture(App.path + "\" + MyIco)
"###################################################################
"显示按钮和提示上的文字
IISSoft = "IISSoft"
Me.Label1.Caption = GetIniStr(IISSoft, "WebInfo")
Me.Label2.Caption = GetIniStr(IISSoft, "WebIP")
Me.Label3.Caption = GetIniStr(IISSoft, "WebTCP")
Me.Label4.Caption = GetIniStr(IISSoft, "WebHost")
Me.Label5.Caption = GetIniStr(IISSoft, "WebVDir")
Me.Label6.Caption = GetIniStr(IISSoft, "WebDefaultDoc")
Me.Label7.Caption = GetIniStr(IISSoft, "WebLogDir")
Me.CmdVSelect.Caption = GetIniStr(IISSoft, "WebVS")
Me.BtnLSelect.Caption = GetIniStr(IISSoft, "WebLS")
Me.CmdSubmit.Caption = GetIniStr(IISSoft, "WebSubmit")
Me.CmdExit.Caption = GetIniStr(IISSoft, "WebCancel")
"####################################################################
IISNote = "IISNote"
MNoteSelectLDir = GetIniStr(IISNote, "MNoteSelectLDir")
NoteSelectVDir = GetIniStr(IISNote, "NoteSelectVDir")
NoteNoIIS = GetIniStr(IISNote, "NoteNoIIS")
NoteNoServerComment = GetIniStr(IISNote, "NoteNoServerComment")
NoteNoServerBindingsTCP = GetIniStr(IISNote, "NoteNoServerBindingsTCP")
NoteNoPath = GetIniStr(IISNote, "NoteNoPath")
NoteNoDefaultDoc = GetIniStr(IISNote, "NoteNoDefaultDoc")
NoteNoLogFileDirectory = GetIniStr(IISNote, "NoteNoLogFileDirectory")
NoteRunXp = GetIniStr(IISNote, "NoteRunXp")
"####################################################################
NoteDefaultName = GetIniStr(IISNote, "NoteDefaultName")
"#####################################################################
NoteIISHaveWebsite = GetIniStr(IISNote, "NoteIISHaveWebsite")
NoteIIsWebCreateok = GetIniStr(IISNote, "NoteIIsWebCreateok")
NoteIIsOpenView = GetIniStr(IISNote, "NoteIIsOpenView")
NoteSystemToolTip = GetIniStr(IISNote, "NoteSystemToolTip")
NoteIISHaveWebVdirsite = GetIniStr(IISNote, "NoteIISHaveWebVdirsite")
NoteIIsWebCreateVdirok = GetIniStr(IISNote, "NoteIIsWebCreateVdirok")
NoteIIsOpenVdirView = GetIniStr(IISNote, "NoteIIsOpenVdirView")
NoteDefaultName = GetIniStr(IISNote, "NoteDefaultName")
"####################################################################
IIsIsHaveOpr (ID)
End Sub
Private Function IIsIsHaveOpr(ID As String)
Dim b As Boolean
b = False
"b = FindIIS(ID)
If b = True Then
"InitInfoIIS (ID)
End If
End Function
Private Sub LinkURL_Click()
GoUrl Me.LinkURL.Caption
End Sub
联系QQ:380894045/279018395 EMAIL：
CareF@CareF.CN后记:本程序为作者一时兴起，写的程序，没有很好的注释，也没有很好的错误调式，希望，有需要的朋友能指点，指正，并改进。
作者：悠索科技(转载勿删，谢谢)
网址：http://www.caref.cn
时间：2008-2-18
下一篇：
C#实现WEB服务器
