源码网,源码论坛,源码之家,商业源码,游戏源码下载,discuz插件,棋牌源码下载,精品源码论坛

 找回密码
 立即注册
查看: 521|回复: 29

[ASP编程] 域名查询系统用到的类

[复制链接]

7万

主题

861

回帖

32万

积分

论坛元老

Rank: 8Rank: 8

积分
329525
发表于 2006-9-30 00:00:00 | 显示全部楼层 |阅读模式
复制代码 代码如下:
<%
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
%>
回复

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2022-8-16 22:29:35 | 显示全部楼层
收下来看看怎么样
回复 支持 反对

使用道具 举报

5

主题

2万

回帖

69

积分

注册会员

Rank: 2

积分
69
发表于 2022-12-3 10:02:08 | 显示全部楼层
啦啦啦啦啦啦哈哈哈
回复 支持 反对

使用道具 举报

3

主题

2万

回帖

172

积分

注册会员

Rank: 2

积分
172
发表于 2023-1-13 22:05:42 | 显示全部楼层
需要很久了终于找到了
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-2-4 23:15:57 | 显示全部楼层
挺不错的东西
回复 支持 反对

使用道具 举报

12

主题

2万

回帖

431

积分

中级会员

Rank: 3Rank: 3

积分
431
发表于 2023-2-10 12:18:03 | 显示全部楼层
啦啦啦啦啦啦啦啦!
回复 支持 反对

使用道具 举报

0

主题

1万

回帖

0

积分

中级会员

Rank: 3Rank: 3

积分
0
发表于 2023-2-12 15:29:13 | 显示全部楼层
。。。。。。。。。。。。。。。
回复 支持 反对

使用道具 举报

5

主题

2万

回帖

69

积分

注册会员

Rank: 2

积分
69
发表于 2023-6-24 03:07:47 | 显示全部楼层
而快乐你们快乐马年快乐
回复 支持 反对

使用道具 举报

9

主题

2万

回帖

420

积分

中级会员

Rank: 3Rank: 3

积分
420
发表于 2023-7-9 18:13:22 | 显示全部楼层
数据库了多久撒快乐的健身卡啦
回复 支持 反对

使用道具 举报

2

主题

2万

回帖

67

积分

注册会员

Rank: 2

积分
67
发表于 2023-8-1 04:18:39 | 显示全部楼层
好人好人好人好人
回复 支持 反对

使用道具 举报

高级模式
B Color Image Link Quote Code Smilies

本版积分规则

手机版|小黑屋|网站地图|源码论坛 ( 海外版 )

GMT+8, 2024-11-23 16:43 , Processed in 0.097978 second(s), 26 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表