步步高i6短信备份提取合并脚本

步高i6手机，有备份短信（收信箱）的功能。

脚本作用是：

把所有备份短信文件中，某一个人的所有短信提取合并到一个备份文件。

操作方法是：

放到备份短信的目录，把所有要处理的文件拖上脚本图标。

'---------------------------------------------------------------------------------Dim Sender, Dest, DestSubSender = "XXX" '通讯录名或手机号Dest = "备份0429-0517.txt" '目标名DestSub = "TEMP" '目录名'---------------------------------------------------------------------------------Dim CmdLn, iCmdLn, iPos, ArgDim fso, fileSource, fileDest, filePath, srcPath, f, fileBuf, fdest, bufArrSet CmdLn = WScript.Arguments'If CmdLn.Count = 0 Then EndIf CmdLn.Count > 0 Then iCmdLn = CmdLn.Count'MsgBox "Deal " & iCmdLn & "."bufArr = SortFilesSet fso = CreateObject("Scripting.FileSystemObject")For iPos = 0 To iCmdLn - 1Arg = bufArr(iPos)fileSource = fso.GetFileName(Arg)srcPath = Replace(Arg, "/" & fileSource, "")filePath = srcPath & "/" & DestSubfileDest = Destfdest = filepath & "/" & fileSourcefdest = filePath & "/" & fileDest'Check temp pathIf fso.FileExists(filePath) Then fso.DeleteFile(filePath)If Not fso.FolderExists(filePath) Then fso.CreateFolder(filePath)fileBuf = ReadUCS(Arg)If Not fso.FileExists(fdest) Then If fso.FolderExists(fdest) Then fso.DeleteFolder(fdest)If Not fso.FileExists(fdest) Then fso.CreateTextFile(fdest)End ifSet f = fso.OpenTextFile(fdest, 8, 0)f.Write Lf2CrLf(ClearOther(fileBuf))f.CloseNextMsgBox "Deal completed."End IfFunction SortFiles()Dim ic, fa, i, j, bufDate, bufFile, fso, bufRetREM Dim msg REM msg = ""ic = WScript.Arguments.Count - 1Redim fileArr(ic)ReDim fileDate(ic)Redim bufRet(ic)Set fso = CreateObject("Scripting.FileSystemObject")For i = 0 To icfileArr(i) = WScript.Arguments(i)Set fa = fso.GetFile(fileArr(i))'fileDate(i) = fa.DateCreatedfileDate(i) = fa.DateLastModifiedNext REM For i = 0 To icREM msg = msg & fileDate(i) & vbCrlfREM Next REM msg = msg & vbCrlfFor i = 0 To icFor j = 0 To ic - 1If DateDiff("d", fileDate(j), fileDate(j+1)) < 0 ThenbufDate = fileDate(j+1)bufFile = fileArr(j+1)fileDate(j+1) = fileDate(j)fileArr(j+1) = fileArr(j)fileDate(j) = bufDatefileArr(j) = bufFileEnd If Next NextREM For i = 0 To icREM msg = msg & fileDate(i) & vbCrlfREM Next REM MsgBox msgSortFiles = fileArrEnd FunctionFunction ClearOther(StrTemp)Dim retStr, regEx, mat, matsretStr = ""Set regEx = New RegExpregEx.Pattern = "(From: /n" & Sender & "(?:/n[^/n]+){3,4}/n/n)"regEx.Ignorecase = TrueregEx.Global = TrueSet mats = regEx.Execute(StrTemp)For each mat In matsretStr = mat & retStrNext ClearOther = retStrEnd FunctionFunction Lf2CrLf(StrTemp)Lf2CrLf = Replace(StrTemp, vbLf, vbCrlf)End FunctionFunction ReadUCS(fileName)Dim Str, stm, bsSet stm = CreateObject("Adodb.Stream")stm.Type = 2stm.Charset = "UTF-16LE"stm.Openstm.loadfromfile fileNameStr = stm.ReadTextstm.Closeset stm = NothingReadUCS = StrEnd Function