frmreg.frm

毕业设计助手源码,用于方便的高效的完成组件注册,项目合并的任务,以提高程序开发效率,使用后,你会发现对你的项目开发设计是个难得的好助手!

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmReg 
   BackColor       =   &H00404040&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "项目助手"
   ClientHeight    =   3150
   ClientLeft      =   5025
   ClientTop       =   3705
   ClientWidth     =   3840
   Icon            =   "frmReg.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "frmReg.frx":0442
   ScaleHeight     =   3150
   ScaleWidth      =   3840
   Begin VB.CommandButton Command2 
      BackColor       =   &H00FFFFFF&
      Caption         =   "退出"
      Height          =   375
      Left            =   2280
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   2040
      Width           =   1335
   End
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   3480
      Top             =   2280
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "关于"
      Height          =   375
      Left            =   2280
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   1560
      Width           =   1335
   End
   Begin VB.Frame FrmBat 
      BackColor       =   &H00FFC0FF&
      Caption         =   "是否显示注册成功选项"
      Height          =   2655
      Left            =   3840
      TabIndex        =   6
      Top             =   240
      Width           =   2055
      Begin VB.TextBox TxtName 
         Alignment       =   2  'Center
         Height          =   375
         Left            =   0
         TabIndex        =   13
         Top             =   1200
         Width           =   2055
      End
      Begin VB.CommandButton CmdCancel 
         BackColor       =   &H00FFC0FF&
         Caption         =   "取消"
         Height          =   375
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   11
         Top             =   2160
         Width           =   1575
      End
      Begin VB.CommandButton CmdOk 
         BackColor       =   &H00FFC0FF&
         Caption         =   "生成批处理"
         Height          =   375
         Left            =   240
         Style           =   1  'Graphical
         TabIndex        =   10
         Top             =   1680
         Width           =   1575
      End
      Begin VB.OptionButton OptShow 
         BackColor       =   &H80000009&
         Caption         =   "显示"
         Height          =   375
         Left            =   0
         Style           =   1  'Graphical
         TabIndex        =   8
         Top             =   720
         Value           =   -1  'True
         Width           =   2055
      End
      Begin VB.OptionButton OptUnShow 
         BackColor       =   &H80000009&
         Caption         =   "不显示"
         Height          =   375
         Left            =   0
         Picture         =   "frmReg.frx":27BB
         Style           =   1  'Graphical
         TabIndex        =   7
         Top             =   240
         Width           =   2055
      End
   End
   Begin VB.CommandButton cmdBe 
      BackColor       =   &H00FFC0FF&
      Caption         =   "文件处理器"
      Height          =   375
      Left            =   2040
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   2640
      Width           =   1455
   End
   Begin VB.CommandButton Cmd 
      BackColor       =   &H00FFC0FF&
      Caption         =   "批处理选项"
      Default         =   -1  'True
      Height          =   375
      Left            =   120
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2640
      Width           =   1575
   End
   Begin MSComDlg.CommonDialog dialog 
      Left            =   2040
      Top             =   3000
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton CmdView 
      BackColor       =   &H00FFFFFF&
      Caption         =   "浏览"
      Height          =   375
      Left            =   2280
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   120
      Width           =   1335
   End
   Begin VB.CommandButton CmdUnReg 
      BackColor       =   &H00FFFFFF&
      Caption         =   "反注册"
      Height          =   375
      Left            =   2280
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   1080
      Width           =   1335
   End
   Begin VB.CommandButton CmdReg 
      BackColor       =   &H00FFFFFF&
      Caption         =   "注册"
      Height          =   375
      Left            =   2280
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   600
      Width           =   1335
   End
   Begin VB.ListBox LstView 
      Height          =   2220
      Left            =   120
      MultiSelect     =   2  'Extended
      TabIndex        =   0
      Top             =   120
      Width           =   2055
   End
   Begin VB.Label lblInf 
      BackColor       =   &H00FFC0FF&
      BackStyle       =   0  'Transparent
      Caption         =   "信息:"
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   2400
      Width           =   1935
   End
End
Attribute VB_Name = "frmReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim flag As Boolean
Dim TPath As String

Private Sub Cmd_Click()
  
    Dim ck As Boolean

    For i = 0 To LstView.ListCount - 1
            If LstView.Selected(i) = True Then
    
                ck = True
            End If
   Next
 

     If ck = False Then
        MsgBox "请选择一个项目", vbInformation + vbOKOnly, "提示"
     Else
           ' FrmBat.Show vbModal
        Me.Width = 6240
    End If
    
End Sub

Private Sub cmdBe_Click()
     FrmBe.Show vbModal
End Sub

Private Sub CmdCancel_Click()
     Me.Width = 3915
End Sub

Private Sub CmdOk_Click()
On Error GoTo err1
    Dim i As Integer
    Dim strBat As String
    Dim fileNumber As Integer
    Dim tempFile As String
    
    If Trim(TxtName.Text) <> "名为:组件注册批" And Trim(TxtName.Text) <> Empty Then
        tempFile = Trim(TxtName.Text)
    Else
        tempFile = "组件注册批"
        MsgBox "文本框内容为空，该批处理将以组件注册批为名，进行保存!", vbInformation, "提示"
    End If
    
    fileNumber = FreeFile

    Open App.Path & "\" & tempFile & ".bat" For Output As #fileNumber
        For i = 0 To LstView.ListCount - 1
            If LstView.Selected(i) = True Then
'                If flag = False Then
                    If OptShow.Value = True Then
                         Print #fileNumber, "regsvr32 " & LstView.List(i) & vbCrLf
                    Else
                         Print #fileNumber, "regsvr32 " & LstView.List(i) & "  /s" & vbCrLf
                    End If
'                Else
'                    If OptUnShow.Value = True Then
'                       Print #5, "regsvr32 " & LstView.List(i) & vbCrLf
'                    Else
'                       Print #5, "regsvr32 " & LstView.List(i) & "  /s" & vbCrLf
'                    End If
'                End If
            End If
      Next
    Close #fileNumber
  
     Me.Width = 3915
     MsgBox "成功写入批处理文件到当前路径！", vbInformation, "成功"
     Exit Sub
err1:
    MsgBox Err.Description
End Sub

Private Sub CmdReg_Click()
On Error GoTo err1:
    Dim i As Integer
    Dim ck As Boolean
    
   
    
    For i = 0 To LstView.ListCount - 1
        If LstView.Selected(i) = True Then
            If flag = False Then
                Shell "regsvr32 " & App.Path & "\" & LstView.List(i)
            Else
               Shell "regsvr32 " & TPath & "\" & LstView.List(i)
            End If
            ck = True
        End If

    Next
    
     If ck = False Then
        MsgBox "请选择一个项目", vbInformation + vbOKOnly, "提示"
    End If
    
    Exit Sub
err1:
    MsgBox Err.Description
End Sub

Private Sub CmdUnReg_Click()
On Error GoTo err1:
    Dim i As Integer
    Dim ck As Boolean
    
    For i = 0 To LstView.ListCount - 1
        If LstView.Selected(i) = True Then
          If flag = False Then
                Shell "regsvr32 -u " & App.Path & "\" & LstView.List(i)
          Else
              Shell "regsvr32 -u " & TPath & "\" & LstView.List(i)
          End If
            ck = True
        End If
        
    Next
    
      If ck = False Then
        MsgBox "请选择一个项目", vbInformation + vbOKOnly, "提示"
    End If
    
    Exit Sub
err1:
    MsgBox Err.Description
End Sub

Private Sub CmdView_Click()
 On Error GoTo err1:
    Dim i As Integer
 
    
    dialog.ShowOpen
     If dialog.filename <> Empty Then
        flag = True
    Else
      
        flag = False
        LstView.Clear
        Call Form_Load
        Exit Sub
    End If
    
    TPath = dialog.filename
    TPath = Replace(TPath, dialog.FileTitle, "")
    TPath = Left(TPath, Len(TPath) - 1)
    LstView.Clear
   
    
    Call Form_Load
     
    Exit Sub
err1:
   MsgBox Err.Description
End Sub

Private Sub Command1_Click()
    FrmAbout.Show
    Me.Hide
End Sub

Private Sub Command2_Click()
    End
End Sub

Private Sub Form_Load()
On Error GoTo err1:
    Dim filename As String
    Dim flagNo As Boolean
    Dim i As Integer
    '用于记录各种文件的数量
    Dim ocxNumber As Integer
    Dim dllNumber As Integer
    
    If flag = True Then
       filename = Dir(TPath & "\*.dll")
    Else
       filename = Dir(App.Path & "\*.dll")
    End If
   
   If filename <> Empty Then LstView.AddItem filename
    
    While filename <> Empty
    
        filename = Dir
        If Trim(filename) <> Empty Then LstView.AddItem filename
    
    Wend
    
    For i = 0 To LstView.ListCount
        If LstView.List(i) <> Empty Then flagNo = True
    Next
    dllNumber = LstView.ListCount
    
    If flagNo = False And ocx = False Then LstView.AddItem "当前路径下无dll、ocx文件!"
   
    TxtName.Text = "名为:组件注册批"
    
    ocxNumber = LstView.ListCount - dllNumber
    
    If flagNo = False And ocx = False Then ocxNumber = 0
    
    lblInf.Caption = lblInf.Caption & "   dll:" & dllNumber
    ' Cmd.Caption = "批处理选项"
    Exit Sub
err1:
    MsgBox "出现异常错误，系统将退出!!", vbCritical, "错误"
End Sub
Private Function ocx()
    Dim filename As String
    Dim i As Integer
    
    If flag = True Then
       filename = Dir(TPath & "\*.ocx")
    Else
       filename = Dir(App.Path & "\*.ocx")
    End If
   
   If filename <> Empty Then LstView.AddItem filename
    
    While filename <> Empty
    
        filename = Dir
        If Trim(filename) <> Empty Then LstView.AddItem filename
    
    Wend
    
    For i = 0 To LstView.ListCount
        If LstView.List(i) <> Empty Then ocx = True
    Next
   
   

End Function
Private Sub OptShow_Click()
  '  Me.Width = 3915
   ' Cmd.Caption = " 批处理选项"
End Sub

Private Sub OptUnShow_Click()
   'Me.Width = 3915
   ' Cmd.Caption = " 批处理选项"
End Sub

Private Sub Timer1_Timer()
    Static i As Integer
    i = i + 1
    Select Case i
        Case 1
            cmdBe.BackColor = &HFFC0FF
        Case 2
            cmdBe.BackColor = RGB(0, 200, 0)
        Case 3
           cmdBe.BackColor = RGB(0, 250, 0)
        Case 4
            cmdBe.BackColor = RGB(0, 240, 0)
        Case 5
            i = 0
  End Select
End Sub

Private Sub TxtName_GotFocus()
     If TxtName.Text = "名为:组件注册批" Then TxtName.Text = Empty
End Sub