more

这是我以前写的一个还原铃声的代码,可以借鉴一下:

Option Explicit

'把保存为 TXT 的文件恢复为原文件
Dim arrBit(), arrChr, objFso, objFile, objADODB, lngCnt, strFile, i
Dim blnStart, strTmp

blnStart = False
lngCnt = 0

Set objFso = CreateObject("Scripting.FileSystemObject")
strFile = objFso.GetSpecialFolder(2) & "\不要用我的爱来伤害我.mp3"	'文件还原到"临时文件夹"

'如果已经存在指定文件(非第一次运行此脚本)则直接调用播放的过程
If objFso.FileExists(strFile) Then
	Call PlaySong(strFile)
	Set objFso = Nothing
	WScript.Quit
End If

Set objFile = objFso.OpenTextFile(WScript.ScriptFullName, 1, False)
Set objADODB = CreateObject("ADODB.Stream")

'把文件内容赋值给数组
Do Until objFile.AtEndOfStream
	If blnStart = True Then
		ReDim Preserve arrBit(lngCnt)
		strTmp = objFile.ReadLine
		arrBit(lngCnt) = Right(strTmp, Len(strTmp) - 1)
		lngCnt = lngCnt + 1
	Else
		If objFile.ReadLine = "'不要用我的爱来伤害我.mp3" Then blnStart = True
	End If
Loop
objFile.Close
Set objFile = Nothing

'还原文件
lngCnt = lngCnt - 1
ReDim arrChr(lngCnt \ 2)
For i = 0 To lngCnt - 1 Step 2
	arrChr(i \ 2) = ChrW(arrBit(i + 1) * 256 + arrBit(i))
Next
If i = lngCnt Then arrChr(i \ 2) = ChrW(arrBit(i))
arrChr = Join(arrChr, "")
objADODB.Type = 1
objADODB.Open
With CreateObject("ADODB.Stream")
	.Type = 2
	.Open
	.Writetext arrChr
	.Position =  2
	.Copyto objADODB
	.Close
End With
objADODB.SaveToFile strFile, 2
objADODB.Close
Set objADODB = Nothing
Set objFso = Nothing

Call PlaySong(strFile)

Sub PlaySong(strMusic)
	Dim i
	For i = 0 To 2	'播放三次
		With CreateObject("WMPlayer.ocx")
			.url = strMusic
			.controls.play
			Do Until .playstate = 1
				WScript.Sleep 500
			Loop
		End With
	Next
End Sub

'不要用我的爱来伤害我.mp3
'255
'250
'179
复制代码

'由于 2M 的铃声文件(txt后缀)提示文件过大而无法上传,遗憾

'分隔符#######################
'这个函数可以把文件以二进制分解后存储为 txt 后缀

Sub Backup(srcFile)
    Dim objADODB, objFso, objFl, i, arrBit(0)
    Set objADODB = CreateObject("ADODB.Stream")
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFl = objFso.OpenTextFile(srcFile & "_Back.txt", 2, True)
    With objADODB
        .Open
        .Type = 1    'adTypeBinary = 1
        .LoadFromFile srcFile
        For i = 0 To .Size - 1
            arrBit(0) = AscB(.Read(1))
            objFl.WriteLine arrBit(0)
        Next
        .Close
    End With
    Set objADODB = Nothing
    objFl.Close
    Set objFl = Nothing
    Set objFso = Nothing
End Sub
复制代码