用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!"