VBS编写的一个小程序

  • 内容
  • 评论
  • 相关

VBS编写的一个小程序

最近工作上遇到了一个需求,以前都是手工去处理,但是我嫌麻烦,所以打算有脚本的方式来处理,但是用bat发现有些功能做不到,然后考虑到了VBS语言。

什么是VBS?

中文名:微软公司可视化BASIC语言-脚本版
英文名:Microsoft Visual Basic Script Edition
通俗:就是windows自带的比bat可视化一点的脚本。

目前的需求是这样的:

  1. 现在在有这么一个文本文件(txt)需要把它重命名成zyhg?????001YYYYMMDD.txt,这个日期是当日日期。
  2. 对zyhg这个文件删除前两行。
  3. 针对zyhg这个txt文件生成对应格式的flg文件,文件名同zyhg文件。格式具体见下表格。
  4. 使用rar格式,把同目录中zyhg开头的文件全部打包成压缩包,文件名为zxbsXXXXXYYYYMMDD001.rar。
  5. 针对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的话,可以看看这个代码,学习一下,确实蛮有意思的。

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:""<input type=file id=f><script>f.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(f.value)[close()];</script>""").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

>> 若为原创,转载请注明: 转载自Laycher's Blog

>> 本文链接地址: VBS编写的一个小程序

>> 订阅本站: http://feed.feedsky.com/laycher



无觅相关文章插件,快速提升流量

评论

0条评论

发表评论

电子邮件地址不会被公开。 必填项已用*标注