Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/pgm_util/editbats/editbats.frm

Visual Basic Form | 1994-12-27 | 25.4 KB | 575 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Form1"
   ClientHeight    =   3555
   ClientLeft      =   2265
   ClientTop       =   2475
   ClientWidth     =   7515
   ClipControls    =   0   'False
   Height          =   3960
   Left            =   2205
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3555
   ScaleWidth      =   7515
   Top             =   2130
   Width           =   7635
   Begin TextBox Text1
      Height          =   1005
      Left            =   1770
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   795
      Width           =   3150
   End
   Begin CommandButton BTN_Read
      Caption         =   "Read Docs"
      Height          =   500
      Left            =   3100
      TabIndex        =   3
      Top             =   3000
      Width           =   1215
   End
   Begin CommandButton BTN_Quit
      Caption         =   "Quit"
      Height          =   500
      Left            =   4800
      TabIndex        =   2
      Top             =   3000
      Width           =   1215
   End
   Begin CommandButton BTN_Proceed
      Caption         =   "Proceed"
      Height          =   500
      Left            =   1400
      TabIndex        =   1
      Top             =   3000
      Width           =   1215
   End
   Begin Label Label1
      Caption         =   "Label1"
      Height          =   2925
      Left            =   30
      TabIndex        =   0
      Top             =   30
      Width           =   7470
   End
'Function Declarations
Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
Declare Function FindExecutable Lib "shell.dll" (ByVal lpszFile$, ByVal lpszDir$, ByVal lpszResult$) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
Declare Function PostMessageByString% Lib "User" Alias "PostMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam$)
Declare Function ExitWindows Lib "User" (ByVal RestartCode As Long, ByVal DOSReturnCode As Integer) As Integer
Declare Function GetVersion Lib "Kernel" () As Long
Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Integer
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' API functions used in getting user and company name
Declare Function LoadLibrary% Lib "Kernel" (ByVal LibFileName$)
Declare Sub FreeLibrary Lib "Kernel" (ByVal hInst%)
Declare Function LoadString% Lib "User" (ByVal hInst%, ByVal idResource%, ByVal Buffer$, ByVal cBuffer%)
'Constants
Const HWND_BROADCAST = &HFFFF
Const WM_WININICHANGE = &H1A
Const WM_USER = &H400
Const EM_SETREADONLY = WM_USER + 31
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060
'Variables
Dim ProgramName As String
Dim CRLF As String
Dim UserName As String
Dim IsWin31 As Integer
Dim GroupName As String
Dim FMFlag As Integer
Sub BTN_Proceed_Click ()
    'Check if File Manager is running
    FMFlag = CloseFileMan()
    'Call the function which determines if and what app is
    'associated with the .txt extension
    TestResult = PerformTest()
    'If Text files are not associated with any app and the
    'user chose not to make an association, end the program.
    If TestResult = 4 Then Unload Me
    Dim WinDir1 As String * 128
    Dim WinDirSize As Integer
    WinDirSize = 128
    'Get the Windows directory, variables must be defined as above
    Ret = GetWindowsDirectory(WinDir1, WinDirSize)
    WinDir = LCase(Left$(WinDir1, Ret))

    'Change to the Windows directory and make backup files
    'of WIN.INI and REG.DAT
    ChDir WinDir
    'Before backing up the files, check if the backup filenames already exist
    If FileExists("reg.bak") Then
        Msg$ = "REG.BAK already exists in your Windows directory." + CRLF + CRLF
        Msg$ = Msg$ + "OK to overwrite?"
        Ans% = MsgBox(Msg$, 52, "File Exists")
    End If
    If Ans% <> 7 Then
        FileCopy "reg.dat", "reg.bak"
        RegBackedUp = True
    End If
    Ans% = 0  'Reset variable
    If FileExists("win.bak") Then
        Msg$ = "WIN.BAK already exists in your Windows directory." + CRLF + CRLF
        Msg$ = Msg$ + "OK to overwrite?"
        Ans% = MsgBox(Msg$, 52, "File Exists")
    End If
    If Ans% <> 7 Then
        FileCopy "win.ini", "win.bak"
        WinBackedUp = True
    End If

    'Inform the user of completed step
    If RegBackedUp Then
        Msg$ = "Your original REG.DAT file has been backed up to REG.BAK." + CRLF + CRLF
    Else
        Msg$ = "Your original REG.DAT file was NOT backed up because REG.BAK already exists." + CRLF + CRLF
    End If
    If WinBackedUp Then
        Msg$ = Msg$ + "Your original WIN.INI has been backed up to WIN.BAK."
    Else
        Msg$ = Msg$ + "Your original WIN.INI file was NOT backed up because WIN.BAK already exists."
    End If
    MsgBox Msg$, 64, "Batch File Configuration"
    'Modify the WIN.INI file
    a% = WriteProfileString("windows", "programs", "com exe pif")
    If a% Then
        'Inform the user of completed step
        Msg$ = "WIN.INI has been successfully updated."
        MsgBox Msg$, 64, "Batch File Configuration"
        di% = PostMessageByString(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
    Else
        'If the function was unsuccesful, inform the user, restore the original
        'WIN.INI, delete the backup files and end the program
        'It is not necessary to restore REG.DAT because it hasn't been altered yet.
        Msg$ = "WIN.INI could not be updated.  Aborting procedure.  " + CRLF
        Msg$ = Msg$ + "Your original WIN.INI and REG.DAT files have been restored."
        FileCopy "win.bak", "win.ini"
        Kill "reg.bak"
        Kill "win.bak"
        MsgBox Msg$, 48, "Batch File Configuration"
        Unload Me
    End If
    'Change to the program's directory
    ChDir app.Path
    'Create the appropriate .REG file based on the test result done earlier
    Select Case TestResult
    Case 1
        FileNum = FreeFile
        Open "batch.reg" For Output As FileNum
        Print #FileNum, "REGEDIT"
        Print #FileNum, "HKEY_CLASSES_ROOT\.bat = txtfile"
        Close FileNum
    Case 2
        FileNum = FreeFile
        Open "batch.reg" For Output As FileNum
        Print #FileNum, "REGEDIT"
        Print #FileNum, "HKEY_CLASSES_ROOT\.bat\shell\open\command = " & ProgramName & " %1"
        Close FileNum
    Case 3
        FileNum = FreeFile
        Open "batch.reg" For Output As FileNum
        Print #FileNum, "REGEDIT"
        Print #FileNum, "HKEY_CLASSES_ROOT\txtfile = Text File"
        Print #FileNum, "HKEY_CLASSES_ROOT\.bat = txtfile"
        Print #FileNum, "HKEY_CLASSES_ROOT\.ini = txtfile"
        Print #FileNum, "HKEY_CLASSES_ROOT\.txt = txtfile"
        Print #FileNum, "HKEY_CLASSES_ROOT\txtfile\shell\print\command = notepad.exe /p %1"
        Print #FileNum, "HKEY_CLASSES_ROOT\txtfile\shell\open\command = notepad.exe %1"
        Close FileNum
    End Select
    'Allow Windows time to process file i/o
    DoEvents
    'Shell to the Registration Editor program, using the file just created
    'as a command line argument.  This will automatically update the Registration
    'Database
    x% = Shell("regedit.exe " + app.Path + "\BATCH.REG")

    'Wait for the user to click the Registration Database's OK button
    'before continuing with the program.
    While GetModuleUsage(x%) > 0
        Z% = DoEvents()
        'Disable the form so the user cannot interact with it
        Form1.Enabled = False
    Wend
    'Delete the file that was just created
    Kill "batch.reg"
    'Re-Enable the form
    Form1.Enabled = True
    'Call the subroutine asking the user whether to change ProgMan's caption
    ChangeProgMan
    'Prompt the user to restart Windows.  While it's not absolutely necessary to restart
    'since the change to WIN.INI is broadcast to all apps and the Registration
    'Editor automatically broadcasts, it's better to do so, if for no other reason
    'than to update ProgMan's caption (if the user chose to do this).  Also, if
    'File Manager was running during this procedure, the document-file icons will
    'not be updated until FM is restarted, even though the association does exist.
    Msg$ = "Windows should now be restarted to verify that all is well.  "
    Msg$ = Msg$ + "If Windows fails to restart, change to your Windows directory "
    Msg$ = Msg$ + "and rename REG.BAK and WIN.BAK to REG.DAT and WIN.INI.  This "
    Msg$ = Msg$ + "will restore your original configuration."
    If MsgBox(Msg$, 4 + 32 + 256, "Batch File Configuration") <> 6 Then
         'If the answer was NO, simply end the program
         Unload Me
    End If
    'Call the function to restart Windows
    i = ExitWindows(66, 0)
    'The function will return 0 if any app fails to close
    If i = 0 Then
        'Inform the user to close Windows normally
        Msg$ = "One or more applications refused to terminate.  This is "
        Msg$ = Msg$ + "probably due to a DOS program that is running in the "
        Msg$ = Msg$ + "background or a Windows program that has unsaved data.  "
        Msg$ = Msg$ + "Click OK, then shut down "
        Msg$ = Msg$ + "and restart Windows manually."
        MsgBox Msg$, 48, "Batch File Configuration"
    End If
    'Unload the form and end the program
    Unload Me
End Sub
Sub BTN_Quit_Click ()
    Unload Me
End Sub
Sub BTN_Read_Click ()
    On Error Resume Next
    Dim FileText As String
    FileNum = FreeFile
    FileText = ""
    FileName$ = app.Path + "\editbats.txt"
    'Open the file for reading
    Open FileName$ For Input As FileNum
    If Err Then
        Close
        MsgBox "Error opening " + FileName$ + CRLF + CRLF + Error$, 64
        Exit Sub
    End If
    'Read each line into a buffer then assign that buffer to a variable and
    'append a carriage return and line feed at the end of each line
    Do Until EOF(FileNum)
        Line Input #FileNum, a$
        FileText = FileText + a$ + CRLF
    Loop
    Close FileNum
    'Set the dimmensions of the text box the same as the label
    Text1.Width = Label1.Width
    Text1.Height = Label1.Height
    Text1.Top = Label1.Top
    Text1.Left = Label1.Left
    'Assign the contents of the file to the text box
    Text1 = FileText
    'Unhide the text box
    Text1.Visible = True
    'Enable the Proceed button
    BTN_Proceed.Enabled = True
    'Disable the Read Docs button
    BTN_Read.Enabled = False
End Sub
Sub ChangeProgMan ()
    Msg$ = "Want to personalize Program Manager a bit?" + CRLF + CRLF
    Msg$ = Msg$ + "Click the Yes Button to change Program Manager's caption "
    Msg$ = Msg$ + "from reading ""Program Manager"" to ""<yourname>'s Desktop.""" + CRLF + CRLF
    Msg$ = Msg$ + "This is accomplished simply by adding an icon for Program Manager "
    Msg$ = Msg$ + "to the Startup group and changing the Description that appears in "
    Msg$ = Msg$ + "the Program Item Properties box."
    Ans% = MsgBox(Msg$, 36, "Personalize Program Manager")
    'If NO was chosen, exit the sub
    If Ans% = 7 Then
        Exit Sub
    End If

    'Call the sub which gets the name of the user from Windows' resources
    GetUserName
    'If the user had clicked the Cancel button in either of the Input Boxes,
    'UserName will be a zero-length string.  Check this and exit the sub, if
    'appropriate
    If UserName = "" Then
        Exit Sub
    End If
    'The CreateProgManItem sub uses this variable
    GroupName = "Startup"
    'Call the sub which creates the Startup group.  There is no harm in doing this
    'even if the Startup group already exists.
    Call CreateProgManGroup(Form1, GroupName, GroupName + ".grp")
    'Call the sub which creates the Program Manager icon in the Startup group
    Call CreateProgManItem(Form1, "progman.exe", UserName + "'s Desktop")
End Sub
Function CloseFileMan ()
    'This function will return TRUE only if File Manager was running and closed,
    'It returns FALSE for any other condition.
    'This value is then used to determine if the program should later restart FM.
    CloseFileMan = False
    'Check to see if File Manager is running
    FileManHandle = FindWindow("WFS_FRAME", "File Manager")
    If FileManHandle Then
        'If it is, prompt to close it
        Msg$ = "It has been detected that File Manager is currently running.  "
        Msg$ = Msg$ + "While this in no way interferes with the procedure, File "
        Msg$ = Msg$ + "Manager should be closed and re-started so that the "
        Msg$ = Msg$ + "document-file icons are properly updated." + CRLF + CRLF
        Msg$ = Msg$ + "Click OK to close File Manager and have it automatically "
        Msg$ = Msg$ + "restarted upon completion, or click Cancel to leave File "
        Msg$ = Msg$ + "Manager running."
        Ans% = MsgBox(Msg$, 65, "File Manager Running")

        If Ans% = 1 Then  'OK was clicked
            'Send a system message ordering FM to close.  Zero is returned
            'if FM process the message.
            Success% = SendMessage(FileManHandle, WM_SYSCOMMAND, SC_CLOSE, 0)
            If Success% <> 0 Then
                Msg$ = "File Manager failed to close." + CRLF
                Msg$ = Msg$ + "Click OK and continue with the procedure.  You will "
                Msg$ = Msg$ + "have to close and re-start File Manager manually."
                MsgBox Msg$, 16, "File Manager Running"
            Else
                CloseFileMan = True
            End If
        End If
    End If
End Function
Sub CreateProgManGroup (x As Form, GroupName$, GroupPath$)
'This sub and CreateProgManItem were taken directly from VB's
'Setup program example
'-------------------------------------------------------------
' Procedure: CreateProgManGroup
' Arguments: X           The Form where a Label1 exist
'            GroupName$  A string that contains the group name
'            GroupPath$  A string that contains the group file
'                        name  ie 'myapp.grp'
'-------------------------------------------------------------
    Screen.MousePointer = 11
    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next
    '--------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '--------------------------------
    x.Label1.LinkTopic = "ProgMan|Progman"
    x.Label1.LinkMode = 2
    For i% = 1 To 10                                         ' Loop to ensure that there is enough time to
      Z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    x.Label1.LinkTimeout = 100
    '---------------------
    ' Create program group
    '---------------------
    x.Label1.LinkExecute "[CreateGroup(" + GroupName$ + Chr$(44) + GroupPath$ + ")]"
    '-----------------
    ' Reset properties
    '-----------------
    x.Label1.LinkTimeout = 50
    x.Label1.LinkMode = 0
    Screen.MousePointer = 0
End Sub
'----------------------------------------------------------
' Procedure: CreateProgManItem
' Arguments: X           The form where Label1 exists
'            CmdLine$    A string that contains the command
'                        line for the item/icon.
'                        ie 'c:\myapp\setup.exe'
'            IconTitle$  A string that contains the item's
'                        caption
'----------------------------------------------------------
Sub CreateProgManItem (x As Form, CmdLine$, IconTitle$)
    Screen.MousePointer = 11
    '----------------------------------------------------------------------
    ' Windows requires DDE in order to create a program group and item.
    ' Here, a Visual Basic label control is used to generate the DDE messages
    '----------------------------------------------------------------------
    On Error Resume Next
    '---------------------------------
    ' Set LinkTopic to PROGRAM MANAGER
    '---------------------------------
    x.Label1.LinkTopic = "ProgMan|Progman"
    x.Label1.LinkMode = 2
    For i% = 1 To 10                                         ' Loop to ensure that there is enough time to
      Z% = DoEvents()                                        ' process DDE Execute.  This is redundant but needed
    Next                                                     ' for debug windows.
    x.Label1.LinkTimeout = 100
    '------------------------------------------------
    ' Create Program Item, one of the icons to launch
    ' an application from Program Manager
    '------------------------------------------------
    x.Label1.LinkExecute "[ShowGroup(" + GroupName + ", 1)]"       ' This will ensure that Program Manager does not
    If IsWin31 Then
        ' Win 3.1 has a ReplaceItem, which will allow us to replace existing icons
        x.Label1.LinkExecute "[ReplaceItem(" + IconTitle$ + ")]"
    End If                                                                ' have a Maximized group, which causes problem in RestoreProgMan
    x.Label1.LinkExecute "[AddItem(" + CmdLine$ + Chr$(44) + IconTitle$ + Chr$(44) + ",,)]"
    '-----------------
    ' Reset properties
    '-----------------
    x.Label1.LinkTimeout = 50
    x.Label1.LinkMode = 0
    Screen.MousePointer = 0
End Sub
Function FileExists (FileName As String) As Integer
    'This sub checks for the existance of any filename passed to it
    If Len(Dir$(FileName)) Then
        FileExists = True
    Else
        FileExists = False
    End If
End Function
Function FixAmpersand$ (ByVal Buffer As String)
  'Sometimes an ampersand (&) is included in the string.
  'This function will get rid of it and also any characters
  'that have no graphical representation (such as TAB or
  'Carriage Return) at the end of the name.
  Dim N%
  N = 1
  Do Until N = 0
    N = InStr(N, Buffer, "&")
    If N > 0 Then
      Buffer = Left$(Buffer, N) + Mid$(Buffer, N)
      N = N + 2
    End If
  Loop
  Do While Right$(Buffer, 1) = Chr$(0)
    Buffer = Left$(Buffer, Len(Buffer) - 1)
  Loop
  FixAmpersand = Buffer
End Function
Sub Form_Load ()
    'Get the Windows version
    VerInfo& = GetVersion()
    WinVer& = VerInfo& And &HFFFF&
    If Val(Format$(WinVer& Mod 256) + "." + Format$(WinVer& \ 256)) >= 3.1 Then
        IsWin31 = True
    End If
    'Center the form on the desktop
    Move (Screen.Width - Width) \ 2, ((Screen.Height - Height) \ 2 - 200)
    'Define a Carriage Return and Line Feed
    CRLF = Chr$(13) + Chr$(10)
    'Set the form's caption
    Form1.Caption = "Batch File Configuration"
    'Define message and assign it to the label
    Msg$ = "This program alters important Windows configuration files.  "
    Msg$ = Msg$ + "Your original files will be backed up before any changes "
    Msg$ = Msg$ + "are made to them." + CRLF + CRLF
    Msg$ = Msg$ + "Before you can continue with the process, you MUST read "
    Msg$ = Msg$ + "the text file by clicking on the Read Docs button." + CRLF + CRLF
    Msg$ = Msg$ + "After reading the documentation, click the Proceed "
    Msg$ = Msg$ + "button to continue or the Quit button "
    Msg$ = Msg$ + "to cancel." + CRLF + CRLF
    Msg$ = Msg$ + "Once you have started the process, you must complete it.  "
    Msg$ = Msg$ + "You cannot cancel after clicking on Proceed, so be sure "
    Msg$ = Msg$ + "that you understand what changes are being made." + CRLF + CRLF
    Msg$ = Msg$ + "After receiving confirmation of the procedure, you should "
    Msg$ = Msg$ + "restart Windows." + CRLF + CRLF
    Label1 = Msg$
    'Disable the Proceed button
    BTN_Proceed.Enabled = False
    'Make the text box READONLY
    a% = SendMessage(Text1.hWnd, EM_SETREADONLY, True, 0&)
    'Hide the text box
    Text1.Visible = False
End Sub
Sub Form_Unload (Cancel As Integer)
    'Make sure that all files have been closed
    Close
    'If File Manager was running prior to this program and closed,
    'restart it.
    If FMFlag Then
        x% = Shell("winfile.exe", 1)
    End If
    End
End Sub
Sub GetUserName ()

        'Get access to USER's strings by getting a handle to USER
        Dim hInstUser As Integer
        hInstUser = LoadLibrary("USER")
        FreeLibrary hInstUser

        Dim Buffer As String, Success As Integer, N As Integer

        'Get the User name
        'The string used to hold the name must be fixed-length
        Buffer = String$(31, 0)
        If LoadString(hInstUser, 514, Buffer, 30) Then
            UserName = Trim(FixAmpersand(Buffer))

            'Trim it down to just the first name
            SpacePos = InStr(UserName, " ")
            UserName = Left$(UserName, SpacePos - 1)
            'Verify the users' name that was retrieved.
            'Most users probably used their full name when installing
            'Windows, but would rather use a shorter name for this.
            'For example, I used "Michael" during my Windows installation,
            'but prefer to use "Mike".  So why even go through the process
            'of getting the user's name?  Well, it looks good! :)
            Msg$ = "Click OK to use the name below or type in a new first name."
            UserName = InputBox$(Msg$, "Personalize Program Manager", UserName)
        Else
            'For some reason, a name couldn't be found, so prompt for it
            Msg$ = "Could not find the name of the person this copy of Windows is registered to." + CRLF
            Msg$ = Msg$ + "Please type in your first name."
            UserName = InputBox(Msg$, "Personalize Program Manager")
        End If
End Sub
Function PerformTest ()
    'Returns 1 if text files are associated with Notepad
    'Returns 2 if text files are associated with an application other than Notepad
    'Returns 3 if an association was not found and user chooses to make the association
    'Returns 4 if an association was not found and user chooses to not make the association
    'This variable must be a fixed-length string
    Dim Association As String * 129
    'This function will find what app is associated with a given extension
    x% = FindExecutable("editbats.txt", app.Path, Association)
    'A character which has an ANSI value of 0 separates the executable
    'filename from the specified filename.  Use this to strip away the
    'executable filename
    NullPos = InStr(Association, Chr$(0))
    If NullPos = 1 Then
        'If the string begins with ANSI Code 0,
        'an association does not exist.  Create
        'a zero-length string.
        ProgramName = ""
    Else
        ProgramName = Mid$(Association, 1, NullPos - 1)
    End If
    If LCase$(Left$(ProgramName, 7)) = "notepad" Then
        'Text files are associated with Notepad.  This is
        'Windows default association.
        Msg$ = "Your system associates text files with Notepad." + CRLF
        Msg$ = Msg$ + "Batch files will also be associated with Notepad."
        MsgBox Msg$, 64, "Association Found"
        PerformTest = 1
    ElseIf Len(ProgramName) Then
        'Text files are associated with a different program.
        Msg$ = "Your system associates text files with the following program:" + CRLF + CRLF
        Msg$ = Msg$ + UCase$("                                     " + ProgramName + CRLF + CRLF)
        Msg$ = Msg$ + "Batch files will also be associated with " + UCase$(ProgramName) + "."
        MsgBox Msg$, 64, "Association Found"
        PerformTest = 2
    Else
        'An association was not found, so ask the user if Windows default
        'association should be created.
        Msg$ = "Your system contains no association between text files and an"
        Msg$ = Msg$ + " application.  Do you want to create an association "
        Msg$ = Msg$ + "between Notepad and the following extensions?" + CRLF + CRLF
        Msg$ = Msg$ + "                          *.txt" + CRLF
        Msg$ = Msg$ + "                          *.bat" + CRLF
        Msg$ = Msg$ + "                          *.ini" + CRLF
        a% = MsgBox(Msg$, 52, "Association not Found")

        If a% = 6 Then
            'If the user answered YES...
            PerformTest = 3
        Else
            'If the user answered NO...
            PerformTest = 4
        End If
    End If
End Function