|
复制代码 代码如下: <% Dim Domain Set Domain = New Cls_DomainFunction Class Cls_DomainFunction Private vListURL Private Thief_ Private vDomainArr, vDomainName Private vLoopI Private vDomainsName, vDomainMainBody Private TLDCode Private Rs, Sql Private ExtraDataArr Private WhoisArr, WhoisCreationDate, WhoisExpirationDate, WhoisORG, WhoisName, WhoisBaiduSite, WhoisBaiduBody, WhoisPageRank Public SqlQueryLengthID, SqlQueryComposeTypeID, SqlQueryTLDID, SqlOrderByID Private SqlQueryLength, SqlQueryComposeType, SqlQueryTLD, SqlOrderBy
Public Function GetDomainList(vListID) Select Case vListID Case 1 : vListURL = "http://www.cnnic.net.cn/download/registar_list/pendingDel.txt" Case 2 : vListURL = "http://www.cnnic.net.cn/download/registar_list/future2todayDel.txt" Case 3 : vListURL = "http://www.cnnic.net.cn/download/registar_list/future1todayDel.txt" Case 4 : vListURL = "http://www.cnnic.net.cn/download/registar_list/1todayDel.txt" Case 5 : vListURL = "http://www.cnnic.net.cn/download/registar_list/2todayDel.txt" Case 6 : vListURL = "http://www.cnnic.net.cn/download/registar_list/3todayDel.txt" Case Else : vListURL = "http://www.cnnic.net.cn/download/registar_list/future1todayDel.txt" End Select Set Thief_ = New Cls_Thief Thief_.Source = vListURL Thief_.Steal vDomainArr = Split(Thief_.Value, vbLf) Set Thief_ = Nothing
If UBound(vDomainArr) < 2 Then Call Cmd.OutputJavaInfo("CNNIC最新数据库尚未发布。")
Call ConnDB() For vLoopI = 0 To UBound(vDomainArr) vDomainsName = LCase(vDomainArr(vLoopI)) If Instr(vDomainsName, ".") > 0 Then vDomainMainBody = Split(vDomainsName, ".")(0) Conn.Execute("INSERT INTO [CNDomainList](DomainName, Body, Length, ComposeType, TLD) VALUES('" & vDomainsName & "', '" & vDomainMainBody & "', " & Len(vDomainMainBody) & ", " & GetDomainComposeType(vDomainMainBody) & ", " & GetDomainLTD(vDomainsName) & ")") End If Next Call DisconnDB() Call CompactDataBase(vDatabasePath, False) End Function
Public Function ClearUpDatabase() Call ConnDB() Conn.Execute("DELETE * FROM [CNDomainList]") Call DisconnDB() Call CompactDataBase(vDatabasePath, False) End Function
Private Function GetDomainComposeType(DomainName) If Cmd.IsAlpha(DomainName) Then GetDomainComposeType=1 ElseIf Cmd.IsDigit(DomainName) Then GetDomainComposeType=2 ElseIf Cmd.IsAlphaDigit(DomainName) Then GetDomainComposeType=3 Else GetDomainComposeType=4 End If End Function
Private Function GetDomainLTD(DomainName) If UBound(Split(DomainName, ".")) > 1 Then Select Case Split(DomainName, ".")(1) Case "com" TLDCode = 10011 Case "net" TLDCode = 10021 Case "org" TLDCode = 10051 Case "gov" TLDCode = 10061 Case "ac" TLDCode = 10071 Case Else TLDCode = 10041 End Select Else TLDCode = 10001 End If GetDomainLTD = TLDCode End Function
Private Sub CompactDataBase(DataBasePath, boolIs97) On Error Resume Next Dim Fso, Engine, strDataBasePath,JET_3X strDataBasePath = Left(DataBasePath,InstrRev(DataBasePath,"\")) Set Fso = CreateObject("Scripting.FileSystemObject") If Err.Number <> 0 Then Err.Clear() Exit Sub End If If Fso.FileExists(DataBasePath) Then Fso.CopyFile DataBasePath,strDataBasePath & "CompactDBTemp.mdb" Set Engine = CreateObject("JRO.JetEngine") If BoolIs97 = "True" Then Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp.mdb", _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp1.mdb;" _ & "Jet OLEDB:Engine Type=" & JET_3X Else Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp.mdb", _ "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDataBasePath & "CompactDBTemp1.mdb" End If Fso.CopyFile strDataBasePath & "CompactDBTemp1.mdb",DataBasePath Fso.DeleteFile(strDataBasePath & "CompactDBTemp.mdb") Fso.DeleteFile(strDataBasePath & "CompactDBTemp1.mdb") Set Fso = nothing Set Engine = nothing If Err.Number <> 0 Then Err.Clear() Exit Sub End If End If End Sub End Class %>
|
|