最近工作上遇到了一个需求,以前都是手工去处理,但是我嫌麻烦,所以打算有脚本的方式来处理,但是用bat发现有些功能做不到,然后考虑到了VBS语言。
什么是VBS?
中文名:微软公司可视化BASIC语言-脚本版英文名:Microsoft Visual Basic Script Edition通俗:就是windows自带的比bat可视化一点的脚本。
目前的需求是这样的:
- 现在在有这么一个文本文件(txt)需要把它重命名成zyhg?????001YYYYMMDD.txt,这个日期是当日日期。
- 对zyhg这个文件删除前两行。
- 针对zyhg这个txt文件生成对应格式的flg文件,文件名同zyhg文件。格式具体见下表格。
- 使用rar格式,把同目录中zyhg开头的文件全部打包成压缩包,文件名为zxbsXXXXXYYYYMMDD001.rar。
- 针对rar这个文件,生成对应格式的flg文件,文件名同rar文件。flg文件中记录数就填压缩包中的文件个数。
序号 说明 长度 备注 1 数据文件名称 60 左对齐 2 '|' 1 3 文件大小 16 以字节为单位,左对齐,不足部分补空格 4 '|' 1 5 文件生成日期 8 YYYYMMDD格式 6 '|' 1 7 文件生成时间 6 HHMMSS格式 8 '|' 1 9 记录数 12 左对齐,不足部分补空格 10 '|' 1 11 数据文件校验码 64 MD5校验码,左对齐,不足部分补空格,字母为大写 12 '|' 1 13 预留 64 保留字段 14 换行符 1
这个vbs包含了好多有用的东西,大部分的东西我都做成了函数,如果想学习vbs的话,可以看看这个代码,学习一下,确实蛮有意思的。
View Code VB
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 | REM Author : Laycher REM DATE:2015-11-23 DIM target_dir,hybh,shpbu,today,tomorrow,content,srcFile,srcPath,rarPath DIM zyhgName,zyhgTxtFullName,zyhgFlgFullName,zxbsName,zxbsRarFullName,zxbsFlgFullName DIM fileName,fileDate,fileTime,fileSize,fileRows,fileMD5,fileCount DIM x,s REM ?????对应的值 hybh="00102" REM XXXXX对应的值 shpbu="20801" REM rar的具体路径 rarPath="D:\Program Files\TotalCMD64\Plugins\wcx\Rar\Rar.exe" REM -------------------------------------------------------------以下是程序代码,不需要修改---------------------------------------------------- MsgBox "作者:Laycher"&VbCrlf&VbCrlf&"提示:点击确定后请在后面的文件选择框中选择恒生导出来的txt文件,此程序会删除文件中的前两行,无需手工删除。另外选择的文件目录请不要包含zyhg开头的多余文件。"&VbCrlf&"Tips:脚本执行稍微有点慢,大概15秒左右处理完成",vbInformation,"相关提示" today=year(Now)&Month(Now)&day(Now) tomorrow=DateAdd("d", 1, date) REM 只存在明天是周六的情况 if DatePart("w", tomorrow,"2") ="6" then tomorrow=DateAdd("d", 2, tomorrow) end if tomorrow=DatePart("yyyy",tomorrow) & Right("0" & DatePart("m",tomorrow), 2) & Right("0" & DatePart("d",tomorrow),2) REM 选择要处理的源文件 srcFile=BrowseForFile() If srcFile ="" Then REM 未选择则直接退出 Wscript.Quit End IF REM 获取源文件路径 target_dir=getFilePath(srcFile) REM x=msgbox("文件所在目录为:"&target_dir&VbCrlf&"当日日期是:"&today&VbCrlf&"下一交易日:"&tomorrow&VbCrlf&"rar.exe的路径:"&rarPath&VbCrlf&"?????的值:"&hybh&VbCrlf&"XXXXX的值:"&shpbu&VbCrlf&VbCrlf&"是否正确?"&VbCrlf&"如果不正确请修改脚本中的内容。",4097,"请确认") 'CreateObject("wscript.shell").sendkeys "{enter}" if x=Vbcancel then Wscript.Quit elseif x=VbOk Then REM 先拷贝成要求的txt文件 Set FSO=CreateObject("Scripting.FileSystemObject") REM Set f1=fso.GetFile(target_dir&"\test.txt") zyhgName="zyhg"&hybh&"001"&today zyhgTxtFullName=target_dir&"\"&zyhgName&".txt" zyhgFlgFullName=target_dir&"\"&zyhgName&".flg" zxbsName="zxbs"&shpbu&tomorrow&"001" zxbsRarFullName=target_dir&"\"&zxbsName&".rar" zxbsFlgFullName=target_dir&"\"&zxbsName&".flg" REM 先删除原先的文件 deleteFile(zyhgTxtFullName) deleteFile(zyhgFlgFullName) deleteFile(zxbsRarFullName) deleteFile(zxbsFlgFullName) REM 把源文件拷贝成目标文件 fso.CopyFile srcFile,zyhgTxtFullName,False REM 删除多余的前两行 DeleteLine zyhgTxtFullName,"",1,0 DeleteLine zyhgTxtFullName,"",1,0 REM 拼凑flg文件中的内容 fileSize=getFileSize(zyhgTxtFullName) fileDate=getFileCreateDate(zyhgTxtFullName) fileTime=getFileCreateTime(zyhgTxtFullName) fileRows=getFileRows(zyhgTxtFullName) fileMD5=getFileMD5(zyhgTxtFullName) content=zyhgName&".txt"&space(60-len(zyhgName&".txt"))&"¦"&fileSize&space(16-len(fileSize))&"¦"&fileDate&"¦"&fileTime&"¦"&fileRows&space(12-len(fileRows))&"¦"&fileMD5&space(64-len(fileMD5))&"¦"&Space(64) REM 生成对应的flg文件 createFile zyhgFlgFullName,content REM 创建RAR文件 rarFiles rarPath,zxbsRarFullName,target_dir,"zyhg*" REM 必须要等一下,否则后面执行太快,找不到文件的 WScript.Sleep 1000 '1000毫秒 'MsgBox "压缩完成"&zxbsRarFullName REM 拼凑flg文件中的内容 fileSize=getFileSize(zxbsRarFullName) fileDate=getFileCreateDate(zxbsRarFullName) fileTime=getFileCreateTime(zxbsRarFullName) fileCount=getFileCount(target_dir,"zyhg") fileMD5=getFileMD5(zxbsRarFullName) content=zxbsName&".rar"&space(60-len(zxbsName&".rar"))&"¦"&fileSize&space(16-len(fileSize))&"¦"&fileDate&"¦"&fileTime&"¦"&fileCount&space(12-len(fileCount))&"¦"&fileMD5&space(64-len(fileMD5))&"¦"&Space(64) REM 生成对应的flg文件 createFile zxbsFlgFullName,content MsgBox "文件生成完成,请上传!"&vbCrLf&"路径:"&target_dir,vbInformation,"完成" Else Wscript.Quit end if REM 退出 Wscript.Quit REM --------------------------------------------------------以下是调用的函数------------------------------------------------------------ '获取文件大小 'fileName 文件路径和文件名组成 'Return 文件大小,单位为字节 function getFileSize(fileName) Dim fso, f, s Set fso = CreateObject("Scripting.FileSystemObject") REM Set f = fso.GetFolder(filespec) If fso.FileExists(fileName) Then Set f = fso.GetFile(fileName) getFileSize=f.size Else MsgBox fileName&"不存在,请检查脚本",48,"错误提示" End If REM s = UCase(f.Name) & " 大小为 " & f.size & " 字节。" end function '获取文件创建日期 'fileName 文件路径和文件名组成 'Return 文件的创建日期,YYYYMMDD格式 function getFileCreateDate(fileName) set fso=createobject("Scripting.FileSystemObject") set fn=fso.GetFile(fileName) getFileCreateDate=Replace(Left(fn.DateCreated,Instr(fn.DateCreated," ")-1),"/","") end function '获取文件创建时间 'fileName 文件路径和文件名组成 'Return 文件的创建时间,HHMMSS格式 function getFileCreateTime(fileName) set fso=createobject("Scripting.FileSystemObject") set fn=fso.GetFile(fileName) getFileCreateTime=Replace(Mid(fn.DateCreated,InstrRev(fn.DateCreated," ")+1),":","") end function 'Function ReadAllTextFile ''vbCr Chr(13) 回车符。 ''vbCrLf 搜索Chr(13) & Chr(10) 回车符与换行符。 ''vbLf Chr(10) 换行符。 ' Const ForReading = 1, ForWriting = 2 ' Dim fso, f ' Set fso = CreateObject("Scripting.FileSystemObject") ' Set f = fso.OpenTextFile("c:testfile.txt", ForWriting, True) ' f.Write "世界你好!" ' Set f = fso.OpenTextFile("c:testfile.txt", ForReading) 'ReadAllTextFile = f.ReadAll ' End Function '获取文件行数 'fileName 文件路径和文件名组成 'Return 文件的行数,根据回车符来计算的 function getFileRows(fileName) set fso=createobject("Scripting.FileSystemObject") set fn=fso.opentextfile(fileName,1) 'msgbox(fn.readall) getFileRows=ubound(split(fn.readall,vbCrLf)) fn.close end Function '获取文件行数 'filePath 文件路径和文件名组成 'strKey 左起的关键字 'Return 文件的行数,根据回车符来计算的 function getFileCount(filePath,strKey) set fso=CreateObject("Scripting.FileSystemObject") for each f in fso.getfolder(filePath).files 'if fso.getextensionname(f.path)="wma" then k=k+1 if left(f.name,Len(strKey))=strKey Or Len(Trim(strKey))=0 then k=k+1 next getFileCount=k End Function '创建文件 'fileName 文件路径和文件名组成 'content 文件内容 'Return 文件生成 function createFile(fileName,content) Dim fso Set fso = CreateObject("scripting.filesystemobject") Set myfile=fso.CreateTextFile( fileName,,ture) str=Split(content, VbCrlf) content="" For Each i In str myfile.WriteLine i Next myfile.Close end function '删除文件中的关键字或者某行 Function DeleteLine(strFile, strKey, LineNumber, CheckCase) 'DeleteLine Function by TomRiddle 2008 'Remove line(s) containing text (strKey) from text file (strFile) 'or 'Remove line number from text file (strFile) 'or 'Remove line number if containing text (strKey) from text file (strFile) 'Use strFile = "c:\file.txt" (Full path to text file) 'Use strKey = "John Doe" (Lines containing this text string to be deleted) 'Use strKey = "" (To not use keyword search) 'Use LineNumber = "1" (Enter specific line number to delete) 'Use LineNumber = "0" (To ignore line numbers) 'Use CheckCase = "1" (For case sensitive search ) 'Use CheckCase = "0" (To ignore upper/lower case characters) Const ForReading=1:Const ForWriting=2 Dim objFSO,objFile,Count,strLine,strLineCase,strNewFile Set objFSO=CreateObject("Scripting.FileSystemObject") Set objFile=objFSO.OpenTextFile(strFile,ForReading) Do Until objFile.AtEndOfStream strLine=objFile.Readline If CheckCase=0 then strLineCase=ucase(strLine):strKey=ucase(strKey) If LineNumber=objFile.Line-1 or LineNumber=0 then If instr(strLine,strKey) or instr(strLineCase,strkey) or strKey="" then strNewFile=strNewFile Else strNewFile=strNewFile&strLine&vbcrlf End If Else strNewFile=strNewFile&strLine&vbcrlf End If Loop objFile.Close Set objFSO=CreateObject("Scripting.FileSystemObject") Set objFile=objFSO.OpenTextFile(strFile,ForWriting) objFile.Write strNewFile objFile.Close End Function '获取文件的MD5值 'Function MD5Sum(filename) ' Dim MyStream, MyHashed, MD5Value ' Set MyStream = CreateObject("ADODB.Stream") ' MyStream.Type = 1 ' MyStream.Open() ' MyStream.LoadFromFile(filename) ' Set MyHashed = CreateObject("CAPICOM.HashedData") ' MyHashed.Algorithm = 3 ' MyHashed.Hash(MyStream.Read()) ' MyStream.Close ' MD5Value = MyHashed.Value ' MD5Sum = MD5Value 'End Function '获取文件的MD5值 'fileName 文件路径和文件名组成 'Return 返回文件的MD5值,大写的 Function getFileMD5(fileName) Dim file_hash Dim hash_value Dim i,wi Set wi = CreateObject("WindowsInstaller.Installer") Set file_hash = wi.FileHash(fileName, 0) hash_value = "" For i = 1 To file_hash.FieldCount hash_value = hash_value & BigEndianHex(file_hash.IntegerData(i)) Next getFileMD5 = hash_value Set file_hash = Nothing Set wi = Nothing End Function Function BigEndianHex(Int) Dim result Dim b1, b2, b3, b4 result = Hex(Int) b1 = Mid(result, 7, 2) b2 = Mid(result, 5, 2) b3 = Mid(result, 3, 2) b4 = Mid(result, 1, 2) BigEndianHex = b1 & b2 & b3 & b4 End Function '使用文件选择框选择文件 Function BrowseForFile() BrowseForFile=CreateObject("WScript.Shell").Exec("mshta vbscript:""""").StdOut.ReadAll End Function '获取文件的所在目录 'fileName 文件路径和文件名组成 function getFilePath(fileName) getFilePath=Left(fileName,InStrRev(fileName,"\")-1) end function '删除文件 function deleteFile(fileName) set fso=createobject("scripting.filesystemobject") REM 如果不存在也不要提示 if (fso.FileExists(fileName)) then fso.deleteFile fileName End if end function '压缩文件成rar格式 'rar.exe a test.rar test.txt 'rarName rar文件路径和文件名组成 'target_dir 源文件路径 'fileName 文件名组成 Function rarFiles(rarPath,rarName,target_dir,fileName) SET ws=CreateObject("wscript.shell") 'set fso=CreateObject("scripting.filesystemobject") 'ws.run "cd "&target_dir,0 ws.currentdirectory=target_dir rarPath=chr(34)&rarPath&chr(34) '在这里修改文件名,注意不要含有空格 ws.run rarPath&" a "&rarName&" "&fileName,0 End Function |