📄 frmmain.frm
字号:
_ExtentX = 8864
_ExtentY = 4948
View = 3
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = -1 'True
HideColumnHeaders= -1 'True
FullRowSelect = -1 'True
_Version = 393217
SmallIcons = "iml"
ForeColor = -2147483640
BackColor = 16777215
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 2
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "文件描述"
Object.Width = 5679
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 1
Text = "状态"
Object.Width = 3158
EndProperty
End
Begin VB.Shape Shape1
BackColor = &H00C00000&
BorderColor = &H008F837A&
FillColor = &H00C00000&
Height = 2895
Left = 225
Top = 345
Width = 5115
End
Begin VB.Label lblTotal
Alignment = 1 'Right Justify
BackColor = &H00EBEDED&
Caption = "Label3"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 3475
TabIndex = 11
Top = 3390
Width = 1845
End
Begin VB.Label lblContinue
AutoSize = -1 'True
BackColor = &H00EBEDED&
Caption = "Label1"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 230
TabIndex = 7
Top = 3390
Width = 480
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************
'Chris Cochran cwc.software@gmail.com Updated: 13 Sep 05
'***********************************************************************
'------------------------------------------------------------------------------------------
' Module : frmMain
' Purpose : GUI for navigating LiveUpdate sequence.
' Image : The frmMain picture is the work of Korn閘 P醠. Thanks Korn閘 for offering it.
'------------------------------------------------------------------------------------------
Option Explicit
'//Icon declares for displaying in ListView
Private Type TypeIcon
cbSize As Long
picType As PictureTypeConstants
hIcon As Long
End Type
Private Type CLSID
id(16) As Byte
End Type
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Const SHGFI_ICON As Long = &H100
Private Const SHGFI_SMALLICON As Long = &H1
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
'//Errors encountered during update process
Private Enum eluErrors
eluSCRIPTDLERR = 0 '------------------------- Error downloading update script
eluSCRIPTPROCERR = 1 '----------------------- Error processing update script
eluPERMISSIONERR = 2 '----------------------- Insufficient privilege to run LiveUpdate
eluFILEDOWNLOADERR = 3 '--------------------- Error downloading updated file
eluFILEPROCESSERR = 4 '---------------------- Error processing update file after download
eluSCRIPTEMPTY = 5 '------------------------- Update script did not contain any entries
End Enum
Private Const oleLiteGray As Long = 16054263 '--- Alternating listview color (See AltLVBackColors sub)
Private Const CRYPTPWD As String = "ReVive" '--- Password for encrypting web URL's in .ris files
'>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*>*'... ***ONCE ESTABLISHED FOR AN APP DO NOT CHANGE***
Private bStep As Byte '---------------- Sets up Next button for next click
Private lTotalDlSize As Long '---------------- The combined size of all needed download files
Private lRecvdBytes As Long '---------------- Stores total bytes received for all update downloads
Private bWriteScript As Boolean '------------- True when script is read successfully, when true a new local script is written
Private bJustExit As Boolean '------------- True when form should not prompt to unload
Private bAppKilled As Boolean '------------- True when running app is killed by ReVive
Private bUpdateIcons As Boolean '------------- True when icons need updated after succesful update
Private Sub cmdReport_Click()
Call CreateReport '-------------------------- Create and display HTML update report
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
Select Case cmdCancel.Caption
Case "取消(&C)"
Unload Me '-------------------------- Exit with Yes/No option
Case "随后复位(&L)"
bREBOOT = False
bJustExit = True
Unload Me '-------------------------- Exit without Yes/No option
End Select
End Sub
Private Sub cmdNext_Click()
'-----------------------------------------------------------------------------------------
' Purpose : Ground zero for app navigation.
'-----------------------------------------------------------------------------------------
Dim x As Long
Select Case bStep
Case 0 '--------------------------------- Download web update script
Me.cmdNext.Enabled = False
Me.ucDL.Download Setup.ScriptURLPrim, CStr(0)
Case 1 '--------------------------------- Prepair screen and begin to cycle downloads
Me.cmdNext.Enabled = False
Me.cmdReport.Visible = False
Me.frmList.Caption = "正在下载和安装可用更新... "
Me.pbDownload.Visible = True
With FileList '---------------------- Display file sizes and mark them as queued in the listview
For x = 1 To UBound(.Description)
If .Status(x) = UPDATEREQ Then
Me.lvFiles.ListItems(x).SubItems(1) = IIf(.FileSize(x) > 1000, _
Format(.FileSize(x) / 1000, "#,##0") & "K 等待", Format(.FileSize(x), _
"##0") & "字节等待")
End If
Next x
End With
Call SequenceDownloads '------------- Begin downloading
Case 2 '--------------------------------- Exit Revive
Unload Me
End Select
End Sub
Private Sub ucDL_DownloadProgress(Identifier As String, RecvdBytes As Long, CurBytes As Long, MaxBytes As Long)
'-------------------------------------------------------------------------------
' Purpose : Keeps frmMain file download progress in sync as downloads progress
'-------------------------------------------------------------------------------
On Error Resume Next
Dim x As Long
Static ident As String
x = CLng(Identifier) '----------------------- Get download identifier
If x <> 0 And x <> 9999 Then '--------------- Skip if 0 (update script) or 9999 (notification icon)
With FileList
If ident <> Identifier Then
'****************************************************************************
'This is solely to ensure filesize is correct on script to avoid generating
'invalid property value error updating progress bar. It also ensures accuracy
'of download progression if script filesize is incorrect. DO NOT REMOVE.
If .FileSize(x) <> MaxBytes Then
.FileSize(x) = MaxBytes
Call ResetProgressBar
End If
'****************************************************************************
ident = CStr(Identifier) '------- Remember identifier to skip above next pass
End If
lRecvdBytes = lRecvdBytes + RecvdBytes
Me.pbDownload.Value = (lRecvdBytes / lTotalDlSize) * 100
Me.lvFiles.ListItems(x).EnsureVisible
If MaxBytes = CurBytes Then
'//Only display message if file is greater than 5Meg (smaller files write to quick)
If MaxBytes > 5000000 Then Me.lvFiles.ListItems(x).SubItems(1) = "写入磁盘"
Else
'******SELECT 1 OF 3 DIFFERENT FILE DOWNLOAD PROGRESS DISPLAY OPTIONS******
'//Show progress by bytes counting down
'Me.lvFiles.ListItems(x).SubItems(1) = IIf((MaxBytes - CurBytes) > 1000, _
Format((MaxBytes - CurBytes) / 1000, "#,##0K"), Format(MaxBytes - CurBytes, _
"#,##0 Bytes"))
'//Show progress by % complete
'Me.lvFiles.ListItems(x).SubItems(1) = Format(((CurBytes / MaxBytes) * 100), _
"#") & "% Complete"
'//Show progress by bytes counting down and % complete
Me.lvFiles.ListItems(x).SubItems(1) = IIf((MaxBytes - CurBytes) > 1000, _
Format((MaxBytes - CurBytes) / 1000, "#,##0K"), Format(MaxBytes - CurBytes, _
"#,##0 字节")) & " " & Format((CurBytes / MaxBytes) * 100, _
IIf(((CurBytes / MaxBytes) * 100) < 10, " 0", "00")) & "%"
'**************************************************************************
End If
End With
End If
End Sub
Private Sub ucDL_DownloadComplete(Identifier As String, Result As eDownloadResults)
'--------------------------------------------------------------------------------------
' Purpose : Called when any download completes, good or bad, from ucDownload control.
' This function takes appropriate action based on download result.
'--------------------------------------------------------------------------------------
Dim lResult As Byte
Dim x As Long
Static bAltAttempted As Boolean
x = CLng(Identifier)
If x = 0 Then '-------------- 0 is our update script file
Select Case Result
Case eSUCCESS
lResult = ParseUpdateScript(sTEMPDIR & "\version.rus")
'//Exit if script parsing fails and we are in auto or notify mode
If lResult <> 0 And Setup.RunMode <> eNORMAL Then GoTo UnloadNow
'//Display error for Normal mode if lResult > 0
If lResult = 1 Then
Call ShowLiveUpdateError(eluPERMISSIONERR)
ElseIf lResult = 2 Then
Call ShowLiveUpdateError(eluSCRIPTPROCERR)
ElseIf lResult = 3 Then
Call ShowLiveUpdateError(eluSCRIPTEMPTY)
Else
bWriteScript = True '------ Script read, set to write local scipt on exit
'//Download notify icon if available.
'NOTE: This was the only file (for whatever reason) that required
' the same filename case in both the script and web file. Wiered...
If Len(Setup.NotifyIcon) And Setup.RunMode <> eNORMAL Then
Me.ucDL.Download Setup.NotifyIcon, "9999"
Else
'//Show file, icons, and their update status in the listview
Call ListScanResults
End If
Exit Sub
End If
Case Else
'//Script download failed. Try alternate if available.
If Not bAltAttempted And Len(Setup.ScriptURLAlt) > 0 Then
bAltAttempted = True
Me.ucDL.Download Setup.ScriptURLAlt, CStr(0)
Else
'//Exit if script download fails and we are
'..in auto or notify mode
If Setup.RunMode <> eNORMAL Then GoTo UnloadNow
Call ShowLiveUpdateError(eluSCRIPTDLERR)
End If
End Select
Exit Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -