strDataName = "电影.mdb"
strTableName= "vodurl"
set objIE = Wscript.CreateObject("InternetExplorer.Application")
'显示LOGO
With objIE
.fullscreen = 1
.width = 300
.height = 100
.navigate "about:blank"
.left = fix((.document.parentwindow.screen.availwidth-.width)/2)
.top = fix((.document.parentwindow.screen.availheight-.height)/2)
.visible = 1
end With
With objIE.Document
.Write "<HTML><HEAD><TITLE>数据库</TITLE></HEAD>"
.Write "<BODY SCROLL='NO'><CENTER><FONT FACE='arial black'> <HR COLOR=#DB7093>"
.Write "正在读取数据库,请稍侯...."
.Write "<HR COLOR=#DB7093></FONT></CENTER></BODY></HTML>"
end With
'是否存在数据库，不存在则创建
Set fso = CreateObject("Scripting.FileSystemObject")
If not (fso.FileExists(strDataName)) Then
CreateDataBase
GetFileList
End If
str = strHTML()
'显示数据
objIE.quit
set objIE = Nothing
set objIE = Wscript.CreateObject("InternetExplorer.Application")
With objIE
.menubar = 0
.addressbar = 0
.toolbar = 0
.statusbar = 0
.resizable = 0
.width = 800
.height = 600
.navigate "about:blank"
.left = fix((.document.parentwindow.screen.availwidth-.width)/2)
.top = fix((.document.parentwindow.screen.availheight-.height)/2)
.visible = 1
end With
With objIE.Document
.Write "<HTML><HEAD><TITLE>数据库</TITLE></HEAD>"
.Write "<BODY><CENTER><FONT FACE='arial black'> <HR COLOR=#DB7093>"
.Write "<DIV id='WriteStr'></DIV>"
.Write "<HR COLOR=#DB7093></FONT></CENTER></BODY></HTML>"
end With
Set objDiv = objIE.Document.All.WriteStr
objDiv.innerHTML = str
'获得全部vbs文件列表,并调用AddData添加数据到数据库
Sub GetFileList()
'Set fso = CreateObject("Scripting.FileSystemObject")
Set objDataFiles = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set fso = CreateObject("Scripting.FileSystemObject")
Set colFiles = objDataFiles. _
ExecQuery("Select * from CIM_DataFile where extension = 'rmvb'")
For Each objFile in colFiles
strName = ""
strClass= ""
strPath = ""
strIntro= "暂无简介"
set f = fso.GetFile(objFile.Name)
strName = f.ParentFolder.Name
strClass= f.ParentFolder.ParentFolder.Name
strPath = f.ParentFolder.ParentFolder.ParentFolder
On Error Resume Next
strIntro= fso.OpenTextFile(strPath & "\海报.txt").ReadAll
AddData strName,strClass,strPath,strIntro
Next
end Sub
Sub AddData(strName,strClass,strPath,strIntro)
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open _
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDataName
objRecordSet.Open _
"SELECT * FROM " & strTablename, objConnection, 3, 3
objRecordSet.AddNew
objRecordSet("Name") = strName & space(1)
objRecordSet("Class")= strClass & space(1)
objRecordSet("Path") = strPath & space(1)
objRecordSet("Intro")= strIntro & space(1)
objRecordSet.Update
end Sub
Sub CreateDataBase()
'创建数据库文件，不存在则创建
On Error Resume Next
CreateObject("Adox.Catalog").Create ( _
"Provider = Microsoft.Jet.OLEDB.4.0; " & _
"Data Source =" & strDataName )
'建立一个新表
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open _
"Provider= Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & strDataName
objConnection.Execute( "CREATE TABLE " & strTableName & _
"(Name TEXT(20) ," & _
"Class TEXT(20) ," & _
"Path TEXT(50) ," & _
"Intro TEXT(200) )" )
end Sub
'读取数据库数据到表格中
Function strHTML()
strHTML = "<table border='1' style='border-collapse: collapse' " & _
"bordercolor='#111111' width='100%' id='Table1' >"
strHTML = strHTML & _
"<tr><td>片名</td><td>类型</td><td>物理目录</td><td>简介</td></tr>"
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open _
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDataName
objRecordSet.Open _
"SELECT * FROM " & strTablename, objConnection, 3, 3
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strHTML = strHTML & "<tr>"
for i = 1 to objrecordset.fields.count
strHTML = strHTML & "<td>" & objrecordset.fields(i - 1) & "</td>"
next
strHTML = strHTML & "</tr>"
objRecordSet.MoveNext
Loop
strHTML = strHTML & "</table>"
end Function
