VBS 自动更新SQL SEVER 2014 Query 模板

好久没动手了。

哈哈， 好像要干架的感觉。

开始写。

当我们在SSMS中点击New Query 时，SSMS会打开一个查询窗口。而这个窗口中的内容我们可以通过模板文件进行预设置。

模板文件在以下路径中，不同的SQL SERVER版本路径也会有所不同，我得是2014, 路径如下。

C:\Program Files (x86)\Microsoft SQL Server\120\Tools\Binn\ManagementStudio\SqlWorkbenchProjectItems\Sql\SQLFile.sql

如果你得是其他版本，可以试试以下路径，其中的100 对应SQL SERVER 2008，如果你是SQL SERVER 2012 那应是 110.

C:\Program Files (x86)\Microsoft SQL Server\100\Tools\Binn\VSShell\Common7\IDE\SqlWorkbenchProjectItems\Sql\SQLFile.sql

如果我们更改SQLFile.sql中的内容，再点击New Query时，窗口中的内容就会更新。更改的过程可能会提示，要权限。由于这个文件目录是不允许修改的，所以我先删了SQLFile.sql这个文件，然后将新的SQLFile.sql放入这个文件夹。 后面我做的时候，我预先修改了这个文件夹的访问权限，改为了Full Control。

好了 说说我想干嘛，由于每天我会点击上百次New Query，所以我准备将爱词霸的每日一句放入这个模板文件，这样每天无形中我可以学习一句英文。

OK，talk is cheap，show me the code！

Sub CalendarPhrases()
    Dim iLocalfile, iRemote, i, j,ibackupFile
    Dim xPost, sGet,strContents

    'URL from website iciba, it can be different when you see this article
    url = "http://news.iciba.com/dailysentence/detail-"+cstr(1421+DateDiff("d", "2015-08-12", Now())*2)+".html?from=calendar"
    'add the calendar phrase as a comment in the SQLFile.sql
    'I use the regular expression to get the content.
    result = "/* "+cstr(now())+ VbCrlf
    result = result+ VbCrlf +RegMatchValue(GetTextFromURL(url), "<li class=""en""><a>[^>]*(?=</a><span)")
    result = Replace(result, "<li class=""en""><a>", "")
    result = result + VbCrlf +VbCrlf + RegMatchValue(GetTextFromURL(url), "<li class=""cn""><a>[^>]*(?=</a></li>)")+ VbCrlf +"*/"+vbCrLf+vbCrLf
    result = Replace(result, "<li class=""cn""><a>", "")
    'MsgBox result

    Dim File, FileObject
    'below file path can be different for different vesion of SQL SERVER
    iLocalfile = "C:\Program Files (x86)\Microsoft SQL Server\120\Tools\Binn\ManagementStudio\SqlWorkbenchProjectItems\Sql\SQLFile.sql"
    ibackupFile = "C:\Temp\"
    Set FileObject = CreateObject("scripting.FileSystemObject")
    'before I change the template sql, I back up it into a folder Temp.
    If FileObject.FileExists(iLocalfile) Then 
        FileObject.CopyFile iLocalfile,ibackupFile
    End If 

    Const ForReading = 1
    Set File = FileObject.OpenTextFile(iLocalfile, ForReading)
    'ignore first 7 lines,which will be used to put the calendar phrases
    For i = 1 To 7
        File.ReadLine
    Next

    Do Until File.AtEndOfStream
        strContents = strContents + vbCrLf + File.ReadLine
        
    Loop
    File.Close

    result = result + vbCrLf + strContents
    'MsgBox result

    'write it to the file, as I also keep the translation, so I use ADODB.Steam.
    Set sGet = CreateObject("ADODB.Stream")
    sGet.Mode = 3
    sGet.Type = 2
    sGet.Charset = "utf-8"
    sGet.Open
    sGet.WriteText result
    sGet.SaveToFile iLocalfile, 2
    sGet.flush
    sGet.Close
    Set sGet = Nothing

End Sub
'=================================================================================================
' ¸get the web text from url.
'=================================================================================================
Function GetTextFromURL(url)
    Dim Retrieval
    On Error Resume Next
    Set Retrieval = CreateObject("Microsoft.XMLHTTP")
    
    Retrieval.Open "GET", url, False, "", ""
    Retrieval.send
    
    GetTextFromURL = Retrieval.responsetext

    If Err.Number <> 0 Then
        'msgbox "There is some error1:"& err.number&"-"&err.Description
        Set Retrieval = Nothing
        Exit Function
    Else
        'msgbox "Successfully GetURL!"
    End If
End Function
'=================================================================================================
' ¸Get the information what we need.
'=================================================================================================
Function RegMatchValue(SourceString, PatternStr)
    Dim Reg, Match, Matches, RetStr
    Set Reg = New RegExp
    'Set Reg = CreateObject("vbscript.regexp")
    Reg.IgnoreCase = True
    Reg.Global = True
    Reg.MultiLine = False
    Reg.Pattern = PatternStr
    Set Matches = Reg.Execute(SourceString)
    For Each Match In Matches
        RetStr = RetStr & Match.Value
    Next
    RegMatchValue = RetStr
End Function

call  CalendarPhrases

将以上代码保存为一个vbs 文件，然后在Task Scheduler中设置一个日常任务。然后每天就可以看到不同的一句。

下面是我得到的。

/* 2015/8/12 12:11:49

If you want to achieve a high goal, you're going to have to take some chances.

如果你想达到一个更高目标，你必须得冒点险。（阿尔贝托·萨拉查）
*/

SELECT Create_date,* FROM SYS.OBJECTS WHERE TYPE='P' AND NAME LIKE '%%'

SELECT OBJECT_NAME(SM.OBJECT_ID),DEFINITION FROM SYS.SQL_MODULES  SM
JOIN SYS.OBJECTS SO
ON SO.OBJECT_ID=SM.OBJECT_ID
WHERE SO.TYPE='P' AND DEFINITION LIKE ''

Good Luck