frmoptions.frm

VB开发的自动更新程序

VERSION 5.00
Begin VB.Form frmOptions 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "脚本编辑器选项"
   ClientHeight    =   5175
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6060
   Icon            =   "frmOptions.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5175
   ScaleWidth      =   6060
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame4 
      Caption         =   "自动选项"
      Height          =   1785
      Left            =   180
      TabIndex        =   12
      Top             =   2640
      Width           =   5685
      Begin VB.ComboBox cmbDefConst 
         Height          =   315
         ItemData        =   "frmOptions.frx":058A
         Left            =   210
         List            =   "frmOptions.frx":05AC
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   1290
         Width           =   2475
      End
      Begin VB.TextBox txtDefWeb 
         Height          =   315
         Left            =   210
         TabIndex        =   3
         Top             =   600
         Width           =   5235
      End
      Begin VB.Label lblConst 
         Caption         =   "脚本文件路径"
         Height          =   225
         Left            =   2850
         TabIndex        =   15
         Top             =   1350
         Width           =   2625
      End
      Begin VB.Label Label2 
         Caption         =   "默认文件夹:"
         Height          =   195
         Left            =   210
         TabIndex        =   14
         Top             =   1050
         Width           =   2535
      End
      Begin VB.Label Label1 
         Caption         =   "默认地址:"
         Height          =   195
         Left            =   210
         TabIndex        =   13
         Top             =   360
         Width           =   1635
      End
   End
   Begin VB.CommandButton cmd 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   375
      Index           =   1
      Left            =   3840
      TabIndex        =   6
      Top             =   4650
      Width           =   975
   End
   Begin VB.CommandButton cmd 
      Caption         =   "确定(&O)"
      Height          =   375
      Index           =   0
      Left            =   4890
      TabIndex        =   5
      Top             =   4650
      Width           =   975
   End
   Begin VB.Frame Frame2 
      Caption         =   "脚本编辑器颜色"
      Height          =   975
      Left            =   180
      TabIndex        =   8
      Top             =   1500
      Width           =   5685
      Begin VB.CommandButton cmdDef 
         Caption         =   "默认(&D)"
         Height          =   375
         Left            =   4590
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   360
         Width           =   975
      End
      Begin VB.Label lblTag 
         Caption         =   "值标识"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   2
         Left            =   3600
         TabIndex        =   11
         Top             =   480
         Width           =   855
      End
      Begin VB.Shape shpTag 
         FillColor       =   &H00D11FE0&
         FillStyle       =   0  'Solid
         Height          =   225
         Index           =   2
         Left            =   3330
         Top             =   450
         Width           =   225
      End
      Begin VB.Label lblTag 
         Caption         =   "关键字"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   1
         Left            =   2460
         TabIndex        =   10
         Top             =   480
         Width           =   705
      End
      Begin VB.Shape shpTag 
         FillColor       =   &H00FF0000&
         FillStyle       =   0  'Solid
         Height          =   225
         Index           =   1
         Left            =   2190
         Top             =   450
         Width           =   225
      End
      Begin VB.Label lblTag 
         Caption         =   "过程标题"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   -1  'True
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   195
         Index           =   0
         Left            =   510
         TabIndex        =   9
         Top             =   480
         Width           =   1515
      End
      Begin VB.Shape shpTag 
         FillColor       =   &H00800000&
         FillStyle       =   0  'Solid
         Height          =   225
         Index           =   0
         Left            =   240
         Top             =   450
         Width           =   225
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "杂项"
      Height          =   1125
      Left            =   180
      TabIndex        =   7
      Top             =   210
      Width           =   5685
      Begin VB.CheckBox chkAssociate 
         Caption         =   "关联脚本文件 .rus 文件类型."
         Height          =   195
         Left            =   210
         TabIndex        =   1
         Top             =   750
         Width           =   4575
      End
      Begin VB.CheckBox chkFileNames 
         Caption         =   "对于Win9X - ME 文件名兼容. (DOS 8.3 文件名格式)"
         Height          =   195
         Left            =   210
         TabIndex        =   0
         Top             =   390
         Width           =   5295
      End
   End
End
Attribute VB_Name = "frmOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'//START IsAdministrator Declares
Private Const TOKEN_READ                    As Long = &H20008
Private Const SECURITY_BUILTIN_DOMAIN_RID   As Long = &H20&
Private Const DOMAIN_ALIAS_RID_ADMINS       As Long = &H220&
Private Const SECURITY_NT_AUTHORITY         As Long = &H5
Private Const TokenGroups                   As Long = 2
Private Type SID_IDENTIFIER_AUTHORITY
   Value(6) As Byte
End Type
Private Type SID_AND_ATTRIBUTES
   Sid As Long
   Attributes As Long
End Type
Private Type TOKEN_GROUPS
   GroupCount As Long
   Groups(500) As SID_AND_ATTRIBUTES
End Type
Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function AllocateAndInitializeSid Lib "advapi32.dll" (pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal nSubAuthority7 As Long, lpPSid As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (pSid As Any)
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

'//START WindowsVersion Declarations
Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long       '1 = Windows 95/98.    '2 = Windows NT
    szCSDVersion As String * 128
End Type

'//Misc and shared declares
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_GETLINECOUNT   As Long = &HBA

Private bAssocValue             As Long

Private Sub cmbDefConst_Click()
Dim s As String
    Select Case Me.cmbDefConst.Text
        Case "<sp>"
            s = "Clients Script Path"
        Case "<ap>"
            s = "Clients Application Path"
        Case "<win>"
            s = "Clients Windows Directory"
        Case "<sys>"
            s = "Clients System Directory"
        Case "<temp>"
            s = "Clients Temporary Folder"
        Case "<pf>"
            s = "Clients Program Files Folder"
        Case "<cf>"
            s = "Clients Common Files Folder"
        Case "<userdesktop>"
            s = "Clients Desktop Folder"
        Case "<commondesktop>"
            s = "Clients Common Desktop Folder"
        Case "<commonstartmenu>"
            s = "Clients Common StartMenu Folder"
    End Select
    Me.lblConst.Caption = s
End Sub

Private Sub cmd_Click(Index As Integer)
Dim x               As Long
Dim lLineCount      As Long
Dim bWasItChanged   As Boolean
Dim s               As String
    If Index = 0 Then
        With Me.txtDefWeb '-------------------------- Verify default address ends with a / or a \
            If Len(.Text) Then
                s = Right$(.Text, 1)
                If s <> "/" And s <> "\" Then
                    MsgBox "Please end the Default Address with either a \ or a /. If the address     " & vbNewLine & _
                    "is a local or network path end if with a \. If it's a URL end it with a /.    ", vbExclamation, "Script Editor"
                    .SelStart = Len(.Text)
                    .SetFocus
                    Exit Sub
                End If
            End If
        End With
        With Setup
            .TestForFileNames = Abs(Me.chkFileNames.Value)
            .DefaultWeb = Me.txtDefWeb.Text
            .DefaultConst = Me.cmbDefConst.Text
            If Abs(Me.chkAssociate.Value) <> bAssocValue Then
                Call CreateAssociation(Abs(Me.chkAssociate.Value))
            End If
            If .SecTagColor <> Me.shpTag(0).FillColor Or _
                    .KeyTagColor <> Me.shpTag(1).FillColor Or _
                    .ValTagColor <> Me.shpTag(2).FillColor Then
                bWasItChanged = bChanged
                lLineCount = SendMessage(frmMain.rtBox.hwnd, EM_GETLINECOUNT, ByVal 0&, ByVal 0&)
                .SecTagColor = Me.shpTag(0).FillColor
                .KeyTagColor = Me.shpTag(1).FillColor
                .ValTagColor = Me.shpTag(2).FillColor
                For x = -lLineCount To -1
                    frmMain.ColorLine Abs(x)
                Next x
                bChanged = bWasItChanged
            End If
            SaveSetting "ReVive Script Editor", "Config", "TestFileNames", .TestForFileNames
            SaveSetting "ReVive Script Editor", "Config", "DefaultWeb", .DefaultWeb
            SaveSetting "ReVive Script Editor", "Config", "DefaultConst", .DefaultConst
            SaveSetting "ReVive Script Editor", "Config", "SecTagColor", .SecTagColor
            SaveSetting "ReVive Script Editor", "Config", "KeyTagColor", .KeyTagColor
            SaveSetting "ReVive Script Editor", "Config", "ValTagColor", .ValTagColor