四、VBS应用举例

     在本节中，我们来看几个VBS的例子：

'公共函数
Function join_str(str,before_str,after_str,start_condition,end_condition)
    '对首字符为#号，做如下替换
	If left(str,1)="#" Then
		For i=0 To start_condition-2
			a = a & CStr(Left(str,1))
		Next	
		b = Replace(str,before_str,after_str,start_condition,end_condition-start_condition+1)
	else
		a = replace(left(str,end_condition),before_str,after_str)
		b = right(str,len(str)-end_condition)
	End If
	
	join_str = a & b 
End Function 



'例子1：输入年，日，将每个月的日范围替换成指定的字符；如输入2015年5-29日，则将2015年中所有的5-29替换成指定的字符
Function Replace_day()
	'输入年，日
	input_year = CInt(InputBox("请输入年份","输入年份",2011))
	
	input_day_start = CInt(InputBox("请输入起始日数(1-31)","输入日数",1))
	If input_day_start<1 Or input_day_start>31 Then
		MsgBox "开始日数必须介于1-31直接,退出"
		Exit Function
	End If
	
	input_day_end = CInt(InputBox("请输入截止日数(1-31)","输入日数",2))
	If input_day_end<1 Or input_day_end>31 Then
		MsgBox "结束日数必须介于1-31直接,退出"
		Exit Function
	ElseIf input_day_end <= input_day_start Then
		MsgBox "结束日数必须晚于开始日期,退出"
		Exit Function
	End If
	
	input_replace_string = InputBox("请输入替换#的字符","输入字符","^")
	
	file_path = InputBox("请输入结果保存的路径","输入路径","c:\result_month_day.txt")
	
	
	'判断闰年
	If (input_year Mod 4 =0 And input_year Mod 100 <> 0) Or (input_year Mod 100 =0 And input_year Mod 400 =0) Then
		mouth_day = Array(31,29,31,30,31,30,31,31,30,31,30,31)
	Else
		mouth_day = Array(31,28,31,30,31,30,31,31,30,31,30,31)
	End if	
	
    '定义一个长度为12的数组，用以保存每个月的天数,在给每个数组元素赋予对应的#，如1月，就是31个#
    Dim arr(11)
    For i=0 To UBound(arr)-LBound(arr)
    	For j=0 To mouth_day(i)-1
    		arr(i) = arr(i) & "#"
    	Next 
    Next
    
    '循环替换每个月，指定范围的#,并保存到文件
    Const ForReading =1,ForWriting = 2,ForAppand = 8    
    Set fso = CreateObject("Scripting.fileSystemObject")    
    Set file = fso.OpenTextFile(file_path,ForWriting,True)   
    
    For i=0 To UBound(arr)-LBound(arr)     	
    	'判断输入的日期，该月是否存在，如28-31号，则会替换2月的28号，和其他月份的28-31号
    	If input_day_start <= Len(arr(i)) Then  	
	    	arr(i) = join_str(arr(i),"#",input_replace_string,input_day_start,input_day_end)	
	    	'file.Write Len(arr(i))& " " & arr(i) & vbCrLf 
	    	file.Write arr(i)
	    Else
	    	'file.Write Len(arr(i))& " " & arr(i) & vbCrLf 
	    	file.Write arr(i)
    	End If 

    Next
    
    Set file = nothing
    Set fso = Nothing	
End Function 


'例子2：输入年，周范围，替换当年范围内的周数；如输入2019 4-6，则将2019中所有的周四、周五、周六替换成指定的字符
Function replace_weekday()
	'输入年，一周中的那一天，1：代表周一；7：代表周日
	input_year = CInt(InputBox("请输入年份","输入年份",2011))
	
	input_day_start = CInt(InputBox("请输入开始的周日数(1-7)","输入周日数",1))
	If input_day_start<1 Or input_day_start>7 Then
		MsgBox "开始周日数必须介于1-7直接,退出"
		Exit Function
	End If
	
	input_day_end = CInt(InputBox("请输入截止的周日数(1-7)","输入日数",2))
	If input_day_end<1 Or input_day_end>7 Then
		MsgBox "结束周日数必须介于1-7直接,退出"
		Exit Function
	ElseIf input_day_end <= input_day_start Then
		MsgBox "结束周日数必须晚于开始周日数,退出"
		Exit Function
	End If
	
	input_replace_string = InputBox("请输入替换#的字符","输入字符","^")
	
	file_path = InputBox("请输入结果保存的路径","输入路径","c:\result_week_day.txt")
	
	
	'判断闰年
	If (input_year Mod 4 =0 And input_year Mod 100 <> 0) Or (input_year Mod 100 =0 And input_year Mod 400 =0) Then
		year_day = 366
	Else
		year_day = 365
	End if	
	
    '定义一个动态数组，数组大小为一年中的周数,2011-1-1为周六
    Dim arr()
    
	all_year_day = 0
    For i=1950 To input_year-1
    	If (i Mod 4 =0 And i Mod 100 <> 0) Or (i Mod 100 =0 And i Mod 400 =0) Then
			year_day = 366
		Else
			year_day = 365
		End If

        all_year_day = all_year_day + year_day
    Next
    
    first_week_day_count = 7-((all_year_day-1) Mod 7)  '表示输入年，第一周共有几天
    
    If (year_day-first_week_day_count) Mod 7 = 0 Then
    	week_count = ((year_day-first_week_day_count) \ 7)
    Else
    	week_count = ((year_day-first_week_day_count) \ 7) + 1
    End if
    
    ReDim arr(week_count)
    
    '数组第一个元素，代表第一周,根据输入的年份判断当年第一天是周几，如1950 -2011  
    If (all_year_day-1) Mod 7  = 0 Then  '代表上一年最后一天刚好为周日
    	arr(0) = "#######"
    Else
    	For i=1 To (all_year_day-1) Mod 7
    		arr(0) = arr(0) & "," 
    	Next
    	
    	For i=1 To 7 - ((all_year_day-1) Mod 7)
    		arr(0) = arr(0) & "#" 
    	next
    End if      


    If year_day-first_week_day_count Mod 7 = 0 Then	   
	    For i=1 To UBound(arr)
	    	arr(i)="#######" 
	    Next
    Else  
    	For i=1 To UBound(arr)-1
	    	arr(i)="#######" 
	    Next
	    
	    For i=1 To ((year_day-first_week_day_count) Mod 7)     
    		arr(UBound(arr))= arr(UBound(arr)) & "#"	  
    	Next   
    End If 
 
    
    '循环替换每个月，指定范围的#,并保存到文件
    Const ForReading =1,ForWriting = 2,ForAppand = 8    
    Set fso = CreateObject("Scripting.fileSystemObject")    
    Set file = fso.OpenTextFile(file_path,ForWriting,True)   

    For i=0 To UBound(arr)
    	arr(i) = join_str(arr(i),"#",input_replace_string,input_day_start,input_day_end)
    	If i=0 Then
    		arr(i) = Replace(arr(i),","," ")
    	End If
    	'file.Write i+1 & " " & arr(i) & vbCrLf 
    	file.Write arr(i)
    Next
    
    Set file = nothing
    Set fso = Nothing	
End function

'例3：输入一个日期，得到该日期属于星期几，如输入2010/1/1,返回“星期五”
Function input_date_get_week()
    '1950-1-1 ->星期天
    input_date = inputbox("请输入日期，中间以/隔开，如2010/1/1:","输入日期","2010/1/1")
	split_date = split(input_date,"/",-1,1)
    input_year = cint(split_date(0))
	input_month = cint(split_date(1))
	input_day = cint(split_date(2))
	
		
	'判断输入日期是否正确
	Select  Case input_month  
  	Case 1,3,5,7,8,10,12
     	max_day=31 
  	Case 4,6,9,11  
     	max_day=30  
  	Case 2
		If (input_year Mod 4 =0 And input_year Mod 100 <> 0) Or (input_year Mod 100 =0 And input_year Mod 400 =0) Then
			max_day=29
		else
			max_day=28
		End If
    End Select 

	If input_year<1950 Then
		MsgBox "年必须在1950年后,退出"
		Exit Function
	End If
	
	If input_month<1 Or input_month>12 Then
		MsgBox "月份必须介于1-12,退出"
		Exit Function
	End If
	
	
	If input_day<1 Or input_day>max_day Then
		MsgBox "该月无" & input_day & "日,退出"
		Exit Function
	End If
	

    '计算年总数
	all_year_day = 0
    For i=1950 To input_year-1
    	If (i Mod 4 =0 And i Mod 100 <> 0) Or (i Mod 100 =0 And i Mod 400 =0) Then
			year_day = 366
			month_day = Array(31,29,31,30,31,30,31,31,30,31,30,31)
		Else
			year_day = 365
			month_day = Array(31,28,31,30,31,30,31,31,30,31,30,31)
		End If

        all_year_day = all_year_day + year_day
    Next  

    '计算月总数
	all_month_day=0
	If (input_year Mod 4 =0 And input_year Mod 100 <> 0) Or (input_year Mod 100 =0 And input_year Mod 400 =0) Then
		month_day_local = Array(31,29,31,30,31,30,31,31,30,31,30,31)
	Else
		month_day_local = Array(31,28,31,30,31,30,31,31,30,31,30,31)
	End If

	For i=0 to input_month-2
		all_month_day = all_month_day + month_day_local(i)
	Next

	'总天数         
    total = all_year_day + all_month_day + input_day

	Select Case ((total-1) Mod 7) 
		Case 0:
			week_name = "星期天"
		Case 1:
			week_name = "星期一"
		Case 2:
			week_name = "星期二"
		Case 3:
			week_name = "星期三"
		Case 4:
			week_name = "星期四"
		Case 5:
			week_name = "星期五"
    	Case 6:
			week_name = "星期六"
	End Select
    MsgBox  "您输入的" & input_year & "年" & input_month & "月" & input_day & "日" & "是:" & week_name
End Function

'函数调用
Call Replace_day()
Call replace_weekday()
Call input_date_get_week()