📄 stdlib.asp
字号:
IsNumericArray = False
If Not IsArray(arr) Then Exit Function
If Ubound(arr) < 0 Then Exit Function
For Each ptr In arr
If Not IsNumeric(ptr) Then Exit Function
Next
IsNumericArray = True
End Function
'--------------------------------------------------------------------
' ArrayCopy - 拷贝数组中指定位置的数组
' - 返回类型：Array
' - arguments[0] = 数组(type: Array)
' - arguments[1] = 起始位置(type: Long)
' - arguments[1] = 结束位置(type: Long)
'--------------------------------------------------------------------
Public Function ArrayCopy(arr, ByVal pos1, ByVal pos2)
Dim ret, i
If pos2 = -1 Then pos2 = UBound(arr)
ReDim ret(pos2 - pos1)
For i = pos1 To pos2
ret(i - pos1) = arr(i)
Next
ArrayCopy = ret
End Function
'--------------------------------------------------------------------
' BaseX - 将一个整数转换为指定进制的字符串，2-32进制
' - 返回类型：String
' - arguments[0] = 整数(type: Long)
' - arguments[1] = 整数(type: Integer)
'--------------------------------------------------------------------
Public Function BaseX(ByVal n, ByVal x)
Dim s, i
If n > 0 Then
s = s & BaseX(n \ x, x)
i = n Mod x
If i < 10 Then
s = s & i
Else
s = s & Chr(i + 55)
End If
End If
BaseX = s
End Function
'--------------------------------------------------------------------
' ConvertX - 将一个字符串转换为指定进制的整数，2-32进制
' - 返回类型：Long
' - arguments[0] = 字符串(type: String)
' - arguments[1] = 整数(type: Integer)
'--------------------------------------------------------------------
Public Function ConvertX(ByVal s, ByVal x)
Dim i
Dim n, p, t
n = 0
p = 1
For i = Len(s) To 1 Step -1
t = AscW(Mid(s, i, 1))
If t >= 48 And t <= 57 Then
t = t - 48
ElseIf t >= 65 And t <= 90 And t < 55 + x Then
t = t - 55
ElseIf t >= 97 And t <= 122 And t < 87 + x Then
t = t - 87
Else
Err.Raise vbObjectError + 1, "ConvertX", "错误的进制字符串"
End If
n = n + (t * p)
p = p * x
Next
ConvertX = n
End Function
'--------------------------------------------------------------------
' BToKB - 字节长度转KB长度，保留小数点后2位
' - 返回类型：Double
' - arguments[0] = 字节长度(type: Long)
'--------------------------------------------------------------------
Public Function BToKB(ByVal lValue)
BToKB = FormatNumber(lValue / KBYTE, 2, True)
End Function
'--------------------------------------------------------------------
' BToMB - 字节长度转MB长度，保留小数点后2位
' - 返回类型：Double
' - arguments[0] = 字节长度(type: Long)
'--------------------------------------------------------------------
Public Function BToMB(ByVal lValue)
BToMB = FormatNumber(lValue / MBYTE, 2, True)
End Function
'--------------------------------------------------------------------
' BToGB - 字节长度转GB长度，保留小数点后2位
' - 返回类型：Double
' - arguments[0] = 字节长度(type: Long)
'--------------------------------------------------------------------
Public Function BToGB(ByVal lValue)
BToGB = FormatNumber(lValue / GBYTE, 2, True)
End Function
Public Function HashEncode(ByVal strData, ByVal strFlag)
Dim ret
ret = strData
ret = Replace(ret, "$", "$1;")
ret = Replace(ret, strFlag, "$2;")
HashEncode = ret
End Function
Public Function HashDecode(ByVal strData, ByVal strFlag)
Dim ret
ret = strData
ret = Replace(ret, "$2;", strFlag)
ret = Replace(ret, "$1;", "$")
HashDecode = ret
End Function
Public Function HashString(objHash, ByVal strFlag)
Dim keys, itms
Dim ret, i
keys = objHash.Keys
itms = objHash.Items
ReDim ret(UBound(keys))
For i = 0 To UBound(keys)
ret(i) = keys(i) & "=" & HashEncode(itms(i), strFlag)
Next
HashString = Join(ret, strFlag)
Erase ret
End Function
Public Sub HashAdd(objHash, ByVal strData, ByVal strFlag)
Dim arr, ptr, tmp
arr = Split(strData, strFlag)
For Each ptr In arr
tmp = Split(ptr, "=", 2)
If UBound(tmp) = 1 Then
objHash(tmp(0)) = HashDecode(tmp(1), strFlag)
End If
Next
End Sub
Public Function GetFileInfo(ByVal strPath)
GetFileInfo = GetFileInfo2(GetFileBinary(strPath))
End Function
Public Function GetFileInfo2(vtData)
Dim arr, ret(2)
Dim arr1, arr2(3)
Dim i, k, j, lngSize
arr = BytesToArray2(vtData, 1, 24)
ret(1) = 0
ret(2) = 0
If arr(0) = &H4D And arr(1) = &H5A Then
ret(0) = "exe"
ElseIf arr(0) = &H42 And arr(1) = &H4D Then
ret(0) = "bmp"
ret(1) = LShift(arr(19), 8) Or arr(18)
ret(2) = LShift(arr(23), 8) Or arr(22)
ElseIf arr(0) = &HFF And (arr(1) = &HFA Or arr(1) = &HFB) Then
ret(0) = "mp3"
ElseIf arr(0) = &H52 And arr(1) = &H61 And arr(2) = &H72 Then
ret(0) = "rar"
ElseIf arr(0) = &H47 And arr(1) = &H49 And arr(2) = &H46 Then
ret(0) = "gif"
ret(1) = LShift(arr(7), 8) Or arr(6)
ret(2) = LShift(arr(9), 8) Or arr(8)
ElseIf arr(0) = &H46 And arr(1) = &H57 And arr(2) = &H53 Then'FWS
ret(0) = "swf"
arr1 = ArrayCopy(arr, 9, 17)
Select Case arr(8)
case &H50
arr2(0) = RShift(arr1(0), 4)
arr2(1) = arr1(0) And &HF
arr2(2) = RShift(arr1(1), 4)
arr2(3) = arr1(1) And &HF
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = arr1(2) And &HF
arr2(1) = RShift(arr1(3), 4)
arr2(2) = arr1(3) And &HF
arr2(3) = RShift(arr1(4), 4)
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 10
ret(2) = ret(2) \ 10
case &H58
arr2(0) = arr1(0) And &HF
arr2(1) = RShift(arr1(1), 4)
arr2(2) = arr1(1) And &HF
arr2(3) = RShift(arr1(2), 4)
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = RShift(arr1(3), 4)
arr2(1) = arr1(3) And &HF
arr2(2) = RShift(arr1(4), 4)
arr2(3) = arr1(4) And &HF
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 40
ret(2) = ret(2) \ 10
case &H60
arr2(0) = arr1(0) And &HF
arr2(1) = RShift(arr1(1), 4)
arr2(2) = arr1(1) And &HF
arr2(3) = RShift(arr1(2), 4)
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = arr1(3) And &HF
arr2(1) = RShift(arr1(4), 4)
arr2(2) = arr1(4) And &HF
arr2(3) = RShift(arr1(5), 4)
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 10
ret(2) = ret(2) \ 10
case &H68
arr2(0) = RShift(arr1(1), 4)
arr2(1) = arr1(1) And &HF
arr2(2) = RShift(arr1(2), 4)
arr2(3) = arr1(2) And &HF
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = RShift(arr1(4), 4)
arr2(1) = arr1(4) And &HF
arr2(2) = RShift(arr1(5), 4)
arr2(3) = arr1(5) And &HF
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 40
ret(2) = ret(2) \ 10
case &H70
arr2(0) = RShift(arr1(1), 4)
arr2(1) = arr1(1) And &HF
arr2(2) = RShift(arr1(2), 4)
arr2(3) = arr1(2) And &HF
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = arr1(4) And &HF
arr2(1) = RShift(arr1(5), 4)
arr2(2) = arr1(5) And &HF
arr2(3) = RShift(arr1(6), 4)
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 10
ret(2) = ret(2) \ 10
case &H78
arr2(0) = arr1(1) And &HF
arr2(1) = RShift(arr1(2), 4)
arr2(2) = arr1(2) And &HF
arr2(3) = RShift(arr1(3), 4)
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = RShift(arr1(5), 4)
arr2(1) = arr1(5) And &HF
arr2(2) = RShift(arr1(6), 4)
arr2(3) = arr1(6) And &HF
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 40
ret(2) = ret(2) \ 10
case &H80
arr2(0) = arr1(1) And &HF
arr2(1) = RShift(arr1(2), 4)
arr2(2) = arr1(2) And &HF
arr2(3) = RShift(arr1(3), 4)
ret(1) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
arr2(0) = arr1(5) And &HF
arr2(1) = RShift(arr1(6), 4)
arr2(2) = arr1(6) And &HF
arr2(3) = RShift(arr1(7), 4)
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 10
ret(2) = ret(2) \ 10
case &H88
arr2(0) = RShift(arr1(1), 4)
arr2(1) = arr1(1) And &HF
arr2(2) = RShift(arr1(2), 4)
arr2(3) = arr1(2) And &HF
arr2(4) = RShift(arr1(3), 4)
arr2(5) = arr1(3) And &HF
ret(1) = LShift(arr2(0), 20) Or LShift(arr2(1), 16) Or LShift(arr2(2), 12) Or LShift(arr2(3), 8) Or LShift(arr2(4), 4) Or arr2(5)
arr2(0) = RShift(arr1(6), 4)
arr2(1) = arr1(6) And &HF
arr2(2) = RShift(arr1(7), 4)
arr2(3) = arr1(7) And &HF
ret(2) = LShift(arr2(0), 12) Or LShift(arr2(1), 8) Or LShift(arr2(2), 4) Or arr2(3)
ret(1) = ret(1) \ 40
ret(2) = ret(2) \ 10
End Select
ElseIf arr(0) = &H43 And arr(1) = &H57 And arr(2) = &H53 Then'CWS
ret(0) = "swf"
ElseIf arr(1) = &H50 And arr(2) = &H4E And arr(3) = &H47 Then
ret(0) = "png"
ret(1) = LShift(arr(18), 8) Or arr(19)
ret(2) = LShift(arr(22), 8) Or arr(23)
ElseIf arr(1) = &H50 And arr(2) = &H44 And arr(3) = &H46 Then
ret(0) = "pdf"
ElseIf arr(0) = &H52 And arr(2) = &H49 And arr(3) = &H46 And arr(4) = &H46 Then
If arr(8) = &H41 And arr(9) = &H56 And arr(10) = &H49 Then
ret(0) = "avi"
ElseIf arr(8) = &H57 And arr(9) = &H41 And arr(10) = &H56 And arr(11) = &H45 Then
ret(0) = "wav"
End If
ElseIf arr(0) = &H2E And arr(1) = &H52 And arr(2) = &H4D And arr(3) = &H46 Then
ret(0) = "rm"
ElseIf arr(0) = &H49 And arr(1) = &H54 And arr(2) = &H53 And arr(3) = &H46 Then
ret(0) = "chm"
ElseIf (arr(6) = &H4A And arr(7) = &H46 And arr(8) = &H49 And arr(9) = &H46) Or (arr(6) = &H45 And arr(7) = &H78 And arr(8) = &H69 And arr(9) = &H66) Then
ret(0) = "jpg"
i = 0
k = 0
j = 4
lngSize = LenB(vtData)
Do While j < lngSize
i = AscB(MidB(vtData, j, 1))
j = j + 1
While i = 255
i = AscB(MidB(vtData, j, 1))
j = j + 1
Wend
If j > lngSize Then Exit Do
If i > 191 And i < 196 Then Exit Do
k = htol(MidB(vtData, j, 2))
j = j + k
If j > lngSize Then Exit Do
i = AscB(MidB(vtData, j, 1))
j = j + 1
While i < 255
i = AscB(MidB(vtData, j, 1))
j = j + 1
Wend
Loop
j = j + 3
If j + 4 < lngSize Then
arr = BytesToArray2(vtData, j, j + 3)
ret(2) = LShift(arr(0), 8) Or arr(1)
ret(1) = LShift(arr(2), 8) Or arr(3)
End If
End If
GetFileInfo2 = ret
End Function
Public Function Array2(ByVal lngSize, ByVal vtValue)
Dim ret, i
ReDim ret(lngSize)
For i = 0 To UBound(ret)
ret(i) = vtValue
Next
Array2 = ret
End Function
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -