modupdate.bas

VB开发的自动更新程序

            'call to GetTokenInformation fails
            'since the buffer size is unspecified.
            'On failure the correct buffer size
            'is returned (cbBuff), and a subsequent call
            'is made to return the data.
             res = GetTokenInformation(hToken, _
                                       TokenGroups, _
                                       TG, _
                                       tiLen, _
                                       cbBuff)
            If res = 0 And cbBuff > 0 Then
                tiLen = cbBuff
                res = GetTokenInformation(hToken, _
                                          TokenGroups, _
                                          TG, _
                                          tiLen, _
                                          cbBuff)
                If res = 1 And tiLen > 0 Then
                    'The SID_IDENTIFIER_AUTHORITY (SIA) structure
                    'represents the top-level authority of a
                    'security identifier (SID). By specifying
                    'we want admins (by setting the value of
                    'the fifth item to SECURITY_NT_AUTHORITY),
                    'and passing the relative identifiers (RID)
                    'DOMAIN_ALIAS_RID_ADMINS  and
                    'SECURITY_BUILTIN_DOMAIN_RID, we obtain
                    'the SID for the administrators account
                    'in lSid
                     SIA.Value(5) = SECURITY_NT_AUTHORITY
                     res = AllocateAndInitializeSid(SIA, 2, _
                                                    SECURITY_BUILTIN_DOMAIN_RID, _
                                                    DOMAIN_ALIAS_RID_ADMINS, _
                                                    0, 0, 0, 0, 0, 0, _
                                                    lSid)
                    If res = 1 Then
                        'Now obtain the name of the account
                        'pointed to by lSid above (ie
                        '"Administrators"). Note vbNullString
                        'is passed as lpSystemName indicating
                        'the SID is looked up on the local computer.
                        '
                        'Re sDomainName: On Win NT+ systems, the
                        'domain name returned for most accounts in
                        'the local computer's security database is
                        'the computer's name as of the last start
                        'of the system (backslashes excluded). If
                        'the computer's name changes, the old name
                        'continues to be returned as the domain
                        'name until the system is restarted.
                        '
                        'On Win NT+ Server systems, the domain name
                        'returned for most accounts in the local
                        'computer's security database is the
                        'name of the domain for which the server is
                        'a domain controller.
                        '
                        'Some accounts are predefined by the system.
                        'The domain name returned for these accounts
                        'is BUILTIN.
                        '
                        'sAcctName is the value of interest in this
                        'exercise.
                         sAcctName1 = Space$(255)
                         sDomainName = Space$(255)
                         cbAcctName = 255
                         cbDomainName = 255
                         res = LookupAccountSid(vbNullString, _
                                                lSid, _
                                                sAcctName1, _
                                                cbAcctName, _
                                                sDomainName, _
                                                cbDomainName, _
                                                peUse)
                        If res = 1 Then
                            'In the call to GetTokenInformation above,
                            'the TOKEN_GROUP member was filled with
                            'the SIDs of the defined groups.
                            '
                            'Here we take each SID from the token
                            'group and retrieve the name of the account
                            'corresponding to the SID. If a SID returns
                            'the same name retrieved above, the user
                            'is a member of the admin group.
                             For cnt = 0 To TG.GroupCount - 1
                                    sAcctName2 = Space$(255)
                                    sDomainName = Space$(255)
                                    cbAcctName = 255
                                    cbDomainName = 255
                                    res = LookupAccountSid(vbNullString, _
                                                           TG.Groups(cnt).Sid, _
                                                           sAcctName2, _
                                                           cbAcctName, _
                                                           sDomainName, _
                                                           cbDomainName, _
                                                           peUse)
                                    If sAcctName1 = sAcctName2 Then
                                       IsAdministrator = True
                                       Exit For
                                    End If   'if sAcctName1 = sAcctName2
                             Next
                        End If  'if res = 1 (LookupAccountSid)
                        FreeSid ByVal lSid
                    End If  'if res = 1 (AllocateAndInitializeSid)
                    CloseHandle hToken
                End If  'if res = 1
            End If  'if res = 0  (GetTokenInformation)
        End If  'if OpenProcessToken
        CloseHandle hProcessID
    End If  'if hProcessID  (GetCurrentProcess)

End Function


'****************************************************************************************
'                               Private Helper Functions
'****************************************************************************************

Private Function WindowsDirectory() As String
'--------------------------------------------------------------
' Purpose   : Returns Windows directory
'--------------------------------------------------------------
Dim path            As String * 255
Dim ReturnLength    As Long
    ReturnLength = GetWindowsDirectory(path, Len(path))
    WindowsDirectory = Left$(path, ReturnLength)
End Function

Private Function FileInUse(ByVal sFile As String) As Boolean
'---------------------------------------------------------
' Purpose   : Attempts to open sFile in EXCLUSIVE mode.
'             Returns True if fails, False if succeeds.
'---------------------------------------------------------
Dim hf  As Long
Dim fo  As OFSTRUCT
    sFile = Trim$(sFile)
    If Len(sFile) = 0 Or Dir$(sFile, 39) = "" Then Exit Function
    If Right$(sFile, 1) <> Chr(0) Then sFile = sFile & Chr(0)
    fo.cBytes = Len(fo)
    hf = OpenFile(sFile, fo, OF_SHARE_EXCLUSIVE) '---- Attempt EXCLUSIVE File Open
    If hf = -1 And Err.LastDllError = 32 Then
        FileInUse = True '---------------------------- File failed to open (In Use)
    Else
        CloseHandle hf '------------------------------ File was opened (Not In Use)
    End If
End Function

Private Function GetShortName(ByVal sFile As String) As String
'--------------------------------------------------------------------------
' Purpose   : Get Windows short file name (works if file does not exist).
'             This is needed when writing to wininit.ini for Win9X/ME only.
'--------------------------------------------------------------------------
On Error Resume Next
Dim sString     As String * 255
Dim lResult     As Long
Dim bCreated    As Boolean
Dim f           As Integer
    f = FreeFile
    If Dir$(sFile, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
        Open sFile For Output As #f
        Close #f
        bCreated = True
    End If
    lResult = GetShortPathName(sFile, sString, 255)
    GetShortName = Left$(sString, lResult)
    If bCreated Then Call DeleteFile(sFile)
End Function

Private Function AddToWininit(ByVal sSourceFile As String, _
    Optional ByVal sDestinationFile As String = "Nul") As Boolean
'------------------------------------------------------------------------
' Purpose   : Writes files that need replaced or deleted at reboot to the
'             wininit.ini file. ***FOR Win9X AND ME ONLY***
'------------------------------------------------------------------------
On Error GoTo Errs
Dim sFile       As String '-------- Path for wininit.ini
Dim f           As Long '---------- Freefile assignment
Dim line        As String '-------- Current line from wininit.ini
Static bFound   As Boolean '------- True if [Rename] section was located
    sFile = WindowsDirectory & "\wininit.ini"
    '//Skip this block if previously done for another entry
    If Not bFound Then
        '//See if wininit.ini file exist in the Windows directory, create it if not
        If Dir$(sFile, vbArchive + vbHidden + vbNormal + vbReadOnly + vbSystem) = "" Then
            f = FreeFile
            Open sFile For Random As #f
            Close #f
        End If
        '//Scan wininit.ini for a rename section
        f = FreeFile
        Open sFile For Input As #f
        Do While Not EOF(f)
            Line Input #f, line
            If InStr(1, UCase$(line), "[RENAME]", vbTextCompare) Then
                bFound = True
                Exit Do
            End If
        Loop
        Close #f
    End If
    '//Append rename section with passed file to delete or replace at reboot.
    f = FreeFile
    Open sFile For Append As #f
    If Not bFound Then Print #f, "[Rename]"
    Print #f, sDestinationFile & "=" & sSourceFile
    bFound = True
    Close #f
    AddToWininit = True
Errs:
    If Err Then Exit Function
End Function

Private Function CreatePath(ByVal sPath As String) As Boolean
'---------------------------------------------------------------------
' Purpose   : Checks if sPath will pass Windows file and folder naming
'             convention rules, and if so creates the path.
'---------------------------------------------------------------------
On Error GoTo Errs
Dim sFolders()  As String
Dim sNewPath    As String
Dim x           As Long
Dim ub          As Long
    If IsLocalPathValid(sPath, True) Then '-------------- Check naming conventions, etc.
        sFolders = Split(sPath, "\") '------------------- Parse drive and folders
        ub = UBound(sFolders)
        sNewPath = sFolders(0) '------------------------- Extract drive and check for existence
        If Dir$(sNewPath, 63) <> "" Then
            If ub Then
                For x = 1 To ub '------------------------ Create path one folder at a time
                    sNewPath = sNewPath & "\" & sFolders(x)
                    If Dir$(sNewPath, vbDirectory) = "" Then MkDir$ sNewPath
                Next x
                CreatePath = True
            End If
        End If
    End If
Errs:
    If Err Then Exit Function
End Function