當前位置:編程學習大全網 - 源碼下載 - 急求VB軟件自動更新源碼!謝謝了,大神幫忙啊

急求VB軟件自動更新源碼!謝謝了,大神幫忙啊

Private Function GetKey(ByVal str As String) As String Dim nOffset As Long nOffset = InStr(str, "=") If nOffset > 0 Then GetKey = Trim(Mid(str, 1, nOffset - 1)) Exit Function End If GetKey = vbNullString End Function Private Function GetVal(ByVal str As String) As String Dim nOffset As Long nOffset = InStr(str, "=") If nOffset > 0 Then GetVal = Trim(Mid(str, nOffset + 1)) Else GetVal = vbNullString End If End Function Private Function GetHttpFileName(ByVal str As String) As String Dim nOffset As Long nOffset = InStrRev(str, "/") Dim strTemp As String If nOffset > 0 Then strTemp = Trim(Mid(str, nOffset + 1)) End If GetHttpFileName = strTemp End Function Private Sub OnLoadConfigFaild() Label1.Caption = "獲取更新列表失敗" End Sub Private Sub LoadFile(ByVal strFile As String) mStatus = TaskLoadFile mFile = GetHttpFileName(strFile) If Len(mFile) = 0 Then Call LoadFileFaild Exit Sub End If Http.Open "GET", strFile, True Http.Send Label1.Caption = "開始讀取文件" End Sub Private Sub LoadFileFaild() Label1.Caption = "下載文件失敗" End Sub Private Sub LoadFileEnd() On Error GoTo lblErr: Dim bytData() As Byte bytData = Http.ResponseBody Open mFile & ".update.exe" For Binary As #1 Put #1, 1, bytData Close Label1.Caption = "正重啟程序" On Error Resume Next Shell "Loader.exe " & mFile & "," & mFile & ".update.exe" End Exit Sub lblErr: Label1.Caption = "下載文件失敗" End Sub Private Sub UpdatePercent(ByVal n As Long) If mStatus = TaskLoadFile Then Label1.Caption = "已下載 " & n & "%" DrawPerent n End If End Sub Private Sub Http_OnResponseStart(ByVal Status As Long, ByVal ContentType As String) nTotalSize = 0 nCurrSize = 0 On Error Resume Next nTotalSize = Http.GetResponseHeader("Content-Length") If Status <> 200 Then Http.Abort LoadFileFaild End If End Sub Private Sub DrawPerent(ByVal n As Long) For i = 0 To Picture1.ScaleWidth * n / 100 Picture1.Line (i, 0)-(i, Picture1.ScaleHeight), RGB(0, &HFF, &H66) Next End Sub

  • 上一篇:寫給某某(先鋒)的壹封信
  • 下一篇:spl是什麽意思?
  • copyright 2024編程學習大全網