frmnew.frm

VB开发的自动更新程序

            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   3
         Left            =   240
         TabIndex        =   21
         Top             =   1425
         Width           =   1725
      End
      Begin VB.Label lbl 
         Caption         =   "ScriptURLPrim="
         BeginProperty Font 
            Name            =   "Courier New"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   4
         Left            =   240
         TabIndex        =   20
         Top             =   1770
         Width           =   1725
      End
      Begin VB.Label lbl 
         Caption         =   "ScriptURLAlt="
         BeginProperty Font 
            Name            =   "Courier New"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   5
         Left            =   240
         TabIndex        =   19
         Top             =   2115
         Width           =   1725
      End
      Begin VB.Label lbl 
         Caption         =   "NotifyIcon="
         BeginProperty Font 
            Name            =   "Courier New"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   6
         Left            =   240
         TabIndex        =   18
         Top             =   2460
         Width           =   2025
      End
      Begin VB.Label lbl 
         Caption         =   "ShowFileIcons="
         BeginProperty Font 
            Name            =   "Courier New"
            Size            =   9.75
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   11
         Left            =   5640
         TabIndex        =   16
         Top             =   390
         Width           =   1725
      End
   End
   Begin VB.CommandButton cmdHelp 
      Cancel          =   -1  'True
      Caption         =   "帮助"
      Height          =   375
      Left            =   5490
      TabIndex        =   17
      Top             =   6570
      Width           =   915
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   6480
      TabIndex        =   15
      Top             =   6570
      Width           =   915
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Default         =   -1  'True
      Height          =   375
      Left            =   7470
      TabIndex        =   13
      Top             =   6570
      Width           =   915
   End
   Begin RichTextLib.RichTextBox rtTip 
      Height          =   945
      Left            =   180
      TabIndex        =   32
      TabStop         =   0   'False
      Top             =   5460
      Width           =   8215
      _ExtentX        =   14499
      _ExtentY        =   1667
      _Version        =   393217
      BackColor       =   14286847
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      AutoVerbMenu    =   -1  'True
      TextRTF         =   $"frmNew.frx":0611
   End
End
Attribute VB_Name = "frmNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

Private Sub chkAdmin_GotFocus()
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub chkReboot_GotFocus()
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub


Private Sub chkRegRISFiles_GotFocus()
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub chkShowIcons_GotFocus()
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub chkUpdateAppKill_GotFocus()
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub cmbDefConst_GotFocus()
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub cmdHelp_Click()
    WinHelp Me.hwnd, App.path & "\ReVive.hlp", HELP_CONTEXT, CLng(6)
End Sub

Private Sub Form_Load()
Dim x As Byte
    For x = 0 To 12
        Me.lbl(x).ForeColor = Setup.KeyTagColor
    Next x
    Me.txtPrim.Text = Setup.DefaultWeb
    Me.txtAlt.Text = Setup.DefaultWeb
    Me.txtNotifyIcon.Text = Setup.DefaultWeb
    With Me.cmbDefConst
        .Text = Setup.DefaultConst '--- Set default script constant
        .ForeColor = Setup.ValTagColor
    End With
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOK_Click()
Dim s As String
Dim x As Long
    s = vbNewLine
    s = s & ";Created by " & UserName & " on " & Format(Date, "dd mmm yyyy")
    s = s & vbNewLine
    s = s & ";" & Me.txtShort.Text & " Remote ReVive Update Script"
    s = s & vbNewLine & vbNewLine
    s = s & "[Setup]"
    s = s & vbNewLine
    s = s & vbTab & "AdminRequired=" & vbTab & CBool(Me.chkAdmin.Value)
    s = s & vbNewLine
    s = s & vbTab & "ForceReboots=" & vbTab & CBool(Me.chkReboot.Value)
    s = s & vbNewLine
    s = s & vbTab & "ShowFileIcons=" & vbTab & CBool(Me.chkShowIcons.Value)
    s = s & vbNewLine
    s = s & vbTab & "RegRISFiles=" & vbTab & CBool(Me.chkRegRISFiles.Value)
    s = s & vbNewLine
    s = s & vbTab & "AppShortName=" & vbTab & Me.txtShort.Text
    s = s & vbNewLine
    s = s & vbTab & "AppLongName=" & vbTab & Me.txtLong.Text
    s = s & vbNewLine
    s = s & vbTab & "ScriptURLPrim=" & vbTab & Me.txtPrim.Text
    s = s & vbNewLine
    s = s & vbTab & "ScriptURLAlt=" & vbTab & Me.txtAlt.Text
    s = s & vbNewLine
    s = s & vbTab & "NotifyIcon=" & vbTab & vbTab & Me.txtNotifyIcon.Text
    s = s & vbNewLine
    s = s & vbTab & "UpdateAppKill=" & vbTab & CBool(Me.chkUpdateAppKill.Value)
    s = s & vbNewLine
    s = s & vbTab & "UpdateAppTitle=" & vbTab & Me.txtAppTitle.Text
    s = s & vbNewLine
    s = s & vbTab & "UpdateAppClass=" & vbTab & Me.txtAppClass.Text
    s = s & vbNewLine
    s = s & vbTab & "LaunchIfKilled=" & vbTab & Me.cmbDefConst.Text & Me.txtLaunch.Text
    s = s & vbNewLine
    Setup.Script = ""
    Setup.AppShortName = LCase$(Me.txtShort.Text)
    With frmMain
        .Caption = "ReVive Script Editor"
        .rtBox.Text = s
        For x = 1 To 18
            .ColorLine x
        Next x
        .rtBox.SelStart = Len(.rtBox.TextRTF)
    End With
    Me.Hide
    If MsgBox("Would you like to begin adding update files to this script?   ", vbYesNo + vbQuestion, "Script Editor") = vbYes Then
        frmInsert.Show 1
    End If
    Unload Me
End Sub

Private Sub SelectAllText()
On Error Resume Next
    Screen.ActiveControl.SelStart = 0
    Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text)
    If Err Then Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmNew = Nothing
End Sub

Private Sub txtAlt_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtAppClass_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtAppTitle_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtLaunch_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtLong_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtNotifyIcon_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtPrim_GotFocus()
    SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Sub txtShort_GotFocus()
    Call SelectAllText
    Call DisplayTip(Me.ActiveControl.Tag, Me)
End Sub

Private Function UserName() As String
On Error Resume Next
Dim status      As Integer
Dim lpName      As String
Dim lpUserName  As String
Const lpnLength As Integer = 255
    lpUserName = Space$(lpnLength + 1)
    status = WNetGetUser(lpName, lpUserName, lpnLength)
    If status = 0 Then
        UserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
    Else
        UserName = "UNKNOWN"
    End If
End Function