用VBS读写二进制数据包

今日解Guilty的虜ノ絆发现有新的pna数据包，睇佐下，好在唔难，念落唔知用咩写好，用返系统自身的脚本算了，将以前收集D资料整理下就搞佐旧咁的嘢出来，导出效率都几高。

系任意地方新建个VBS文件，将内容复制入去，再修改第一行的folder变量为你自己相应的文件夹路径，运行一下就搞定。

folder="G:\111111\12313\99999999999\Chip6"

sub splitpna(sFile)

	Set stm = CreateObject("Adodb.Stream")
	stm.Type = 1
	stm.Open
	stm.LoadFromFile sFile

	stm.Position = 16
	strRead = stm.Read

	iHowFiles=Asc(strRead)
	Dim anyFile()
	ReDim anyFile(iHowFiles)

	for iNow = 0 to iHowFiles-1

		stm.Position = 16 + 40 * (iNow + 1)
		strRead = stm.Read(4)

		dim iT, sStr1, sStr2
		for iT = 0 to LenB(strRead)-1
			sStr1 = sprintf( HEX(AscB(MidB(strRead, LenB(strRead)-iT, 1))) , 2)
			sStr2 = sStr2 & sStr1
		next
		strHex = sStr2

		anyFile(iNow)=HEX_to_DEC(strHex)
		sStr1=""
		sStr2=""
		strRead=""
		strHex=""
	next
	
	dim sFullName
	for iNow = 0 to UBound(anyFile)-1
		Set stmw = CreateObject("Adodb.Stream")
		stmw.Type = 1
		stmw.Mode=3
		stmw.Open
		bArry = stm.Read(anyFile(iNow))
		stmw.Write bArry
		sFullName = sFile & "_" & sprintf(iNow, 3) & ".webp"
		stmw.SaveToFile sFullName, 2
		stmw.Flush
		stmw.Close
		sFullName=""
	next
	stm.Close
end sub


Function HEX_to_DEC(byval Hex)
	Hex = UCase(Hex)
	For i = 1 To Len(Hex)
	Select Case Mid(Hex, Len(Hex) - i + 1, 1)
		Case "0": B = B + 16 ^ (i - 1) * 0
		Case "1": B = B + 16 ^ (i - 1) * 1
		Case "2": B = B + 16 ^ (i - 1) * 2
		Case "3": B = B + 16 ^ (i - 1) * 3
		Case "4": B = B + 16 ^ (i - 1) * 4
		Case "5": B = B + 16 ^ (i - 1) * 5
		Case "6": B = B + 16 ^ (i - 1) * 6
		Case "7": B = B + 16 ^ (i - 1) * 7
		Case "8": B = B + 16 ^ (i - 1) * 8
		Case "9": B = B + 16 ^ (i - 1) * 9
		Case "A": B = B + 16 ^ (i - 1) * 10
		Case "B": B = B + 16 ^ (i - 1) * 11
		Case "C": B = B + 16 ^ (i - 1) * 12
		Case "D": B = B + 16 ^ (i - 1) * 13
		Case "E": B = B + 16 ^ (i - 1) * 14
		Case "F": B = B + 16 ^ (i - 1) * 15
	End Select
	Next
	HEX_to_DEC = B
End Function

function sprintf(str,length)
	strf=""
	for i=1 to length-Len(str)
		strf=strf&"0"
	next
	sprintf=strf&str
end function


Function FilesTree(sPath)
	on error resume next
	Set oFso = CreateObject("Scripting.FileSystemObject")
	Set oFolder = oFso.GetFolder(sPath)
	Set oSubFolders = oFolder.SubFolders
	Set oFiles = oFolder.Files
	For Each oFile In oFiles
		'oFile.Delete
		if oFso.GetExtensionName(oFile.Path)="pna" then
			splitpna(oFile.Path)
		end if
	Next
	For Each oSubFolder In oSubFolders
		FilesTree(oSubFolder.Path)
	Next
	Set oFolder = Nothing
	Set oSubFolders = Nothing
	Set oFso = Nothing
End Function

FilesTree(folder)

MsgBox "done!"

100

101

102

103

104

105

106

107

108

109

110

folder="G:\111111\12313\99999999999\Chip6"

sub splitpna(sFile)

Set stm = CreateObject("Adodb.Stream")

stm.Type = 1

stm.Open

stm.LoadFromFile sFile

stm.Position = 16

strRead = stm.Read

iHowFiles=Asc(strRead)

Dim anyFile()

ReDim anyFile(iHowFiles)

for iNow = 0 to iHowFiles-1

stm.Position = 16 + 40 * (iNow + 1)

strRead = stm.Read(4)

dim iT, sStr1, sStr2

for iT = 0 to LenB(strRead)-1

sStr1 = sprintf( HEX(AscB(MidB(strRead, LenB(strRead)-iT, 1))) , 2)

sStr2 = sStr2 & sStr1

strHex = sStr2

anyFile(iNow)=HEX_to_DEC(strHex)

sStr1=""

sStr2=""

strRead=""

strHex=""

dim sFullName

for iNow = 0 to UBound(anyFile)-1

Set stmw = CreateObject("Adodb.Stream")

stmw.Type = 1

stmw.Mode=3

stmw.Open

bArry = stm.Read(anyFile(iNow))

stmw.Write bArry

sFullName = sFile & "_" & sprintf(iNow, 3) & ".webp"

stmw.SaveToFile sFullName, 2

stmw.Flush

stmw.Close

sFullName=""

stm.Close

end sub

Function HEX_to_DEC(byval Hex)

Hex = UCase(Hex)

For i = 1 To Len(Hex)

Select Case Mid(Hex, Len(Hex) - i + 1, 1)

Case "0": B = B + 16 ^ (i - 1) * 0

Case "1": B = B + 16 ^ (i - 1) * 1

Case "2": B = B + 16 ^ (i - 1) * 2

Case "3": B = B + 16 ^ (i - 1) * 3

Case "4": B = B + 16 ^ (i - 1) * 4

Case "5": B = B + 16 ^ (i - 1) * 5

Case "6": B = B + 16 ^ (i - 1) * 6

Case "7": B = B + 16 ^ (i - 1) * 7

Case "8": B = B + 16 ^ (i - 1) * 8

Case "9": B = B + 16 ^ (i - 1) * 9

Case "A": B = B + 16 ^ (i - 1) * 10

Case "B": B = B + 16 ^ (i - 1) * 11

Case "C": B = B + 16 ^ (i - 1) * 12

Case "D": B = B + 16 ^ (i - 1) * 13

Case "E": B = B + 16 ^ (i - 1) * 14

Case "F": B = B + 16 ^ (i - 1) * 15

End Select

HEX_to_DEC = B

End Function

function sprintf(str,length)

strf=""

for i=1 to length-Len(str)

strf=strf&"0"

sprintf=strf&str

end function

Function FilesTree(sPath)

on error resume next

Set oFso = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFso.GetFolder(sPath)

Set oSubFolders = oFolder.SubFolders

Set oFiles = oFolder.Files

For Each oFile In oFiles

'oFile.Delete

if oFso.GetExtensionName(oFile.Path)="pna" then

splitpna(oFile.Path)

end if

For Each oSubFolder In oSubFolders

FilesTree(oSubFolder.Path)

Set oFolder = Nothing

Set oSubFolders = Nothing

Set oFso = Nothing

End Function

FilesTree(folder)

MsgBox "done!"

» 本文作者：ztj
» 本文采用知识共享许可协议 CC BY-NC-SA 3.0 进行许可
» 转载注明出处：乜都讲D

《用VBS读写二进制数据包》有0个评分

0.0 满分5星

★★★★★

★★★★

★★★

★★

★

乜都讲D

ZTJ的从爱尔兰到契丹无人不知，无人不晓的ACG博客~

用VBS读写二进制数据包

《用VBS读写二进制数据包》有0个评分

《用VBS读写二进制数据包》有3个想法

发表回复取消回复

《用VBS读写二进制数据包》有3个想法

发表回复 取消回复

发表回复取消回复