http://www.17benteng.com/ zh-cn PBlog2 v2.4 http://www.17benteng.com/images/logos.gif http://www.17benteng.com/ 一起奔腾 http://www.17benteng.com/article.asp?id=83 7180001@qq.com(admin) Sun,28 Dec 2008 15:15:32 +0800 http://www.17benteng.com/default.asp?id=83 IDC网站天使官方交流群43453676

好久没有更新了,让大家久等了!
这次主要重写了过滤算法与修正了一些重要的bug
详细情况大家看看更新日志吧!
另因工作的原因可能暂时无法为程序加新功能了,所以很抱歉了!不过我会一直做下去的,而且个人一直可以免费使用!

下载地址/soft/IDCWebAngel(1.0.1.1).rar

网站天使出生以来已经差不多快有一年了,这中间谢谢大家的支持!
另外有问题请直接到我的blog反馈,我会尽力解决的!]]> http://www.17benteng.com/article.asp?id=82 7180001@qq.com(admin) Sat,25 Oct 2008 15:37:35 +0800 http://www.17benteng.com/default.asp?id=82
IDC网站天使官方交流群43453676

1.0.1.0

2008-10-25
重写编写关键词过滤核心，使得关键词过滤支持UTF8,ANSI,UNICODE且运行速度更快

下载地址/soft/IDCWebAngel(1.0.1.0).rar]]> http://www.17benteng.com/article.asp?id=81 7180001@qq.com(admin) Thu,16 Oct 2008 15:43:42 +0800 http://www.17benteng.com/default.asp?id=81
　　据了解，为打击盗版，微软一直在寻求解决方法，包括联合相关版权部门打击盗版，不过收获甚小。2007年3月微软在中国推出Windows正版增值计划（WGA通知），同时Office的正版增值计划OGA也是首次在国内发布。其中WGA针对Windows　XP专业版的用户，OGA针对Office　XP、Office　2003和Office　2007的用户，这两个通知可通过软件升级自动下载到用户电脑中。
　
　　“这两个验证工具，可以自动检测验证用户电脑上安装的Windows　XP和Office是否为正版软件，如果是使用的盗版软件，则会不断收到提示信息，还将频繁遭遇黑屏。”微软相关负责人向记者表示。　

　　据微软相关负责人透露，此次涉及到的使用盗版软件遭遇黑屏主要是指，在收到提示后的盗版用户电脑界面将出现黑色背景，但不影响其他使用功能，用户可以通过手动调回，不过该黑色背景会每60分钟出现一次。


方法一：

关闭自动更新(需要升级xp系统补丁的话，我们可以利用360安全卫士等第三方软件来升级)

具体操作为：右键单击“我的电脑”-“属性” ，在系统属性窗口中选择“自动更新”选项卡，在“通知设置”一栏选择“关闭自动更新”一项。

方法二：

第二，“我的电脑”点右键，选“管理”，点左边“服务和应用程序”旁的加号，展开，点“服务”。
或者直接在“运行”中输入“Services.msc”打开服务设置窗口。
在“服务”列表中，找到“AutomaticUpdates”这一项，双击，弹出的属性窗口中，“启动类型”设置为“已禁用”，确定即可。


方法三：

开始-运行-输入REGEDIT回车，在左边栏中找到HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\NotifyWgaLogon项，将整个WgaLogon项删除即可。以上为经过测试的最简便方法。

这次的WGA与上次相比只增加了LegitCheckControl.dll，主要执行方式（通过WINLOGON加载）未变。显然微软此举可归为常规性不定期“恐吓”，此举也是对于盗版的无奈。

方法四：

@echo off
sc stop wuauserv
sc config wuauserv start= disabled

另存为bat格式的文件后运行。



如果20号以后出现每小时黑屏一次的情况，用下面的方法：

@echo off
sfc /purgecache
reg delete "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify\Wgalogon" /f
taskkill /f /im WgaTray.exe /T
del c:\Windows\system32\WgaTray.exe /f /q
taskkill /f /im WgaTray.exe /T
del c:\Windows\system32\WgaTray.exe /f /q
taskkill /f /im WgaTray.exe /T
del c:\Windows\system32\WgaTray.exe /f /q
taskkill /f /im WgaTray.exe /T
del c:\Windows\system32\WgaTray.exe /f /q
taskkill /f /im WgaTray.exe /T
del c:\WINNT\system32\WgaTray.exe /f /q
taskkill /f /im WgaTray.exe /T
del c:\WINNT\system32\WgaTray.exe /f /q
taskkill /f /im WgaTray.exe /T
del c:\WINNT\system32\WgaTray.exe /f /q
echo. & pause
把上面的复制到记事本里保存,把记事本的后缀TXT改成BAT,然后运行.
此方法供给大家参考.
]]> http://www.17benteng.com/article.asp?id=80 7180001@qq.com(admin) Fri,10 Oct 2008 09:20:20 +0800 http://www.17benteng.com/default.asp?id=80
delphi
bcb
.net
都可以了
OK 差不多搞定!
有问题再说

下载地址:http://www.17benteng.com/soft/delphi2009Crack_Update1.rar


]]> http://www.17benteng.com/article.asp?id=79 7180001@qq.com(admin) Fri,10 Oct 2008 09:12:08 +0800 http://www.17benteng.com/default.asp?id=79 程序下载地址
http://www.17benteng.com/soft/delphi2009.RMT.Crack.rar


]]> http://www.17benteng.com/article.asp?id=78 7180001@qq.com(admin) Tue,30 Sep 2008 11:13:40 +0800 http://www.17benteng.com/default.asp?id=78 IDC网站天使官方交流群43453676

1.0.0.7 beta

2008-06-26
修正机器长时间不重启防盗链不产生密串的bug
修正混合模式中一个Cookie不跨域的问题

2008-06-27
去消URL重写中的指定目录功能

1.0.0.7 正式版

2008-06-27
优化部份算法
使用release编译程序


1.0.0.8 beta

2008-07-05
修改防盗链开启后管理后台图片不能显示的bug

2008-07-11
重新编写防盗链算法，速度更快，运用更灵活

2008-07-12
增加日志功能，让使用者更了解自己的网站

2008-07-14
编写防盗链SDK接口部份

2008-07-16
为方便管理，增加全局目录忽略设置

2008-07-17
修改了管理程序，增加修改密码功能

2008-07-23
取消代码过滤功能，因此功能有点耗内存
修改关键词过滤功能，使之更易用

2008-07-25
修正信息过滤器中的一个bug

2008-08-08
修正信息过滤器中的一个压缩算法bug

2008-08-17
修正一个兼容问题

1.0.0.9 重写程序核心

2008-09-29
重写关键词过滤

2008-09-30
修正防盗链无参数的bug(http://domain/1.jpg?wasid)

下载地址:http://17benteng.com/soft/IDCWebAngel (1.0.0.9 beta2).rar
]]> http://www.17benteng.com/article.asp?id=77 7180001@qq.com(admin) Sun,17 Aug 2008 20:08:01 +0800 http://www.17benteng.com/default.asp?id=77
我们本着实际运用，用朴素的语言来介绍一下我们的“网站天使”！

什么是“网站天使”?

众所周知“天使”即是上帝派来守护人类的使者！他们拥有着常人没有的能力！也就是因为他们拥有常人没有的能力，他们才可以守护人类！

那么既然称为“网站天使”肯定有着不一般的功能了？！！！

首先“网站天使”就是为了弥补IIS的不足而更好地让网站站长控制自己的网站诞生，所以他的部份功能肯定是IIS所没有的，并且是很多网站站长所需要的！

使用在线web管理方式，可以使每一个使用“网站天使”的站长自主控制自己的“网站天使”功能，并且无需重启IIS，无须重启网站，就能使新的设置即时生效！

独有的多模式防盗链系统、让站长不必担忧资源被其它网站盗用，独有的在线管理自己网站的伪静态规则，并可以自动将“ISAPI_Rewrite”、“URLRewrite”等规则自动转换到

“网站天使”的“URL重写”规则！！！完全支持目前几大流行论坛(discuz、discuznt、phpwind等等...)的伪静态化处理！！！

在“网站天使”升级到“1.0.0.4”版本后，我们又增加了全新的“恶意代码过滤功能”，可过滤恶意嵌入的script,iframe,object代码，可设置允许嵌入的域名，而且代码过滤不会影响网页的正常浏览！！！

“网站天使”的“信息过滤”，可以过滤网页中的非法信息内容！！！

“网站天使”中全新的功能 “SQL注入防护”和“上传攻击防护” 结合在一起使用可以彻底地防止网站被非法入侵！

“网站天使”不愧为“网站天使”，九大功能彻底解决网站站长的种种困扰，使您可以更安心地把时间放到网站发展上去！！！“网站天使”网站的守护天使！！！

这么多强劲的功能你还在等什么呢？而且还是免费的！！！


下面仅对“网站天使”做一份并不详细的说明

功能一、“网站天使”之“IP阻塞”，可按需求设置“IP阻塞目录”，“IP阻塞模式”，“IP阻塞时转向地址”，“IP禁止时显示内容”等，

此功能与IIS内置的“IP阻塞”并不完全相同，

“网站天使”的“IP阻塞”是使用“IP段(如: 192.0.0.0～192.255.255.255)”阻塞或允许IP访问网站的，

要注意的是这里的“IP段”前面的IP值不能小于后面的IP值，否则设置的这条规则将无效，

“IP阻塞目录”可指定“IP阻塞”对应的目录(如: /IISwall/Demo/)，

这样此目录以及目录下面的子目录中的文件都会受“IP阻塞”控制，要注意的是不能跨目录设置子目录保护并且目录前面都要带“/”符号，比如现要保护目录“/IISwall/test/”

设置成“/Demo/”、“/IISwall/Demo”、“IISwall/Demo/”都是不正确的，正确的设置应为“/iiswall/demo/”大小写任意，

IP被阻塞可自动跳转到相应的URL，若跳转URL为空，则自动向客户端发送“显示内容(可以是HTML)”中的信息！

注：下面的各功能中的“是否指定目录”和“目录列表”,都与“IP阻塞”中的“是否指定目录”和“目录列表”功能相同，所以就不再作介绍了！



功能二、“网站天使”之“CC攻击防护”，可按需求设置“CC攻击防护目录”、“CC攻击保护文件类型”、“刷新间隔时间”、“受攻击时锁定时间”、“CC攻击锁定时转向地址”、“CC攻击锁定时显示内容”、“CC攻击保护例外”等，

要说明的是“CC攻击保护例外”，当baidu或google等公司的爬虫要访问网站时，“网站天使”的“CC攻击保护”也可能会当作CC攻击，所以我们要收集这此爬虫的IP地址并加入例外列表中！

其它设置都在管理程序中做了详细的说明！



功能三、“网站天使”之“线程限制”，可按需求设置“线程限制模式”、“线程限制目录”、“线程限制例外”、“线程限制文件类型”、“超出线程时转向地址”、“超出线程时显示内容”、“限制线程数”等，

其中“线程限制模式”为两种，“单文件线程”即为对单一个文件的下载进程限制，而全局线程则指的是，对整个网站的浏览或下者进程限制，“线程限制”中其它的设置项相信各位也能看明白了！


功能四、“网站天使”之“防盗链”，可按需求设置“防盗链模式”、“防盗链目录”、“允许链接域名列表”另分三种防盗链文件大类自行设置，分别为：“媒体文件”、“图片文件”、“其它文件”。

可使用静态调用或结合sdk一起使用!


功能五、“网站天使”之“URL重写”，URL重写既是被运用得比较广泛的伪静态技术，“网站天使”的伪静态和其它伪静态不同的是管理更加方便，直接使用web在线管理而且无需重启IIS！



功能六、“网站天使”之“信息过滤”，这个就不用多说了，“非法信息过滤”是很多人需要的！


功能七、“网站天使”之“SQL注入防护”，相信很多站长受到过SQL注入的困扰，而且“网站天使”的“SQL注入防护”可以防止GET、POST和COOKIE的注入攻击！！！


功能八、“网站天使”之“上传木马防护”，相信很多站长受到过上传木马防护的困扰，而且“网站天使”的“上传木马防护”可以防止很多基于HTTP的上传木马攻击！！！


http://17benteng.com/IDCWebAngel Professional (1.0.0.8).rar


]]> http://www.17benteng.com/article.asp?id=76 7180001@qq.com(admin) Wed,13 Aug 2008 16:26:23 +0800 http://www.17benteng.com/default.asp?id=76
内有一个类,和一个demo程序,大家自己看源码]]> http://www.17benteng.com/article.asp?id=75 7180001@qq.com(admin) Wed,30 Jul 2008 17:22:22 +0800 http://www.17benteng.com/default.asp?id=75
Option Explicit
Private Declare Function InternetOpen Lib "wininet.dll" _
    Alias "InternetOpenA" _
    (ByVal lpszCallerName As String, _
    ByVal dwAccessType As Long, _
    ByVal lpszProxyName As String, _
    ByVal lpszProxyBypass As String, _
    ByVal dwFlags As Long) As Long
    
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
   (ByVal hOpen As Long, _
   ByVal sUrl As String, _
   ByVal sHeaders As String, _
   ByVal lLength As Long, _
   ByVal lFlags As Long, _
   ByVal lContext As Long) _
   As Long

Private Declare Function InternetConnect Lib "wininet.dll" _
    Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, _
    ByVal lpszServerName As String, _
    ByVal nProxyPort As Integer, _
    ByVal lpszUsername As String, _
    ByVal lpszPassword As String, _
    ByVal dwService As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare Function InternetReadFile Lib "wininet.dll" _
   (ByVal hFile As Long, _
   ByRef sBuffer As Byte, _
   ByVal lNumBytesToRead As Long, _
   lNumberOfBytesRead As Long) _
   As Integer
    
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
    (ByVal hHttpRequest As Long, _
    ByVal lInfoLevel As Long, _
    ByVal sBuffer As Any, _
    ByRef lBufferLength As Long, _
    ByRef lIndex As Long) As Integer

Private Declare Function HttpOpenRequest Lib "wininet.dll" _
    Alias "HttpOpenRequestA" _
    (ByVal hInternetSession As Long, _
    ByVal lpszVerb As String, _
    ByVal lpszObjectName As String, _
    ByVal lpszVersion As String, _
    ByVal lpszReferer As String, _
    ByVal lpszAcceptTypes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

Private Declare Function HttpSendRequest Lib "wininet.dll" _
    Alias "HttpSendRequestA" _
    (ByVal hHttpRequest As Long, _
    ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, _
    ByVal sOptional As String, _
    ByVal lOptionalLength As Long) As Boolean
    
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" _
    Alias "HttpAddRequestHeadersA" _
    (ByVal hHttpRequest As Long, _
    ByVal sHeaders As String, _
    ByVal lHeadersLength As Long, _
    ByVal lModifiers As Long) As Integer
    
Private Declare Function InternetSetCookie Lib "wininet.dll" Alias "InternetSetCookieA" _
    (ByVal lpszUrlName As String, _
    ByVal lpszCookieName As String, _
    ByVal lpszCookieData As String) _
    As Boolean

Private Declare Function InternetGetCookie Lib "wininet.dll" Alias "InternetGetCookieA" _
    (ByVal lpszUrlName As String, _
    ByVal lpszCookieName As String, _
    ByVal lpszCookieData As String, _
    lpdwSize As Long) _
    As Boolean

Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInternetHandle As Long) As Boolean
    
Private Declare Function DeleteUrlCacheEntry Lib "wininet" _
   Alias "DeleteUrlCacheEntryA" _
  (ByVal lpszUrlName As String) As Long
    
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
    
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
    
Private Const GWL_WNDPROC = (-4)
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3&
Private Const INVALID_HANDLE_VALUE = -1&
Private Const Create_ALWAYS = 2
Private Const FILE_BEGIN = 0
Private Const OPEN_ALWAYS = 4

Public Enum wd_Status
    s1 = 1  ' 开始会话
    s2 = 2  ' 连接服务器
    s3 = 3  ' 发送请求
    s4 = 4  ' 请求成功
    s5 = 5  ' 开始接收数据
    s6 = 6  ' 下载结束
End Enum

Public Enum wd_ErrorCode
    e1 = 1  ' 会话失败
    e2 = 2  ' 连接服务器失败
    e3 = 3  ' 发送请求失败
    e4 = 4  ' 下载被中止
    e5 = 5  ' 文件已经存在
    e6 = 6  ' 创建目录出错
    e7 = 7  ' 打开文件时出错
End Enum
    
Private m_Method                As String
Private m_URL                   As String
Private m_Referer               As String
Private m_UserAgent             As String
Private m_Cookie                As String
Private m_Charset               As String
Private m_Pakesize              As Long
Private m_ReDown                As Boolean
Private m_Filename              As String
Private m_PostData              As String
Private m_IsUpload              As Boolean

Private server                  As String
Private port                    As Long
Private script                  As String

Private blnDownLoad             As Boolean  '是否下载中

Private hInternetOpen           As Long
Private hInternetConnect        As Long
Private hHttpOpenRequest        As Long

Private Buffer                  As String
Private buflen                  As Long
Private RetQueryInfo            As Boolean

Private dtTimerStart            As Double   '下载时间,用来计算速度
Private TimeConsuming           As Double   '下载耗时
Private dbSpeed                 As Double   '下载速度

'下载库通过该事件通知文件下载进度
Event Progress(ByVal dbFileSize As Double, ByVal dbFinished As Double, ByVal dbSpeed As Double)
'下载库通过该事件通知下载过程结束
Event DownloadEnd(ByVal bSuccess As Boolean)
'下载库通过该函数通知下载状态
Event Status(ByVal lStatus As wd_Status)
'下载库通过该函数通知下载过程中发生的错误
Event Error(ByVal lErrorCode As wd_ErrorCode)
            
' 返回版本信息
Public Property Get Version()
    Version = "Pentium WininetDown 1.0.0"
End Property

'类初始化
Private Sub Class_Initialize()
    m_Method = "GET"
    m_URL = ""
    m_Referer = ""
    m_UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    m_Cookie = ""
    m_Charset = "gb2312"
    m_Pakesize = 1024
    m_ReDown = True
    m_Filename = ""
    m_PostData = ""
    m_IsUpload = False

    server = ""
    port = 80
    script = ""
    
    blnDownLoad = False
    
    hInternetOpen = 0
    hInternetConnect = 0
    hHttpOpenRequest = 0
End Sub

'类注销
Private Sub Class_Terminate()
    blnDownLoad = False
End Sub

'Method
Public Property Let Method(ByVal oValue As String)
    m_Method = oValue
End Property
Public Property Get Method() As String
    Method = m_Method
End Property

'URL
Public Property Let URL(ByVal oValue As String)
    m_URL = oValue
End Property
Public Property Get URL() As String
    URL = m_URL
End Property

'Referer
Public Property Let Referer(ByVal oValue As String)
    m_Referer = oValue
End Property
Public Property Get Referer() As String
    Referer = m_Referer
End Property

'UserAgent
Public Property Let UserAgent(ByVal oValue As String)
    m_UserAgent = oValue
End Property
Public Property Get UserAgent() As String
    UserAgent = m_UserAgent
End Property

'Cookie
Public Property Let Cookie(ByVal oValue As String)
    m_Cookie = oValue
End Property
Public Property Get Cookie() As String
    Cookie = m_Cookie
End Property

'设置返回字符串类型
Public Property Let Charset(ByVal oValue As String)
    m_Charset = oValue
End Property
Public Property Get Charset() As String
    Charset = m_Charset
End Property

'Pakesize
Public Property Let Pakesize(ByVal oValue As Long)
    m_Pakesize = oValue
End Property
Public Property Get Pakesize() As Long
    Pakesize = m_Pakesize
End Property

'ReDown
Public Property Let ReDown(ByVal oValue As Boolean)
    m_ReDown = oValue
End Property
Public Property Get ReDown() As Boolean
    ReDown = m_ReDown
End Property

'Filename
Public Property Let Filename(ByVal oValue As String)
    m_Filename = oValue
End Property
Public Property Get Filename() As String
    Filename = m_Filename
End Property

'PostData
Public Property Let PostData(ByVal oValue As String)
    m_PostData = oValue
End Property
Public Property Get PostData() As String
    PostData = m_PostData
End Property

' IsUpload
Public Property Let IsUpload(ByVal oValue As Boolean)
    m_IsUpload = oValue
End Property
Public Property Get IsUpload() As Boolean
    IsUpload = m_IsUpload
End Property

' SplitCode
Public Property Let SplitCode(ByVal oValue As String)
    m_SplitCode = oValue
End Property
Public Property Get SplitCode() As String
    SplitCode = m_SplitCode
End Property

' 使用Adodb.Stream处理二进制数据
Private Function BytesToBstr(ByVal strBody, ByVal CodeBase)
    Dim Ados
    Set Ados = CreateObject("Adodb.Stream")
    Ados.Type = 1
    Ados.Mode = 3
    Ados.Open
    Ados.Write strBody
    Ados.Position = 0
    Ados.Type = 2
    Ados.Charset = CodeBase
    BytesToBstr = Ados.ReadText
    Ados.Close
    Set Ados = Nothing
End Function

' 分析URL
Private Sub URLAnalysis()
    Dim bStart As Long
    If m_URL <> "" Then
        server = Replace(m_URL, "http://", "", 1, -1, vbTextCompare)
        bStart = InStr(server, "/")
        If bStart <= 0 Then
            script = "/"
            server = server
        Else
            script = Mid(server, bStart)
            server = Mid(server, 1, bStart - 1)
        End If
        If InStr(server, ":") > 0 Then
            Dim osvr As Variant
            osvr = Split(server, ":")
            server = osvr(0)
            port = CLng(osvr(1))
        Else
            server = server
            port = 80
        End If
    End If
End Sub

' 执行下载
Public Function Download() As Boolean
    blnDownLoad = True
    Dim bRet As Boolean
    ' 分析URL
    URLAnalysis
    ' 建立一个internet会话
    RaiseEvent Status(s1)
    hInternetOpen = InternetOpen(m_UserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    If hInternetOpen = 0 Then
        Download = False
        RaiseEvent Error(e1)
        Exit Function
    End If
    
    ' 连接服务器
    RaiseEvent Status(s2)
    hInternetConnect = InternetConnect(hInternetOpen, server, port, vbNullString, "HTTP/1.0", INTERNET_SERVICE_HTTP, 0, 0)
    If hInternetConnect = 0 Then
        Download = False
        RaiseEvent Error(e2)
        Exit Function
    End If

    ' 发送请求下载指定文件
    RaiseEvent Status(s3)
    hHttpOpenRequest = HttpOpenRequest(hInternetConnect, m_Method, script, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
    If hHttpOpenRequest = 0 Then
        Download = False
        RaiseEvent Error(e3)
        Exit Function
    End If
    ' 请求成功
    Download = True
    RaiseEvent Status(s4)
    
    Dim sHeader As String
    If m_Referer <> "" Then
        sHeader = sHeader & "Referer: " & m_Referer & vbCrLf
    End If
    If UCase(m_Method) = "POST" Then
        sHeader = sHeader & "Content-Type: application/x-www-form-urlencoded" & vbCrLf
    End If
    ' 发送客户端信息
    bRet = HttpAddRequestHeaders(hHttpOpenRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD)
    ' 发送Cookie
    If m_Cookie <> "" Then
        InternetSetCookie m_URL, vbNullString, m_Cookie
    End If
    ' 发送数据
    'If (UCase(m_Method) = "POST") And (m_PostData <> "") Then
        Dim lpszPostData As String
        Dim lPostDataLen As Long
        
        lpszPostData = m_PostData
        lPostDataLen = Len(lpszPostData)
        bRet = HttpSendRequest(hHttpOpenRequest, vbNullString, 0, lpszPostData, lPostDataLen)
    'End If
    
    Buffer = Space$(1024)
    buflen = 1024
    RetQueryInfo = HttpQueryInfo(hHttpOpenRequest, 21, Buffer, buflen, 0)
    If RetQueryInfo Then
        Buffer = Mid$(Buffer, 1, buflen)
        'Debug.Print Buffer
    Else
        Buffer = ""
    End If
End Function

'退出下载
Public Sub bStop()
    blnDownLoad = False
    InternetCloseHandle hHttpOpenRequest
    InternetCloseHandle hInternetConnect
    InternetCloseHandle hInternetOpen
    
    DeleteUrlCacheEntry m_URL
End Sub

'取得文件头
Public Function GetHeader(Optional hdrName As String = vbNullString) As String
    On Error Resume Next
    Dim tmp As Long
    Dim tmp2 As String
    If blnDownLoad = False Then
        GetHeader = "0"
        bStop
        Exit Function
    End If
    If Buffer <> "" Then
        Select Case UCase$(hdrName)
            Case "CONTENT-LENGTH"
                tmp = InStr(Buffer, "Content-Length")
                tmp2 = Mid$(Buffer, tmp + 16, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "CONTENT-TYPE"
                tmp = InStr(Buffer, "Content-Type")
                tmp2 = Mid$(Buffer, tmp + 14, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "DATE"
                tmp = InStr(Buffer, "Date")
                tmp2 = Mid$(Buffer, tmp + 6, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "LAST-MODIFIED"
                tmp = InStr(Buffer, "Last-Modified")
                tmp2 = Mid$(Buffer, tmp + 15, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case "SERVER"
                tmp = InStr(Buffer, "Server")
                tmp2 = Mid$(Buffer, tmp + 8, Len(Buffer))
                tmp = InStr(tmp2, Chr$(0))
                GetHeader = CStr(Mid$(tmp2, 1, tmp - 1))
            Case vbNullString
                GetHeader = Buffer
            Case Else
                GetHeader = "0"
        End Select
    Else
        GetHeader = "0"
    End If
End Function

' 取得文件大小
Public Function FileSize() As Long
    On Error Resume Next
    FileSize = GetHeader("Content-Length")
    If Err Then
        FileSize = 1
    End If
End Function

' 取得Cookie
Public Function GetCookie(Optional ByVal CookName As String = vbNullString) As String
    On Error Resume Next
    Dim sCookieVal As String * 256
    Dim bRet As Boolean
    bRet = InternetGetCookie(m_URL, CookName, sCookieVal, 255)
    If bRet = False Then
        GetCookie = ""
    Else
        sCookieVal = Replace(sCookieVal, Chr(0), "")
        sCookieVal = Replace(sCookieVal, Chr(10), "")
        sCookieVal = Replace(sCookieVal, Chr(13), "")
        GetCookie = sCookieVal
    End If
End Function

'取得文本
Public Function DownLoadToText() As String
    On Error Resume Next
    If Download = False Then
        DownLoadToText = ""
        Exit Function
    End If
    Dim TempBody            As String
    Dim sReadBuffer()       As Byte
    Dim TatolSize           As Double
    Dim lNumberOfBytesRead  As Long
    Dim ReadTatols          As Double
    Dim bRet                As Boolean
    
    DownLoadToText = ""
    
    If blnDownLoad = False Then
        ' 下载被中止
        bStop
        DownLoadToText = ""
        RaiseEvent Error(e4)
        RaiseEvent DownloadEnd(False)
        Exit Function
    End If
    
    ' 取得文件大小
    TatolSize = FileSize
    ' 时间开始
    dtTimerStart = Timer()
    Do While True
        ReDim sReadBuffer(m_Pakesize)
        bRet = InternetReadFile(hHttpOpenRequest, sReadBuffer(0), m_Pakesize, lNumberOfBytesRead)
        If lNumberOfBytesRead > 0 And bRet = True Then
            ReDim Preserve sReadBuffer(0 To lNumberOfBytesRead - 1)
            TempBody = TempBody & BytesToBstr(sReadBuffer, m_Charset)
            ReadTatols = ReadTatols + lNumberOfBytesRead
            TimeConsuming = Timer() - dtTimerStart
            If TimeConsuming > 0 Then
                dbSpeed = ReadTatols / TimeConsuming
            End If
            ' 开始接收数据
            RaiseEvent Status(s5)
            ' 进度信息
            RaiseEvent Progress(TatolSize, ReadTatols, dbSpeed)
        Else
            Exit Do
        End If
        
        DoEvents
        If blnDownLoad = False Then
            ' 下载被中止
            bStop
            DownLoadToText = ""
            RaiseEvent Error(e4)
            RaiseEvent DownloadEnd(False)
            Exit Do
        End If
    Loop
    '取得文本
    DownLoadToText = TempBody
    
    If blnDownLoad = True Then
        '下载完成
        bStop
        RaiseEvent Status(s6)
        RaiseEvent DownloadEnd(True)
    End If
End Function

'下载到文件
Public Function DownloadToFile() As Boolean
    On Error Resume Next
    If Download = False Then
        DownloadToFile = False
        Exit Function
    End If
    Dim sReadBuffer()       As Byte
    Dim TatolSize           As Double
    Dim lNumberOfBytesRead  As Long
    Dim ReadTatols          As Double
    Dim bRet                As Boolean
    
    Dim FileHandle          As Long      '文件操作句柄
    
    If blnDownLoad = False Then
        ' 下载被中止
        bStop
        DownloadToFile = False
        RaiseEvent Error(e4)
        RaiseEvent DownloadEnd(False)
        Exit Function
    End If
    
    ' 取得文件大小
    TatolSize = FileSize
    
    '文件存在
    If Len(Dir$(m_Filename)) = TatolSize Then
        If m_ReDown = False Then
            ' 文件已经存在
            bStop
            DownloadToFile = False
            RaiseEvent Error(e5)
            RaiseEvent DownloadEnd(False)
            Exit Function
        Else
            ' 删除
            Kill Filename
        End If
    Else
        ' 删除
        Kill Filename
    End If
    
    If CheckFolder(m_Filename) = True Then
        FileHandle = CreateFile(m_Filename, GENERIC_WRITE, 0, ByVal 0&, OPEN_ALWAYS, 0, ByVal 0&)
    Else
        ' 创建目录出错
        bStop
        DownloadToFile = False
        RaiseEvent Error(e6)
        RaiseEvent DownloadEnd(False)
        Exit Function
    End If
    If Err Then
        Err.Clear
        '关闭文件
        CloseHandle FileHandle
        ' 打开文件时出错
        bStop
        DownloadToFile = False
        RaiseEvent Error(e7)
        RaiseEvent DownloadEnd(False)
        Exit Function
    End If
    '设定写入位置
    SetFilePointer FileHandle, 0, ByVal 0&, FILE_BEGIN
    ' 时间开始
    dtTimerStart = Timer()
    Do While True
        ReDim sReadBuffer(m_Pakesize)
        bRet = InternetReadFile(hHttpOpenRequest, sReadBuffer(0), m_Pakesize, lNumberOfBytesRead)
        If lNumberOfBytesRead > 0 And bRet = True Then
            ReDim Preserve sReadBuffer(0 To lNumberOfBytesRead - 1)
            ReadTatols = ReadTatols + lNumberOfBytesRead
            Dim Ret As Long
            WriteFile FileHandle, sReadBuffer(0), lNumberOfBytesRead, Ret, ByVal 0&
            TimeConsuming = Timer() - dtTimerStart
            If TimeConsuming > 0 Then
                dbSpeed = ReadTatols / TimeConsuming
            End If
            ' 开始接收数据
            RaiseEvent Status(s5)
            ' 进度信息
            RaiseEvent Progress(TatolSize, ReadTatols, dbSpeed)
        Else
            Exit Do
        End If
        
        DoEvents
        If blnDownLoad = False Then
            ' 下载被中止
            bStop
            DownloadToFile = False
            RaiseEvent Error(e4)
            RaiseEvent DownloadEnd(False)
            Exit Do
        End If
    Loop
    '关闭文件
    CloseHandle FileHandle
    
    If blnDownLoad = True Then
        '下载完成
        bStop
        DownloadToFile = True
        RaiseEvent Status(s6)
        RaiseEvent DownloadEnd(True)
    End If
End Function


下载地址:
http://17benteng.com/Codes/vb/WininetDown.rar
]]> http://www.17benteng.com/article.asp?id=74 7180001@qq.com(admin) Wed,30 Jul 2008 17:13:45 +0800 http://www.17benteng.com/default.asp?id=74

下载地址
http://17benteng.com/Codes/vb/Benteng_Sniffer2.rar]]>