更新

1
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
2
Sub 获取标签名(control As IRibbonControl, ByRef returnedVal)
3
    returnedVal = "报告小帮手 V2.6"
4
End Sub
5
Sub 获取标签日期(control As IRibbonControl, ByRef returnedVal)
6
    returnedVal = "20220814更新"
7
End Sub
8
Sub 签名(control As IRibbonControl, ByRef returnedVal)
9
    returnedVal = "公众号：茶瓜子的休闲馆"
10
End Sub
11
Sub 检查更新(control As IRibbonControl)
12
    本地 = Val(ThisVersion)
13
    最新 = Val(Getver)
14
    If 本地 <> 最新 Then
15
        y = MsgBox("存在新版本，是否进入主页查看最新版？", vbYesNo)
16
        If y = 6 Then
17
            OpenWeb
18
        End If
19
    Else
20
        MsgBox "当前版本为最新版"
21
    End If
22
End Sub
23
Public Function ThisVersion()
24
    ThisVersion = "2.6"
25
End Function
26
Public Function Getver()
27
    Dim Json As Object
28
    URL = "http://api.gzaudit.com/xbs/wd/"
29
    res = GetData(URL, "UTF-8")
30
    Set Json = JsonConverter.ParseJson(res)
31
    Getver = Json("版本")
32
End Function
33
Sub OpenWeb()
34
  ShellExecute 0&, vbNullString, "www.gzaudit.com", vbNullString, vbNullString, vbNormalFocus
35
End Sub
36
Function GetData(StrUrl, CodePageX)
37
    Dim oHtml As Object
38
    Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
39
    Dim sUrl As String
40
    sUrl = StrUrl
41
    Dim sCharset As String
42
    sCharset = CodePageX
43
    With oHtml
44
        .Open "GET", sUrl, False
45
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/91.0.4472.124 Safari/537.36"
46
        .Send
47
        '获取返回的字节数组
48
        bResult = .ResponseBody
49
        '按照指定的字符编码显示
50
        sResult = BytesToStr(bResult, CodePageX)
51
        'Debug.Print sResult
52
    End With
53
    GetData = sResult
54
    Set oHtml = Nothing
55
End Function
56
Public Function BytesToStr(strBody, CodeBase)
57
    Dim objStream
58
    Set objStream = CreateObject("Adodb.Stream")
59

60
    With objStream
61
        .Type = 1
62
        .Mode = 3
63
        .Open
64
        .Write strBody
65
        .Position = 0
66
        .Type = 2
67
        .Charset = CodeBase '"GB2312" '
68
        BytesToStr = .ReadText
69
        .Close
70
    End With
71
    Set objStream = Nothing
72
End Function