怎样用VB自动更新应用程序?

怎样用VB自动更新应用程序?,第1张

s=trim(command())

'取得命令行参数

应该是这个形式:FastCopy.exe

网络目录名,文件名

's的返回值是

网络目录名,文件名

如:“\\liang\,myadd.exe"

'然后为了区分开目录名和文件名,就查找","号

p=instr(1,s,",")

'如果找到就分别取“,”前面的目录和后面的应用程序名。

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/11162987.html

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

发表评论

登录后才能评论

评论列表(0条)

保存