新增检查sql脚本是否符合ANSI编码格式

Posted 2020-10-20 特务小强

‘*******************************************************************
‘作用：transfer转换文件编码格式
‘参数含义：incode为传入的文件编码 outcode转换后的文件编码
‘进行判断文件类型是否是ansi类型，如果不是,提供选择是否需要自动更新文件
‘*******************************************************************
Function read(path)
    ‘将Byte()数组转成String字符串
    Dim ado, a(), i, n
    Set ado = CreateObject("ADODB.Stream")
    ado.Type = 1 : ado.Open
    ado.LoadFromFile path
    n = ado.Size - 1
    ReDim a(n)
    For i = 0 To n
        a(i) = ChrW(AscB(ado.Read(1)))
    Next
    read = Join(a, "")
End Function

Function is_valid_utf8(ByRef input) ‘ByRef以提高效率
    Dim s, re
    Set re = New Regexp
    s = "[\xC0-\xDF]([^\x80-\xBF]|$)"
    s = s & "|[\xE0-\xEF].{0,1}([^\x80-\xBF]|$)"
    s = s & "|[\xF0-\xF7].{0,2}([^\x80-\xBF]|$)"
    s = s & "|[\xF8-\xFB].{0,3}([^\x80-\xBF]|$)"
    s = s & "|[\xFC-\xFD].{0,4}([^\x80-\xBF]|$)"
    s = s & "|[\xFE-\xFE].{0,5}([^\x80-\xBF]|$)"
    s = s & "|[\x00-\x7F][\x80-\xBF]"
    s = s & "|[\xC0-\xDF].[\x80-\xBF]"
    s = s & "|[\xE0-\xEF]..[\x80-\xBF]"
    s = s & "|[\xF0-\xF7]...[\x80-\xBF]"
    s = s & "|[\xF8-\xFB]....[\x80-\xBF]"
    s = s & "|[\xFC-\xFD].....[\x80-\xBF]"
    s = s & "|[\xFE-\xFE]......[\x80-\xBF]"
    s = s & "|^[\x80-\xBF]"
    re.Pattern = s
    is_valid_utf8 = (Not re.Test(input))
End Function

Function CheckCode(Sourcefile)
    ‘WScript.echo "Checking: " & Sourcefile
    Dim stream
    set stream = CreateObject("Adodb.Stream")
    stream.Type = 1 ‘adTypeBinary
    stream.Mode = 3 ‘adModeReadWrite
    stream.Open
    stream.Position = 0
    stream.LoadFromFile Sourcefile
    Bin = stream.read(2)
	s = read(Sourcefile) ‘读取文件
	if is_valid_utf8(s)=-1 then‘判断是否UTF-8
		Codes = "utf-8"
		msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改"
	‘&HEF  239   &HBB 187  &HFF 255  &HFE 254
    elseif AscB(MidB(Bin, 1, 1)) = &HEF and _     
        AscB(MidB(Bin, 2, 1)) = &HBB Then
        Codes = "utf-8"
		msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改"
    elseif AscB(MidB(Bin, 1, 1)) = &HFF and _
        AscB(MidB(Bin, 2, 1)) = &HFE Then
        Codes = "unicode"
		msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改"
	elseif 	 AscB(MidB(Bin, 1, 1)) = &HFE and _
        AscB(MidB(Bin, 2, 1)) = &HFF Then
			Codes = "unicode big endian"
			msgbox Sourcefile&"文件为"&Codes&"非ansi请注意修改"
			Codes = "unicode"
    else
		Codes = "gb2312"
    end if

 
    stream.Close
    set stream = Nothing
	  CheckCode = Codes
end Function  

‘*******************************************************************
‘作用：transfer转换文件编码格式
‘参数含义：incode为传入的文件编码 outcode转换后的文件编码
‘*******************************************************************
Function  transfer(inFile,incode,outcode,outfile)
	Set instream = CreateObject("Adodb.Stream")
	Set outstream = CreateObject("Adodb.Stream")

	‘Open input file
	instream.Type = 2 ‘adTypeText
	instream.Mode = 3 ‘adModeReadWrite
	instream.Charset = inCode
	instream.Open
	instream.LoadFromFile inFile

	‘Read input file
	content = instream.ReadText

	‘Close input file
	instream.Close
	Set instream = Nothing

	‘Open output file
	outstream.Type = 2 ‘adTypeText
	outstream.Mode = 3 ‘adModeReadWrite
	outstream.Charset = outCode
	outstream.Open

	‘Write to output file
	outstream.WriteText content
	outstream.SaveToFile outFile, 2 ‘adSaveCreateOverWrite
	outstream.flush

	‘Close output file
	outstream.Close
	Set outstream = Nothing
end Function 
‘*******************************************************************
‘作用：GetDirectory获取当前目录
‘参数含义：
‘*******************************************************************
Function GetDirectory()
Dim WshShell
Set WshShell=CreateObject("WScript.Shell")
GetDirectory = WshShell.CurrentDirectory
Set WshShell = nothing 
End Function 
‘*******************************************************************
‘*******************************************************************
‘作用：rrubstr取字符串istr中的sign字符串后面的子字符串;从字符串尾部搜索的位置
‘参数含义：
‘*******************************************************************
Function rsubstr (istr, sign)
     Dim fnum,substr
     fnum = instrRev (istr,sign) + Len(sign) - 1
     substr = Right (istr,Len(istr)-fnum)
     rsubstr = substr
End Function 
‘*******************************************************************
‘作用：
‘参数含义：
‘*******************************************************************
Function  Main()
    ‘创建新文件             
    Set nfso = CreateObject("Scripting.FileSystemObject")
	 ‘遍历一个文件夹下的所有文件 
    Set oFso = CreateObject("Scripting.FileSystemObject")   
	fold = GetDirectory()&"\"
    Set oFolder = oFso.GetFolder(fold)    
    Dim inFile
	isExist = 0
	isTransfer = 0
	isCount = 0
    Set oFiles = oFolder.Files  
    ‘对每个文件进行处理 
    For Each oFile In oFiles   
		inFile = oFile.path
		if rsubstr(inFile,".") <> "vbs" then 
			
		    isCount = isCount +1
			incode = CheckCode (infile)
			outcode ="gb2312"
			if incode <> outcode then 
				choice = Msgbox(inFile & " is not ansi，请注意!" & vbCrlf & _
				" Do you want to transfer it?", vbQuestion + vbYesNo, _
				"Output file has been existed")
				if choice = vbYES then 
					transfer inFile,incode,outcode,inFile
					‘msgbox  inFile &"格式转换成功！"
					isTransfer = isTransfer +1
				end if 
				isExist = isExist+1
			end if 
		end if 	
	 Next   
	 set nfso = nothing
	 set ntf = nothing 
	 set oFolder = nothing
	 set oFiles = nothing 
	 msgbox "共检查文件:"&isCount&"，发现格式不对文件:"&isExist&",共转换成功文件:"&isTransfer
End Function  

Main