E动力采集汽车之家图片规则未完成

7sg2011 · 发表于 2011-8-3 19:50:37

本帖最后由 7sg2011 于 2011-8-4 10:52 编辑

在网上搜了这个ASP的规则，在火车头不懂如何配置，求助高手，成功可付费

ASP代码：

<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta http-equiv="Content-Language" content="zh-cn">
</head>
<html>
<%
'ole db连接
set conn = Server.CreateObject("ADODB.Connection")
conn.Open "provider=sqloledb;data source=sql服务器;initial catalog=数据库;user id=名字;password=密码;" '
%>
<%
u=0
set rs2= Server.CreateObject("ADODB.RecordSet")
rs2.Open "select * from jl10pic where chu=0",conn ,1,1 '临时数据库没有处理过的图片
do While not rs2.eof
xid=rs2("id")
bbc=rs2("name")
lei=rs2("lei")
dizhi=""
qian=0
hou=0
zhong=0
memo=rs2("nei")
qian = InStr(1,memo, "src",1)
if qian<>0 then
hou = InStr(1,memo, "jpg",1)
if hou<>0 then
zhong=hou-qian
if zhong >0 then
dizhi= Mid(memo,qian+13,zhong-10) '从数据库图片地址中获取文件名
end if
end if
end if
if dizhi<>"" then
set rs= Server.CreateObject("ADODB.RecordSet")
rs.Open "select top 1 * from auto_car_brand where type=2 and itemname="&"'"&bbc&"'",conn ,1,1
if not rs.eof then
bbc1=rs("dir")
Set fs=Server.CreateObject("Scripting.FileSystemObject")
If fs.FolderExists("D:\WWW\wwwroot\0777carcom_pp7yu2dg\www\uploadfile\carbrand"&bbc1) = false Then '如果没有车型文件夹
fs.CreateFolder("D:\WWW\wwwroot\0777carcom_pp7yu2dg\www\uploadfile\carbrand"&bbc1) '则建立这个文件夹
End If
fs.MoveFile "D:\WWW\wwwroot\0777carcom_pp7yu2dg\www\uploadfile\jl10che\Image"&dizhi , "D:\WWW\wwwroot\0777carcom_pp7yu2dg\www\uploadfile\carbrand"&bbc1&""&lei&dizhi '移动图片到这个文件夹文件名前加上类型
set fs=nothing
'以下是生成缩略图部分
s_OriginalPath="/uploadfile/carbrand/"&bbc1&"/"&lei&dizhi
s_BuildBasePath="/uploadfile/carbrand/"&bbc1
n_MaxWidth=120
n_MaxHeight=90
Err.Clear
On Error Resume Next
Set AspJpeg = Server.Createobject("Persits.Jpeg")
s_MapOriginalPath = Server.MapPath(s_OriginalPath)
AspJpeg.Open s_MapOriginalPath ''''打开原图片
n_OriginalWidth = AspJpeg.Width
n_OriginalHeight = AspJpeg.Height
div1 = n_OriginalWidth / n_OriginalHeight
div2 = n_OriginalHeight / n_OriginalWidth
n1 = 0
n2 = 0
If n_OriginalWidth > n_MaxWidth Then
n1 = n_OriginalWidth / n_MaxWidth
Else
n_BuildWidth = n_OriginalWidth
End If
If n_OriginalHeight > n_MaxHeight Then
n2 = n_OriginalHeight / n_MaxHeight
Else
n_BuildHeight = n_OriginalHeight
End If
If n1 <> 0 Or n2 <> 0 Then
If n1 > n2 Then
n_BuildWidth = n_MaxWidth
n_BuildHeight = n_MaxWidth * div2
Else
n_BuildWidth = n_MaxHeight * div1
n_BuildHeight = n_MaxHeight
End If
End If
AspJpeg.Width = n_BuildWidth
AspJpeg.Height = n_BuildHeight
pos = InStrRev(s_OriginalPath, "/") + 1
s_OriginalFileName = Mid(s_OriginalPath, pos)
pos = InStrRev(s_OriginalFileName, ".")
s_OriginalFileExt = Mid(s_OriginalFileName, pos)
If Right(s_BuildBasePath, 1) <> "/" Then s_BuildBasePath = s_BuildBasePath & "/"
s_MapBuildBasePath = Server.MapPath(s_BuildBasePath)
s_EndFlag = "_small" ''''可以自定义,只要能区别大小图片即可
s_BuildFileName = Replace(s_OriginalFileName, s_OriginalFileExt, "") & s_EndFlag & s_OriginalFileExt
s_MapBuildPath = s_MapBuildBasePath & "" & s_BuildFileName
AspJpeg.Save s_MapBuildPath ''''保存
Set AspJpeg = Nothing
If Err.Number <> 0 Then
BuildSmallPic = "Error_Other"
Err.Clear
End If
BuildSmallPic = s_BuildBasePath & s_BuildFileName
sql="delete from jl10pic where id=" & xid '从临时数据库中删除数据
conn.execute sql
u=u+1
else
response.write "没找到"&bbc&"</br>" '把采集到的，而且现有车型里没有的车型名字写出来
end if
rs.close()
end if
rs2.MoveNext
Loop
rs2.close()
conn.close()
%>成功移动<%=u%>个图片
</html>

复制代码

303718 · 发表于 2011-8-5 08:31:59

你是要配置采集还是发布接口呢。

E动力采集汽车之家图片规则未完成

浏览过的版块