VB6.0 版本驗證

iiy147258369

---------------------需要的件元-------------------------
Text*1
Command*1
Label*4
Inet*1
表單*2
模組*1
------------------------表單內容---------------------------------

Private Sub Command1_Click() '名副其實就是按鈕 - 3 -
Unload Me  '關閉版本認證
Form2.Show '開啟Form2
End Sub

Private Sub Form_Load()
Label4.Caption = DownloadString("https://www.dropbox.com/xxxxxxxxxxxxx") '版本驗證,()內需更改成免空網址
'設置一個Txt檔案,裡面打版本,之後上傳至免空即可
If Label4.Caption = Label3.Caption Then'免空顯示的TXT=表單上的文字
Text3.Text = "目前為最新版本，可以使用!"     '顯示可以使用
Text3.ForeColor = &HFF0000
Command1.Enabled = True '可使用時，可點取
'TrueFalse
Else

Text3.Text = "偵測到新版本，請重新下載!"    '顯示不同=不可進入
Text3.ForeColor = &HFF&
Command1.Enabled = False    '禁止進入

End If  '停止本動作

If Label3.Caption = Label4.Caption Then  '一樣的話啟動以下指令
Else
Command1.Enabled = False   


If App.PrevInstance Then '讀取前一個版本
MsgBox "請勿重複開啟", 48, "訊息"
End If
End If

End Sub

-------------------------模組內容-------------------------不解釋了------------------------------------------------------
' HTTP Downloading Module By Inndy
Option Explicit
' For API
Private Const CP_ACP = 0        ' default to ANSI code page
Private Const CP_UTF8 = 65001   ' default to UTF-8 code page
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
' For module
Public Enum Encode
     ANSI = 0
     BIG5 = 1
     UTF8 = 2
End Enum

Private Function ToUTF8(ByVal sData As String) As Byte()
     Dim aRetn() As Byte, nSize As Long
     nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0)
     ReDim aRetn(0 To nSize - 1) As Byte
     WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
     ToUTF8 = aRetn
End Function

Private Function FromUTF8(ByVal sData As String) As Byte()
     Dim aRetn() As Byte, nSize As Long
     nSize = MultiByteToWideChar(CP_UTF8, 0, StrPtr(sData), -1, 0, 0)
     ReDim aRetn(0 To 2 * nSize - 1) As Byte
     MultiByteToWideChar CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize
     FromUTF8 = aRetn
End Function

Public Function DownloadData(ByVal url As String) As Byte()
     Dim http As Object
     Set http = CreateObject("MSXML2.ServerXMLHTTP")
     http.Open "GET", url, False
     http.setRequestHeader "Pragma", "no-cache"
     http.send
     DownloadData = http.responseBody
     Set http = Nothing
End Function

Public Function DownloadString(ByVal url As String, Optional ByVal EncType As Encode = Encode.BIG5) As String
     If EncType = Encode.ANSI Then
         DownloadString = DownloadData(url)
     ElseIf EncType = Encode.BIG5 Then
         DownloadString = StrConv(DownloadData(url), vbUnicode)
     Else
         DownloadString = FromUTF8(DownloadData(url))
     End If
End Function

Public Function DownloadFile(ByVal url As String, ByVal file As String) As Boolean
     On Error GoTo Failed
     Dim f As Integer
     f = FreeFile
     Open file For Binary As f
     Put f, , DownloadData(url)
     Close f
     DownloadFile = True
     Exit Function
Failed:
     DownloadFile = False
End Function