服务器_直接保存URL图像或网页到服务器本地的类,复制代码 代码如下:% @ LANGUA
set ADOS=Server.CreateObject("Adodb.Stream")
select case imgUp.imgType
End With
dim preName,extName
newwin.document.close();
ret(0)="png"
else
Private Function Num2Str(num,base,lens)
else
ln=inStrRev(fileName,".")
dim ln
End Function
'dim imgUp
End SUB
dim DiskPath,XuPath,NewUrl
var code=event.srcElement.parentElement.children[0].value;
<INPUT TYPE="radio" value=2 <%if iSaveMode="2" then response.write "checked" end if%>> 文本文件
.Open "Get", StrUrl, False, "", ""
ret(0)="jpg"
chkInfo=""
if trim(fullpath)="" or _
BinVal=ret
ret(2)=BinVal2(ADOS.read(2))
dim ret(3),bFlag,fdata,fsize
R_write "图像文件名:"&imgUp.imgName,1
End Class
R_Write "<br>传输文件栏没有填写有效的图像URL!",0
var newwin=window.open('','','');
end if
end select
<%
ADOS.close
ret = ret *256 + ascb(midb(bin,i,1))
ret(1)=binval(ADOS.Read(4))
if lcase(right(SaveName,4))<>"."&imgType then
GetWebData =.ResponseBody
<hr size=1>
'图象上传和上传信息获取CLASS
<% @ LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
loop while true
R_write "保存位置:"&imgUp.DiskPath,1
R_write " 大小:"&formatnumber(imgUp.imgSize/1024,2,-1)&" KB",1
end if
dim imgUp '传输对象
dim iSavePath '要保存的虚拟路径
'方法:
'取文件类型和长宽
R_write "虚拟路径:"&imgUp.XuPath,1
if SaveName="" then
End Sub
Private Function Bin2Str(Bin)
'imgUp.imgName '图像文件名:"&
保存类型:
fileName=split(nameStr,"?")(0)
'=================调用过程 Execute========================
imgSize=fsize
Str = Str & Chr(ASCB(clow))
ADOS.Position=0 '重置数据开始位置
SUB saveUpload(GetUrl,SavePath,SaveName,mode)
'R_write inStrRev(fileName,"."),1
'imgUp.saveImg(fullpath) '保存图像文件
ret(0)="gif"
if mode="1" and imgUp.imgName="unknow" then
'set imgUp=new BoxInfoImg
'R_Write mode,1
ADOS.Open
ADOS.SaveToFile FullPath,2
r_write "错误的URL,请输入可访问的URL",0
function setsmiley(what)
end if
ADOS.read(3)
if SaveMode="1" then
Bin2Str = Str
else
for i=1 to len(str)
set ADOS=nothing
.Send
imgUp.saveImg imgUp.DiskPath
do:p1=binVal(ADOS.Read(1)):loop while p1<255 and not ADOS.EOS
call tform()
dim ret:ret = 0
保存文件名:<INPUT TYPE="text" size=50 value=""><br>
imgSize=fsize
End Function
ADOS.Type=1
R_write "无有效数据保存",0
<META CONTENT="V37">
R_write " 宽:"&imgUp.width&" pix",1
end if
ret(1)=BinVal(ADOS.read(2))
'imgUp.filename '文件名"&
height=0 or _
next
else
dim defaultName
ADOS.Write fdata
call tform()
ret(0)=""
if isNull(bFlag) then
end if
else
do
ADOS.SaveToFile FullPath,2
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
end if
call tform()
newwin.opener = null
else
document.PostForm.comment.value += " "+what;
Private Function BinVal2(bin)
获取 URL:<INPUT TYPE="text" size=50 value="http://www.blueidea.com/img/common/logo.gif"><br>
'imgUp.XuPath '虚拟路径"
// var code=event.srcElement.parentElement.children[0].value;
textStr=ADOS.readtext()
<HEAD>
end if
function runCode(num) //运行代码HTML
end select
exit function
for i = lenb(bin) to 1 step -1
case else
chkInfo="<li>无效的传输格式,允许图像数据格式为 ""png"",""jpg"",""bmp"",""gif""</li>"
R_write " 高:"&imgUp.height&" pix",1
<INPUT TYPE="submit" value="确定提交">
</FORM>
end if
<INPUT TYPE="radio" value=1 <%if iSaveMode="1" or iSaveMode="" then response.write "checked" end if%>> Web图像
dim GetStrUrl '要获取的图像或网页URL
<!--
height=ret(2)
}
end if
Class BoxInfoImg
getimagesize=ret
ret = ret *256 + ascb(midb(bin,i,1))
if left(Bin2Str(bFlag),2)="BM" then
ret(2)=BinVal(ADOS.read(2))
if fsize=0 then
R_Write "未指定有效的URL",0
Private Function Str2Num(str,base)
if p1>191 and p1<196 then exit do else ADOS.read(binval2(ADOS.Read(2))-2)
<%
I=I+1
case "FFD8FF":
ADOS.Read(3)
With Retrieval
end if
%>
</HTML>
else
end sub
do: p1=binVal(ADOS.Read(1)): loop while p1=255 and not ADOS.EOS
R_write "扩展名:"&imgUp.extName,1
width=0
dim width,height,imgSize,imgType,imgName,fileName
{
SaveMode=iSaveMode
</BODY>
ret(0)=imgType:ret(1)=width:ret(2)=height:ret(3)=""
if SaveMode="1" then
<HTML>
dim nameStr
if SaveMode="2" then
<BODY>
iSavePath=trim(request.form("SavePath"))
Num2Str = right(string(lens,"0") & num & ret,lens)
dim i,testStr,showStr
if(num==1){var code=window.form2.code.innerText;}
R_write "<b>===处理结果部分资料===</b><br>",1
GetStrUrl=trim(request.form("GetStrUrl"))
Set Retrieval = Nothing
dim Retrieval
R_write "<textarea cols=100 name=content rows=10 width:90%;fixed;word-break:break-all;"">"&server.htmlencode(imgUp.textStr)&"</textarea>",1
'R_Write imgUp.imgName,1
end select
'-------------
end if
end if
<META CONTENT="">
<%End SUB
'用法:
end if
ADOS.Charset ="gb2312"
getimagesize=ret
ADOS.Type=2
SaveName=defaultName
set imgUp=nothing
End function
R_Write "<br>传输文件栏没有填写!",0
{
getImageSize
width=ret(1)
if nameStr="" then
preName=fileName
imgType=ret(0)
iSaveName=trim(request.form("SaveName"))
End Function
dim iSaveMode '保存的模式 1 为图像 0 为任意文件
Public Function getImageSize()
next
ret(1)=BinVal2(ADOS.read(2))
Next
'imgUp.NewUrl '保存后url"
if ASCB(clow)<128 then
SavePath=iSavePath
ret(2)=binval(ADOS.Read(4))
<INPUT TYPE="radio" value=0 <%if iSaveMode="0" then response.write "checked" end if%>> 二进制数据
dim textStr
ADOS.Position=0
dim tempStr
case else
Private Sub Class_Initialize
defaultName=filename
End Function
'
end if
End Function
'R_write fileName,0
'R_write fileName,1
else
Option Explicit
<%
if SavePath="" then SavePath="./"
end if
case "464947":
dim ret:ret = 0
<hr size=1>
iSaveMode=trim(request.form("SaveMode"))
ret = ret *base + cint(mid(str,i,1))
nameStr=tempStr(ubound(tempStr))
SaveName=SaveName&"."&imgType
imgName="unknow"
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
dim i
fsize=clng(lenb(fdata))
'取得数据尺寸
R_Write chkInfo,0
if ln>0 then
'imgUp.DiskPath '保存位置"
ADOS.read(2)
BinVal2=ret
XuPath=replace(replace(DiskPath,server.mappath("https://www.xp.cn/"),""),"\","https://www.xp.cn/")
<br>保存为其他任意方式,对asp html 等为取得发送结果的Html
exit function
%>
Private Sub Class_Terminate
response.write str&"<br>"
height=0
newwin.document.write(code);
set imgUp=nothing
DiskPath=server.mappath(SavePath&SaveName)
//-->
exit function
/*function runCode()
'imgUp.imgType '类型
dim SavePath,SaveName,SaveMode
<br>保存文件路径为空则保存在当前路径
end if
'imgUp.imgName '文件名
Select case ret(0)
ret(2)=binval2(ADOS.Read(2))
end if
SaveImg=false
NewUrl="http://"&Request.ServerVariables("SERVER_NAME")&XuPath
newwin.document.write(code);
R_write "<img src="""https://www.xp.cn/&imgUp.XuPath&"?"&timer()&""" alt="&imgUp.imgName&">",1
dim ADOS
R_write "文件名:"&imgUp.filename,1
while(num>=base)
End Sub
<br>如果保存为图像,不要加扩展名,自动识别加上,如果加的扩展名不合也回自动加上
case "png","jpg","bmp","gif","swf"
width=0 or _
select case hex(binVal(bFlag))
ret=(num mod base) & ret
SavePath=replace(SavePath,"//","https://www.xp.cn/")
else
<META CONTENT="EditPlus">
clow=MidB(Bin,I,1)
}
extName=right(fileName,len(fileName)-inStrRev(fileName,"."))
End Function
'imgUp.height '高
ADOS.Mode=3
document.PostForm.comment.focus();
if GetUrl="" then
height=0
%>
</HEAD>
case "png","jpg","bmp","gif"
width=0
R_write "<buttonPreviews"" title=""页面快照""runCode(0);"">Run this code</button>",1
R_write "保存后url:"&imgUp.NewUrl,1
Server.ScriptTimeOut=5000
if mode="1" and chkInfo<>"" then '检查上传图像数据合格后,则保存之
end if
num=(num - num mod base)/base
newwin.document.close();
if GetStrUrl<>"" then
dim iSaveName '要保存的名字
if(num==0){var code=window.form2.content.innerText;}
for i = 1 to lenb(bin)
{
'R_Write SavePath,1
if StrUrl="" then
'R_Write "SaveName="&SaveName,1
if tempStr(ubound(tempStr))="" or inStr(StrUrl,"https://www.xp.cn/")=0 then
dim istr:istr=str
'限定格式
imgType=".unknow"
ADOS.read(15)
Str2Num=ret
dim tempStr
call tform()
<%
<FORM METHOD=POST name=form2>
For I=1 to LenB(Bin)
CALL saveUpload(GetStrUrl,iSavePath,iSaveName,iSaveMode)
保存路径:<INPUT TYPE="text" size=50 value="./"><br>
Public function SaveImg(FullPath)
%>
SaveImg=true
dim p1
tempStr=split(GetStrUrl,"https://www.xp.cn/")
R_write "------------------------<br>传输完毕",0
<TITLE> New Document </TITLE>
ret(0)="bmp"
if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
ret(1)=binval2(ADOS.Read(2))
'R_Write imgUp.filename,1
defaultName=imgName
ADOS.Read(15)
if inum=0 then response.end
dim inum:inum=num
set imgUp=new BoxInfoImg
'imgUp.imgSize '大小
case else:
'imgUp.extName '扩展名"
SaveName=iSaveName
End Function
newwin.opener = null
tempStr=split(GetStrUrl,"https://www.xp.cn/")
chkInfo="<li>"+"传输图像数据不存在,请确定你的URL是否正确"
var newwin=window.open('','','');
next
复制代码 代码如下:
'imgUp.SaveMode '保存后url"if SaveName="" then SaveName=defaultName
imgName=preName&"."&ret(0)
case "4E5089":
end if
imgType="unknow"
end if
'属性:
exit function
if right(SavePath,1)<>"https://www.xp.cn/" then SavePath=SavePath&"https://www.xp.cn/"
imgType=".unknow" then exit function end if
fdata=GetWebData(GetStrUrl) '取得XmlHttp数据
} */
SUB tform()
dim ret:ret = ""
</SCRIPT>
dim chkInfo
if iSaveMode="2" then
dim ret:ret = 0
Private Function GetWebData(byval StrUrl)
Dim I,Str,clow
<SCRIPT LANGUAGE="JavaScript">
exit function
R_write " 格式:"&imgUp.imgType,1
r_write "无效",1
if GetStrUrl<>"" then
'传输类的使用方法
bFlag=ADOS.read(3)
<br>保存文件名为空则使用自动识别取得的文件名
call tform()
'写文本对象读取图像长宽和类型
'imgUp.width '宽
preName=left(fileName,inStrRev(fileName,".")-1)
Private Function BinVal(bin)
imgSize=0
imgSize=0 or _
%>
if imgUp.width=0 or imgUp.height=0 or imgUp.imgSize=0 then
ADOS.Position=0
<META CONTENT="">
call tform()
Sub R_write(str,num)
相关热词: 服务器
本站内容来源于网络,如有侵权请与我们联系,我们会及时删除,我们深感抱歉!
注:本站所有信息仅供用于网络技术学习参考,学习中请遵循相关法律法规!
本文地址: https://v30.fanwenzhu.com/server/yun/6843.shtml
相关文章
热门TAG
win10 ecshop 主机 阿里云 解决 配置 C# C++ 解析 SQL语句 命令 Go语言 方法 CSS3 HTML5 CSS win7 MSSQL 服务器配置 IIS7.5 IIS7 IIS6 IIS CentOS 7 Linux oracle数据库 oracle phpcms discuz discuz教程最新文章
-
租用云服务器后的备案问
时间:2021-01-05
-
百度云服务器bcc有什么优
时间:2021-01-05
-
什么是云服务器cvm?怎么
时间:2021-01-05
-
云服务器怎么保证信息安
时间:2021-01-05
-
云服务器怎么预防被攻击
时间:2021-01-05
-
阿里云ECS实例设置用户r
时间:2020-12-29
-
阿里云ECS服务器入门使用
时间:2020-12-29
-
怎么配置云服务器
时间:2020-12-28
热门文章
-
租用云服务器后的备案问题你真的了解吗
时间:2021-01-05
-
选择美国云服务器需要关注什么?
时间:2020-12-27
-
阿里云服务器怎么买?阿里云服务器购买
时间:2020-12-25
-
运维必须知道的关于云服务器的十个问题
时间:2020-12-24
-
如何快速搭建一个阿里云服务器
时间:2020-12-24
-
什么是云?什么是云服务?什么是云主机
时间:2020-12-25
-
云服务器网站承载量一般有多大?一个云
时间:2020-12-28
-
浅谈云服务器和独立服务器的八大差异
时间:2020-12-24
-
SugarHosts云服务器如何开启访问端口和使用
时间:2020-12-24
-
云服务器是什么,云主机干什么用的?
时间:2020-12-28
