Update.ini:
[update]
new=1.0.1
config.ini:
[config]
ver=1.0.0
代码:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Sub Form_Load()
r = URLDownloadToFile(0,"", App.Path &"\Update\u.ini", 0, 0)
'下载好文件后,就开始读ini了
Dim ret As Long
Dim nowv, newv As String
nowv = Space$(1000) '事先定义读取值的字串宽度
'读出新版本和旧版本
ret = GetPrivateProfileString("update", "new", "", newv, 1000, App.Path &"\Update\Update.ini")
ret = GetPrivateProfileString("config", "ver", "", nowv, 1000, App.Path &"\Update\Update.ini")
'如果新版本和旧版本不同,则开始下载新版本
If nowv <>newv Then
r = URLDownloadToFile(0,"", App.Path &"\Update\1.exe", 0, 0)
End Sub
写了这么多,楼主是不是给点分,多给点
一楼说文件类型,显然是没有看题
看到二楼说的,我无语~~
AxWebBowser就是原来VB6里面那个COM控件WebBowser.直接在添加引用时选择COM一页进去找就是了在线升级一般采用FTP方式.先由客户端发起更新请求,服务器返回现在最新的文件的清单、版本、修改日期等信息,客户端拿到和自己的文件进行比对,发现不同的就用FTP方式向服务器索取最新的,然后替换掉自己的就可以了。
wstr = Inet1.OpenURL("http://www.xxx.com/1.txt")If wstr <>"" And wstr <>"v1.0" Then
a = MsgBox("你好,检查到远程有升级程序,是否更新?", vbOKCancel, "提示")
If a = 1 Then '确定更新
DownFile
End If
ElseIf wstr = "" Or wstr = "v1.0" Then
MsgBox "当前此版本为最新程序,若有建议请联系QQ:121734199", vbOKOnly, "提示"
End If
Private Sub DownFile()
If ii = 0 Then
strURL = "http://www.xxx.com/xiaoshuo/小说.exe"
mstrFileName = App.Path &"\小说_v1.0.exe"
ElseIf ii = 1 Then
strURL = "http://www.xxx.com/xiaoshuo/更名器.exe"
mstrFileName = App.Path &"\更名器.exe"
Else
Shell App.Path &"\更名器.exe", vbHide
End
End If
mblnPutStart = False
With Winsock1
If .State <>sckClosed Then .Close
.Protocol = sckTCPProtocol
.RemoteHost = Split(Replace(strURL, "http://", ""), "/")(0)
.RemotePort = 80
.Connect
End With
End Sub
Private Sub Winsock1_Connect()
Dim s As String
s = "GET " + strURL + " HTTP/1.0" + vbCrLf
s = s + "Accept: */*" + vbCrLf
s = s &"Pragma: no-cache" &vbCrLf
s = s &"Cache-Control: no-cache" &vbCrLf
s = s &"Connection: close" &vbCrLf &vbCrLf
s = s + vbCrLf
Winsock1.SendData s
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim RevData() As Byte
Dim a() As Byte, b() As String, c() As String
Dim s As String, i As Long, k As Long
On Error GoTo fail
If mblnPutStart = False Then
Winsock1.PeekData RevData, vbArray Or vbByte
k = InStrB(1, RevData, ChrB(13) &ChrB(10) &ChrB(13) &ChrB(10))
If k >0 Then
Winsock1.GetData RevData, vbArray Or vbByte
a = LeftB(RevData, k - 1)
RevData = MidB(RevData, k + 4)
s = StrConv(a, vbUnicode)
b = Split(s, vbCrLf)
If InStr(1, b(0), "200 OK", vbTextCompare) = 0 Then GoTo fail
For i = 1 To UBound(b)
c = Split(b(i), ": ")
Select Case c(0)
Case "Content-Length"
mlngFileLen = CLng(c(1))
End Select
Next
mblnPutStart = True
mlngCurByte = UBound(RevData) + 1
mlngFileNum = FreeFile
Open mstrFileName For Binary As #mlngFileNum
Else
Exit Sub
End If
Else
Winsock1.GetData RevData, vbArray Or vbByte
mlngCurByte = mlngCurByte + bytesTotal
End If
Put #mlngFileNum, , RevData
Label3.Caption = "已下载字节:" &mlngCurByte &"/" &mlngFileLen
If mlngCurByte = mlngFileLen Then
Close #mlngFileNum
ii = ii + 1
DownFile
End If
Exit Sub
fail:
MsgBox "网络传输错误,文件下载失败!"
End Sub
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)