复制代码 代码如下:

<%

DimDomain

SetDomain=NewCls_DomainFunction

ClassCls_DomainFunction

PrivatevListURL

PrivateThief_

PrivatevDomainArr,vDomainName

PrivatevLoopI

PrivatevDomainsName,vDomainMainBody

PrivateTLDCode

PrivateRs,Sql

PrivateExtraDataArr

PrivateWhoisArr,WhoisCreationDate,WhoisExpirationDate,WhoisORG,WhoisName,WhoisBaiduSite,WhoisBaiduBody,WhoisPageRank

PublicSqlQueryLengthID,SqlQueryComposeTypeID,SqlQueryTLDID,SqlOrderByID

PrivateSqlQueryLength,SqlQueryComposeType,SqlQueryTLD,SqlOrderBy

PublicFunctionGetDomainList(vListID)

SelectCasevListID

Case1:vListURL="http://www.cnnic.net.cn/download/registar_list/pendingDel.txt"

Case2:vListURL="http://www.cnnic.net.cn/download/registar_list/future2todayDel.txt"

Case3:vListURL="http://www.cnnic.net.cn/download/registar_list/future1todayDel.txt"

Case4:vListURL="http://www.cnnic.net.cn/download/registar_list/1todayDel.txt"

Case5:vListURL="http://www.cnnic.net.cn/download/registar_list/2todayDel.txt"

Case6:vListURL="http://www.cnnic.net.cn/download/registar_list/3todayDel.txt"

CaseElse:vListURL="http://www.cnnic.net.cn/download/registar_list/future1todayDel.txt"

EndSelect

SetThief_=NewCls_Thief

Thief_.Source=vListURL

Thief_.Steal

vDomainArr=Split(Thief_.Value,vbLf)

SetThief_=Nothing

IfUBound(vDomainArr)<2ThenCallCmd.OutputJavaInfo("CNNIC最新数据库尚未发布。")

CallConnDB()

ForvLoopI=0ToUBound(vDomainArr)

vDomainsName=LCase(vDomainArr(vLoopI))

IfInstr(vDomainsName,".")>0Then

vDomainMainBody=Split(vDomainsName,".")(0)

Conn.Execute("INSERTINTO[CNDomainList](DomainName,Body,Length,ComposeType,TLD)VALUES('"&vDomainsName&"','"&vDomainMainBody&"',"&Len(vDomainMainBody)&","&GetDomainComposeType(vDomainMainBody)&","&GetDomainLTD(vDomainsName)&")")

EndIf

Next

CallDisconnDB()

CallCompactDataBase(vDatabasePath,False)

EndFunction

PublicFunctionClearUpDatabase()

CallConnDB()

Conn.Execute("DELETE*FROM[CNDomainList]")

CallDisconnDB()

CallCompactDataBase(vDatabasePath,False)

EndFunction

PrivateFunctionGetDomainComposeType(DomainName)

IfCmd.IsAlpha(DomainName)Then

GetDomainComposeType=1

ElseIfCmd.IsDigit(DomainName)Then

GetDomainComposeType=2

ElseIfCmd.IsAlphaDigit(DomainName)Then

GetDomainComposeType=3

Else

GetDomainComposeType=4

EndIf

EndFunction

PrivateFunctionGetDomainLTD(DomainName)

IfUBound(Split(DomainName,"."))>1Then

SelectCaseSplit(DomainName,".")(1)

Case"com"

TLDCode=10011

Case"net"

TLDCode=10021

Case"org"

TLDCode=10051

Case"gov"

TLDCode=10061

Case"ac"

TLDCode=10071

CaseElse

TLDCode=10041

EndSelect

Else

TLDCode=10001

EndIf

GetDomainLTD=TLDCode

EndFunction

PrivateSubCompactDataBase(DataBasePath,boolIs97)

OnErrorResumeNext

DimFso,Engine,strDataBasePath,JET_3X

strDataBasePath=Left(DataBasePath,InstrRev(DataBasePath,""))

SetFso=CreateObject("Scripting.FileSystemObject")

IfErr.Number<>0Then

Err.Clear()

ExitSub

EndIf

IfFso.FileExists(DataBasePath)Then

Fso.CopyFileDataBasePath,strDataBasePath&"CompactDBTemp.mdb"

SetEngine=CreateObject("JRO.JetEngine")

IfBoolIs97="True"Then

Engine.CompactDatabase"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&strDataBasePath&"CompactDBTemp.mdb",_

"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&strDataBasePath&"CompactDBTemp1.mdb;"_

&"JetOLEDB:EngineType="&JET_3X

Else

Engine.CompactDatabase"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&strDataBasePath&"CompactDBTemp.mdb",_

"Provider=Microsoft.Jet.OLEDB.4.0;DataSource="&strDataBasePath&"CompactDBTemp1.mdb"

EndIf

Fso.CopyFilestrDataBasePath&"CompactDBTemp1.mdb",DataBasePath

Fso.DeleteFile(strDataBasePath&"CompactDBTemp.mdb")

Fso.DeleteFile(strDataBasePath&"CompactDBTemp1.mdb")

SetFso=nothing

SetEngine=nothing

IfErr.Number<>0Then

Err.Clear()

ExitSub

EndIf

EndIf

EndSub

EndClass

%>