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
| 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
Sub 获取标签名(control As IRibbonControl, ByRef returnedVal)
returnedVal = "报告小帮手 V2.6"
End Sub
Sub 获取标签日期(control As IRibbonControl, ByRef returnedVal)
returnedVal = "20220814更新"
End Sub
Sub 签名(control As IRibbonControl, ByRef returnedVal)
returnedVal = "公众号：茶瓜子的休闲馆"
End Sub
Sub 检查更新(control As IRibbonControl)
本地 = Val(ThisVersion)
最新 = Val(Getver)
If 本地 <> 最新 Then
y = MsgBox("存在新版本，是否进入主页查看最新版？", vbYesNo)
If y = 6 Then
OpenWeb
End If
Else
MsgBox "当前版本为最新版"
End If
End Sub
Public Function ThisVersion()
ThisVersion = "2.6"
End Function
Public Function Getver()
Dim Json As Object
URL = "http://api.gzaudit.com/xbs/wd/"
res = GetData(URL, "UTF-8")
Set Json = JsonConverter.ParseJson(res)
Getver = Json("版本")
End Function
Sub OpenWeb()
ShellExecute 0&, vbNullString, "www.gzaudit.com", vbNullString, vbNullString, vbNormalFocus
End Sub
Function GetData(StrUrl, CodePageX)
Dim oHtml As Object
Set oHtml = VBA.CreateObject("WinHttp.WinHttpRequest.5.1")
Dim sUrl As String
sUrl = StrUrl
Dim sCharset As String
sCharset = CodePageX
With oHtml
.Open "GET", sUrl, False
.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"
.Send
bResult = .ResponseBody
sResult = BytesToStr(bResult, CodePageX)
End With
GetData = sResult
Set oHtml = Nothing
End Function
Public Function BytesToStr(strBody, CodeBase)
Dim objStream
Set objStream = CreateObject("Adodb.Stream")
With objStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase
BytesToStr = .ReadText
.Close
End With
Set objStream = Nothing
End Function
|