Source code of ASP that can be connected to images in 163 albums

The attachment is a cracked ASP Source code If your space supports ASP, you can directly transfer it to your space. Of course, here we will provide you with a unified solution for your convenience!
Quote:
As we all know, the 163 album speed is very fast. It is several times the QQ album. There is also an upload tool that can upload many images at a time. However, there is a major drawback: you cannot link images in an album (this is called the anti-leeching System) elsewhere. Of course, this is 163 anti-leeching only because of your own interests. However, now I want to display the image in the album in the forum. Hey, the image below is my photo, which is put in the album of 163.

Quote:
How to operate: for example, your 163 album has an image address is if you fill in directly in the address of the texture frame: This hair out, certainly show Red Cross as long as in front of the image address plus http://home.goofar.com/ile8/showpic.asp? Url = that is, the image address
Enter OK to complete
Some people cannot be put into the ASP space. This may be the reason for the space, that is, if instr (request. servervariables ("http_referer"), "http: //" & request. servervariables ("SERVER_NAME") & ") = 0 then
Response. Write "illegal leeching"
Response. End
End if
Just remove it ......CopyCodeThe Code is as follows: <%
'Leeching judgment
Dim URL, body, mycache

Url = request. querystring ("url ")

Set mycache = new cache
Mycache. Name = "picindex" & URL
If mycache. Valid then
Body = mycache. Value
Else
Body = getwebdata (URL)
Mycache. add body, dateadd ("D", 1, now)
End if

If err. Number = 0 then
Response. charset = "UTF-8"
Response. contenttype = "application/octet-stream"
Response. binarywrite body
Response. Flush
Else
Wscript. Echo err. Description
End if

'Get data
Public Function getwebdata (byval strurl)
Dim curlpath
Curlpath = mid (strurl, 1, instr (8, strurl ,"/"))
Dim Retrieval
Set retrieval = server. Createobject ("Microsoft. XMLHTTP ")
With Retrieval
. Open "get", strurl, false ,"",""
. SetRequestHeader "Referer", curlpath
. Send
Getwebdata =. responsebody
End
Set retrieval = nothing
End Function

'Cache class

Class Cache
Private OBJ 'cache content
Private expiretime 'expiration time
Private expiretimename 'expiration time application name
Private cachename 'cache content application name
Private path 'url

Private sub class_initialize ()
Path = request. servervariables ("url ")
Path = left (path, limit Rev (path ,"/"))
End sub

Private sub class_terminate ()
End sub

Public property get blempty
'Empty?
If isempty (OBJ) then
Blempty = true
Else
Blempty = false
End if
End Property

Public property get valid
'Available (expired)
If isempty (OBJ) or not isdate (expiretime) then
Valid = false
Elseif cdate (expiretime) <now then
Valid = false
Else
Valid = true
End if
End Property

Public property let name (STR)
'Set cache name
Cachename = STR & Path
OBJ = Application (cachename)
Expiretimename = STR & "expires" & Path
Expiretime = Application (expiretimename)
End Property

Public property let expires (TM)
'Reset the expiration time
Expiretime = TM
Application. Lock
Application (expiretimename) = expiretime
Application. Unlock
End Property

Public sub add (VAR, expire)
'Assign a value
If isempty (VAR) or not isdate (expire) then
Exit sub
End if
OBJ = VaR
Expiretime = expire
Application. Lock
Application (cachename) = OBJ
Application (expiretimename) = expiretime
Application. Unlock
End sub

Public property get value
'Value
If isempty (OBJ) or not isdate (expiretime) then
Value = NULL
Elseif cdate (expiretime) <now then
Value = NULL
Else
Value = OBJ
End if
End Property

Public sub makeempty ()
'Release the application
Application. Lock
Application (cachename) = empty
Application (expiretimename) = empty
Application. Unlock
OBJ = empty
Expiretime = empty
End sub

Public Function equal (var2)
'comparison
If typename (OBJ) <> typename (var2) then
equal = false
elseif typename (OBJ) = "object" then
If obj is var2 then
equal = true
else
equal = false
end if
elseif typename (OBJ) = "variant ()" then
If join (OBJ, "^") = join (var2, "^ ") then
equal = true
else
equal = false
end if
else
If OBJ = var2 then
equal = true
else
equal = false
end if
end function
end class
%>