如何用VB制作在线升级?

如何用VB制作在线升级?,第1张

可以在服务器端放2个文件,一个假如是Update.ini,还有一个就是你的程序,假如是,在本地还要有一个文件,存放设置,假如是config.ini

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


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12205779.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-21
下一篇 2023-05-21

发表评论

登录后才能评论

评论列表(0条)

保存