<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Option Explicit%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http:///TR/xhtml1/DTD/">
<html xmlns="http:///1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>JSBin</title>
</head>
<body>
<%
'==================================================
'Category: Stream
'==================================================
Const adTypeBinary = 1
Const adLongVarBinary = 205
Const adSaveCreateOverWrite = 2
Class Stream
Dim bytBuffer
Dim lngSize
Dim lngOffset
'==================================================
' Method: Load
' Description: Loading data stream from file
'==================================================
Public Function Load(Path)
Dim objADOStream
Dim binData
Dim i
Set objADOStream = ("")
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
'
' Read data
'
For i = 0 To lngSize
bytBuffer(i) = AscB(MidB(binData, i + 1, 1))
Next
lngSize = lngSize + 1
End Function
'==================================================
' Method: Save
'==================================================
Public Function Save(Path)
Dim objADOStream
Dim objRS
Dim i
Dim binData
Set objADOStream = ("")
Set objRS = ("")
'
'ASP can only handle binary
'
For i = 0 To lngSize - 1
binData = binData & ChrB(bytBuffer(i))
Next
With objRS
. "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
'==================================================
' Method: Seek
' Description: Positioning the current position of the byte stream
'==================================================
Public Function Seek(pos)
lngOffset = pos
End Function
'==================================================
' Method: Read
'==================================================
Public Function ReadByte()
ReadByte = bytBuffer(lngOffset)
lngOffset = lngOffset + 1
End Function
'==================================================
' Method: WriteUInt
'==================================================
Public Function WriteUInt(Code)
bytBuffer(lngOffset) = CByte(Code Mod 256)
bytBuffer(lngOffset + 1) = CByte(Code \ 256)
lngOffset = lngOffset + 2
End Function
'==================================================
' Properties: 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
'==================================================
'Category: Vector
'==================================================
Const DEFAULT_SIZE = 20
Const NUM_INC = 50
Class Vector
Dim arrContainer()
Dim lngSize
Dim lngCount
'==================================================
'Process: Class Construct
'==================================================
Private Sub Class_Initialize()
lngCount = 0
lngSize = DEFAULT_SIZE
ReDim arrContainer(DEFAULT_SIZE - 1)
End Sub
Private Sub Class_Terminate()
End Sub
'==================================================
' Properties: 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
'==================================================
' Properties: Item
'==================================================
Public Property Get Item(id)
Item = arrContainer(id)
End Property
'==================================================
' Properties: Count
'==================================================
Public Property Get Count()
Count = lngCount
End Property
End Class
'==================================================
' Function: JSBin
' Description: Convert the formulated file to a JS-compatible binary file
' 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
'
' Create script byte stream object
'
Set objStream = New Stream
Set vctKey = New Vector
Set vctZero = New Vector
'
' Load the file
'
FileIn
lngFileLen =
lngSize = (lngFileLen - 1) \ 2
'
' Convert a byte stream to an integer array
'
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
'
' Counter cleared
'
Table(0) = USHRT_MAX
For i = 1 To USHRT_MAX - 1
Table(i) = 0
Next
'
'Calculate the number of times each Unicode character appears (except \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
'
' Look for Unicode with the least number of occurrences
'
intKeyNum = USHRT_MAX
For i = 0 To USHRT_MAX - 1
intVal = Table(i)
If intVal < intKeyNum Then
intKeyNum = intVal
intKeyVal = i
End If
'
' Found characters that have never appeared before and are completed directly
'
If intKeyNum = 0 Then
Exit For
End If
Next
'
' Find and record the locations of all intKeyVals in an integer array
'
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
'
' Replace 0 in the integer array with intKeyVal
'
With vctZero
For i = 0 To .Count - 1
intBuffer(.Item(i)) = intKeyVal
Next
End With
Dim pos
'
' Generate the target file
'
With objStream
.Size = 6 + intKeyNum * 4 + (lngSize + 1) * 2
.Seek 0
.WriteUInt 65279
.WriteUInt intKeyVal
.WriteUInt intKeyNum + 1 �
For i = 0 To intKeyNum - 1 'Record the occurrence location of each minimum value
pos = (i)
WriteUInt (pos MOD 65535) + 1 '(avoid 0)
WriteUInt (pos \ 65535) + 1 '(avoid 0)
Next
For i = 0 To lngSize
.WriteUInt intBuffer(i)
Next
'
'Save data to file
'
.Save FileOut
"Conversion is completed!<br>Save to " & FileOut & "<br>Source file: " & lngFileLen & "Byte.<br>After conversion: " & .Size & "Byte."
End With
Set objStream = Nothing
Set vctZero = Nothing
Set vctKey = Nothing
End Function
Sub Main()
Dim strFile
Dim strFileIn
Dim strFileOut
strFile = ("path")
strFileIn = (strFile)
strFileOut = (strFile & ".txt")
JSBin strFileIn, strFileOut
End Sub
Main
%>
</body>
</html>