JS幻想 读取二进制文件
更新时间：2009年04月20日 15:25:34 作者：
如果说让JavaScript读取站点上一文本文件,那不过是个再简单不了的事了；但若说要换成一个二进制的文件，并且是完全静态的读取,那似乎有点天方夜谭了。
编码程序虽不复杂，不过也不是几句就能搞定的，为方面这里给个ASP版本的（运行效率非常低，不过处理小文件还是很快的）。JavaScript的解码程序倒是非常的简短，放在Demo.html里一起贴出了。
JSBin.asp:
复制代码 代码如下:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Option Explicit%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>JSBin</title>
</head>
<body>
<%
'==================================================
' 类: Stream
'==================================================
Const adTypeBinary = 1
Const adLongVarBinary = 205
Const adSaveCreateOverWrite = 2
Class Stream
Dim bytBuffer
Dim lngSize
Dim lngOffset
'==================================================
' 方法: Load
' 说明: 从文件载入数据流
'==================================================
Public Function Load(Path)
Dim objADOStream
Dim binData
Dim i
Set objADOStream = Server.CreateObject("ADODB.Stream")
With objADOStream
.Type = adTypeBinary
.Open
End With
With objADOStream
.LoadFromFile Path
binData = .Read
.Close
End With
Set objADOStream = Nothing
lngSize = Ubound(binData)
ReDim bytBuffer(lngSize)
lngOffset = 0
'
' 读取数据
'
For i = 0 To lngSize
bytBuffer(i) = AscB(MidB(binData, i + 1, 1))
Next
lngSize = lngSize + 1
End Function
'==================================================
' 方法: Save
'==================================================
Public Function Save(Path)
Dim objADOStream
Dim objRS
Dim i
Dim binData
Set objADOStream = Server.CreateObject("ADODB.Stream")
Set objRS = Server.CreateObject("ADODB.Recordset")
'
' ASP处理二进制只能如此
'
For i = 0 To lngSize - 1
binData = binData & ChrB(bytBuffer(i))
Next
With objRS
.Fields.Append "t", adLongVarBinary, lngSize
.Open
.AddNew
.Fields("t").AppendChunk binData
.Update
binData = .Fields("t").GetChunk(lngSize)
End With
With objADOStream
.Type = adTypeBinary
.Open
.Write binData
.SaveToFile Path, adSaveCreateOverWrite
.Close
End With
Set objADOStream = Nothing
Set objRS = Nothing
End Function
'==================================================
' 方法: Seek
' 说明: 定位字节流当前位置
'==================================================
Public Function Seek(pos)
lngOffset = pos
End Function
'==================================================
' 方法: Read
'==================================================
Public Function ReadByte()
ReadByte = bytBuffer(lngOffset)
lngOffset = lngOffset + 1
End Function
'==================================================
' 方法: WriteUInt
'==================================================
Public Function WriteUInt(Code)
bytBuffer(lngOffset) = CByte(Code Mod 256)
bytBuffer(lngOffset + 1) = CByte(Code \ 256)
lngOffset = lngOffset + 2
End Function
'==================================================
' 属性: Size
'==================================================
Public Property Get Size()
Size = lngSize
End Property
Public Property Let Size(value)
lngSize = value
ReDim Preserve bytBuffer(lngSize - 1)
End Property
End Class
'==================================================
' 类: Vector
'==================================================
Const DEFAULT_SIZE = 20
Const NUM_INC = 50
Class Vector
Dim arrContainer()
Dim lngSize
Dim lngCount
'==================================================
' 过程: 类构造
'==================================================
Private Sub Class_Initialize()
lngCount = 0
lngSize = DEFAULT_SIZE
ReDim arrContainer(DEFAULT_SIZE - 1)
End Sub
Private Sub Class_Terminate()
End Sub
'==================================================
' 属性: Add
'==================================================
Public Function Add(value)
If lngCount = lngSize Then
lngSize = lngSize + NUM_INC
ReDim Preserve arrContainer(lngSize)
End If
arrContainer(lngCount) = value
lngCount = lngCount + 1
End Function
'==================================================
' 属性: Item
'==================================================
Public Property Get Item(id)
Item = arrContainer(id)
End Property
'==================================================
' 属性: Count
'==================================================
Public Property Get Count()
Count = lngCount
End Property
End Class
'==================================================
' 函数: JSBin
' 说明: 将制定的文件转换为JS兼容的二进制文件
' EtherDream 08/06/10
'==================================================
Function JSBin(FileIn, FileOut)
Const USHRT_MAX = 65536
Dim objStream
Dim lngFileLen
Dim lngSize
Dim intBuffer()
Dim Table(65535)
Dim intVal
Dim vctKey
Dim vctZero
Dim intKeyNum
Dim intKeyVal
Dim i
'
' 建立脚本字节流对象
'
Set objStream = New Stream
Set vctKey = New Vector
Set vctZero = New Vector
'
' 载入文件
'
objStream.Load FileIn
lngFileLen = objStream.Size
lngSize = (lngFileLen - 1) \ 2
'
' 将字节流转换为整型数组
'
ReDim intBuffer(lngSize)
On Error Resume Next
With objStream
For i = 0 To lngSize
intVal = .ReadByte()
intVal = intVal + .ReadByte() * 256
intBuffer(i) = intVal
Next
End With
On Error Goto 0
'
' 计数器清零
'
Table(0) = USHRT_MAX
For i = 1 To USHRT_MAX - 1
Table(i) = 0
Next
'
' 统计每个Unicode字符出现的次数(\0\0除外)
'
With vctZero
For i = 0 To lngSize
intVal = intBuffer(i)
If intVal = 0 Then
.Add i
Else
Table(intVal) = Table(intVal) + 1
End If
Next
End With
'
' 寻找出现次数最少的Unicode
'
intKeyNum = USHRT_MAX
For i = 0 To USHRT_MAX - 1
intVal = Table(i)
If intVal < intKeyNum Then
intKeyNum = intVal
intKeyVal = i
End If
'
' 发现从未出现过的字符直接完成
'
If intKeyNum = 0 Then
Exit For
End If
Next
'
' 寻找并记录整型数组中所有intKeyVal的位置
'
If intKeyNum > 0 Then
With vctKey
For i = 0 To lngSize
If intBuffer(i) = intKeyVal Then
.Add i
End If
Next
End With
End If
'
' 将整型数组中的0替换为intKeyVal
'
With vctZero
For i = 0 To .Count - 1
intBuffer(.Item(i)) = intKeyVal
Next
End With
Dim pos
'
' 生成目标文件
'
With objStream
.Size = 6 + intKeyNum * 4 + (lngSize + 1) * 2
.Seek 0
.WriteUInt 65279 'Unicode文件头 0xFEFF
.WriteUInt intKeyVal '出现最少的Unicode值 (0已排除)
.WriteUInt intKeyNum + 1 '出现最少的Unicode次数 (避免0)
For i = 0 To intKeyNum - 1 '记录每个最少值的出现位置
pos = vctKey.Item(i)
.WriteUInt (pos MOD 65535) + 1 '(避免0)
.WriteUInt (pos \ 65535) + 1 '(避免0)
Next
For i = 0 To lngSize
.WriteUInt intBuffer(i)
Next
'
' 保存数据至文件
'
.Save FileOut
Response.Write "转换完成!<br>保存至 " & FileOut & "<br>源文件: " & lngFileLen & "字节.<br>转换后: " & .Size & "字节."
End With
Set objStream = Nothing
Set vctZero = Nothing
Set vctKey = Nothing
End Function
Sub Main()
Dim strFile
Dim strFileIn
Dim strFileOut
strFile = Request.QueryString("path")
strFileIn = Server.MapPath(strFile)
strFileOut = Server.MapPath(strFile & ".txt")
JSBin strFileIn, strFileOut
End Sub
Main
%>
</body>
</html>
使用时加上path参数即可对指定的文件编码,比如JSBin.asp?path=123.rar,就会对123.rar编码,并生成123.rar.txt的文件.
客户端的可以在我的空间上预览:
http://www.etherdream.com/FunnyScript/JSBin/JSBinDemo.html
可以在里面输入 JSBin.rar.txt,123.jpg.txt,jsmin.exe.txt即对相应的编码文件加载,所显示的内容与编码前的文件一模一样.对一个二进制的文件仅仅做了几个字节的修改,就能让JavaScript读取,不是很有趣吗?
相关文章
Ajax Blog 用到的几个函数...2006-10-10
javascript连接mysql与php通过odbc连接任意数据库的实例
下面小编就为大家分享一篇javascript连接mysql与php通过odbc连接任意数据库的实例，具有很好的参考价值，希望对大家有所帮助。一起跟随小编过来看看吧2017-12-12
相信大家都知道网上关于Javascript中数组去重的方法很多，这篇文章给大家总结Javascript中数组各种去重的方法，相信本文对大家学习和使用Javascript具有一定的参考借鉴价值，有需要的下面来一起看看。2016-10-10
这篇文章主要介绍了JavaScript图像放大镜效果实现方法详解,文中通过示例代码介绍的非常详细，对大家的学习或者工作具有一定的参考学习价值,需要的朋友可以参考下2020-06-06
这篇文章主要介绍了BootstrapValidator超详细教程(推荐)的相关资料,非常不错，具有参考借鉴价值，需要的朋友可以参考下2016-12-12
有时在显示某段文字的时候，可能会太长，影响我们页面的显示效果。如果仅是英文，那么我们可以用String.substring(start, end)函数就已经够用了。但是通常我们都会遇到既有英文，又有汉字的情况。而汉字是占用2个字节的，如果用String.substring(start, end)截取字符串的话，会发现汉字截取后比英文截取后个数虽然相同，但是长度还是长出去不少（具体要视字符个数来决定）2013-04-04
这篇文章主要介绍了javascript关于运动的各种问题,实例总结了javascript关于滚动的常见错误、实现方法与相关注意事项,非常具有实用价值,需要的朋友可以参考下2015-04-04
Javascript iframe交互并兼容各种浏览器的解决方法
这篇文章主要介绍了Javascript iframe交互并兼容各种浏览器的解决方法的相关资料,非常不错，具有参考借鉴价值，需要的朋友可以参考下2016-07-07
这篇文章主要为大家详细介绍了JavaScript队列、优先队列与循环队列的相关资料,具有一定的参考价值，感兴趣的小伙伴们可以参考一下2016-11-11
本篇文章主要介绍了Webpack path与publicPath的区别详解，小编觉得挺不错的，现在分享给大家，也给大家做个参考。一起跟随小编过来看看吧2018-05-05
最新评论