frmmain.frm

主要是对文件的一些操作:加密、解密文件

    Select Case SelList
      Case PtJiami, PtJiemi, EXEJiami, EXEJiemi
        If SelList <= UBound(AllInfo) Then                  '判断选择的列表框内是否有数据
            With AllInfo(SelList)
                .data(.SelectListIndex) = .data(.FileNum)   '将最后一个变量复制到选定的变量里
                .FileNum = .FileNum - 1                     '使文件数减少一个
                ReDim Preserve .data(.FileNum)              '重定义动态数组为.filenum个元素
            End With
            RestList                                        '刷新列表
        End If
    
      Case RenNames
        cmd_ren_DelFile_Click
      Case CutFiles
        Del_fg_Item
    End Select

End Sub

Private Sub mnuJoin_Click()

  '通过选择的列表框调用响应的添加文件按钮

    Select Case SelList
      Case PtJiami
        cmd_jia_FileName_Click
      Case PtJiemi
        cmd_jie_FileName_Click
      Case EXEJiami
        cmd_EXEjia_FileName_Click
      Case EXEJiemi
        cmd_EXEjie_FileName_Click
      Case RenNames
        cmd_ren_JoinFile_Click
      Case CutFiles
        cmd_fg_File_Click
    End Select

End Sub

Private Sub mnuKillAll_Click()

  '清空选择的列表框

    Select Case SelList
      Case PtJiami, PtJiemi, EXEJiami, EXEJiemi
        If SelList <= UBound(AllInfo) Then  '判断选择的列表框内是否有数据
            ReDim AllInfo(SelList).data(0)  '重定义数组元素为1个
            AllInfo(SelList).FileNum = 0    '文件数设为0个
            RestList                        '刷新列表
        End If
      Case RenNames
        RenName.FileNum = 0
        ReDim RenName.data(0)
        lst_ren_File.Clear
      Case CutFiles
        CutFile.FileNum = 0
        ReDim CutFile.data(0)
        lst_fg_File.Clear
        txt_fg_FileName = ""
        txt_fg_SaveFolder = ""
        CutFile.SelectListIndex = 0
    End Select
        
    
End Sub

Private Sub mnuRest_Click()

  Dim i As Long

    '刷新列表框
    Select Case SelList
      Case PtJiami, PtJiemi, EXEJiami, EXEJiemi
        If SelList <= UBound(AllInfo) Then
            RestList
        End If
      Case RenNames
        ShowRenFile
      Case CutFiles
        lst_fg_File.Clear
        For i = 1 To CutFile.FileNum
            lst_fg_File.AddItem CutFile.data(i).SoureName
        Next i
        If CutFile.FileNum > 0 Then
            lst_fg_File.ListIndex = 0
        End If
    End Select

End Sub

'*************************************************************************
'**  自定义函数、过程
'*************************************************************************

'*************************************************************************
'**函 数 名：MakeAutoCompExe
'**输    入：InFile(String)
'**        ：OutFile(String)
'**输    出：无
'**功能描述：将一个普通加密的文件转换为可脱离本软件单独解密的加密文件(EXE加密用)
'**全局变量：
'**调用模块：
'**作    者：王滋华
'**日    期：2004年03月24日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************

Private Sub MakeAutoCompExe(InFile As String, OutFile As String)

  'InFile                                       '输入文件
  'OutFile                                      '输出文件
  
  Dim Buffer() As Byte                          '缓存数组
  Dim fn1 As Byte                               '文件号1
  Dim fn2 As Byte                               '文件号2
  Dim tmp As String                             '临时字符串变量

    fn1 = FreeFile                              '获取一个没有使用的文件号
    On Error Resume Next                        '设置错误陷阱,发生错误后不理会继续执行下面的代码
      Kill OutFile                              '删除输出文件
    On Error GoTo 0                             '关闭错误陷阱
    Open OutFile For Binary As #fn1             '以二进制方式打开输出文件,fn1是该文件的文件号
    Buffer() = LoadResData(101, "Shell")        '将资源文件里的自定义资源Shell里的101号资源读入缓存数组
    tmp = UBound(Buffer()) + 1                  '计算缓存数组里的元素数
    tmp = tmp & CStr(Len(tmp))                  '将tmp的长度加入字符串tmp的后面
    Put #fn1, , Buffer()                        '将缓存数组中的数据写入文件号为fn1的文件
    fn2 = FreeFile                              '获取一个没有使用的文件号
    Open InFile For Binary As #fn2              '以二进制方式打开输入文件,fn2是该文件的文件号
    ReDim Buffer(1 To LOF(fn2))                 '重定义缓存数组的大小为文件号为fn2的文件的大小
    Get #fn2, , Buffer()                        '将文件号为fn2的文件中的数据读入缓存数组
    Close #fn2                                  '关闭文件号为fn2的文件
    Kill InFile                                 '删除输入文件
    Put #fn1, , Buffer()                        '将缓存数组中的数据写入文件号为fn1的文件
    ReDim Buffer(1 To Len(tmp))                 '重定义缓存数组的大小为tmp的长度
    Buffer() = StrConv(tmp, vbFromUnicode)      '将tmp中的数据转换到缓存数组中
    Put #fn1, , Buffer()                        '将缓存数组中的数据写入文件号为fn1的文件
    Close #fn1                                  '关闭文件号为fn1的文件

End Sub

'*************************************************************************
'**函 数 名：MakeCompFile
'**输    入：InFile(String)  -
'**        ：OutFile(String) -
'**输    出：无
'**功能描述：将加密的EXE文件的加密数据部分提取出来(EXE解密用)
'**全局变量：
'**调用模块：
'**作    者：王滋华
'**日    期：2004年03月29日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub MakeCompFile(InFile As String, OutFile As String)

  'InFile                                       '输入文件
  'OutFile                                      '输出文件
  
  Dim fn As Byte                                '文件号
  Dim meLen As Long                             '输入文件的大小
  Dim Buffer() As Byte                          '缓存数组
  Dim tmp As Byte                               '临时二进制变量
  Dim tmp1 As Long                              '临时长整型变量

    fn = FreeFile                               '获取一个没有使用的文件号
    meLen = FileLen(InFile)                     '获取输入文件的大小
    Open InFile For Binary Access Read As #fn   '以二进制方式打开输入文件,设置为只能读,不能些,文件号为fn
    Get #fn, meLen, tmp                         '将输入文件的最后一个字节读入tmp
    tmp = Val(Chr$(tmp))                        '将tmp里的数据转换为数字
    ReDim Buffer(1 To tmp)                      '重定义缓存数组大小
    Get #fn, meLen - tmp, Buffer()              '从输入文件的meLen-tmp处开始读取数据到buffer()里
    tmp1 = Val(StrConv(Buffer(), vbUnicode))    '将buffer()里的数据转换并储存到tmp1里
    ReDim Buffer(1 To meLen - tmp1 - tmp - 1)   '重定义缓存数组的大小
    Get #fn, tmp1 + 1, Buffer()                 '从输入文件的tmp1+1处开始读取数据到buffer()里
    Close #fn                                   '关闭文件号为fn的文件

    fn = FreeFile                               '获取一个没有使用的文件号
    If Len(Dir$(OutFile)) > 0 Then              '判断输出文件是否存在
        Kill OutFile                            '删除输入文件
    End If
    Open OutFile For Binary As #fn              '以二进制方式打开输出文件
    Put #fn, , Buffer()                         '将buffer里的数据写入输出文件
    Close #fn                                   '关闭文件号为fn的文件

End Sub

'*************************************************************************
'**函 数 名：RestList
'**输    入：无
'**输    出：无
'**功能描述：刷新列表框数据(加密解密用)
'**全局变量：
'**调用模块：
'**作    者：王滋华
'**日    期：2004年03月29日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub RestList()

  Dim i As Long                                         '循环计数器
  Dim rListBox As ListBox                               '列表框变量
  Dim rTextBox() As TextBox                             '文本框变量数组

    Select Case SelList                                 '多分支判断
      Case PtJiami                                      '当sellist里的数据和ptjiami里的数据相同时执行下面的代码
        ReDim rTextBox(1 To 2)                          '定义文本框变量数组大小
        Set rListBox = lst_jia_Name                     '设置列表框变量为列表框lst_jia_Name
        Set rTextBox(1) = txt_jia_FileName              '设置rTextBox(1)为文本框txt_jia_FileName
        Set rTextBox(2) = txt_jia_SaveName              '设置rTextBox(2)为文本框txt_jia_SaveName
      Case PtJiemi
        ReDim rTextBox(1 To 2)
        Set rListBox = lst_jie_Name
        Set rTextBox(1) = txt_jie_FileName
        Set rTextBox(2) = txt_jie_SaveName
      Case EXEJiami
        ReDim rTextBox(1 To 1)
        Set rListBox = lst_EXEjia_Name
        Set rTextBox(1) = txt_EXEjia_FileName
      Case EXEJiemi
        ReDim rTextBox(1 To 1)
        Set rListBox = lst_EXEjie_Name
        Set rTextBox(1) = txt_EXEjie_FileName
    End Select

    rListBox.Clear                                      '清楚列表框变量所代表的列表框

    With AllInfo(SelList)
        For i = 1 To .FileNum                           '开始循环
            rListBox.AddItem .data(i).SoureName         '向rListBox里添加内容
        Next i                                          '循环结束
        If .FileNum > 0 Then
            rTextBox(1) = .data(1).SoureName
            If UBound(rTextBox) > 1 Then
                rTextBox(2) = .data(1).SaveName
            End If
            rListBox.ListIndex = 0
          Else
            rTextBox(1) = ""
            If UBound(rTextBox) > 1 Then
                rTextBox(2) = ""
            End If
        End If
    End With

End Sub


'*************************************************************************
'**函 数 名：JoinList
'**输    入：ListItems()(String)
'**        ：ListName(ListBox)
'**输    出：无
'**功能描述：将数据传递过来的数组里的信息添加到指定ListBox里
'**全局变量：
'**调用模块：
'**作    者：王滋华
'**日    期：2004年03月24日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub JoinList(ListItems() As String, ListName As ListBox)

  Dim i As Long
  Dim Num As Long

    Num = UBound(ListItems)
    If Num > 0 Then
        For i = 1 To Num
            ListName.AddItem ListItems(0) & ListItems(i)
        Next i
    End If

End Sub

'*************************************************************************
'**函 数 名：InitToolTipText
'**输    入：无
'**输    出：无
'**功能描述：设置当鼠标停留在某个控件上时显示的信息
'**全局变量：无
'**调用模块：无
'**作    者：王滋华
'**日    期：2004年03月23日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Sub InitToolTipText()

    chkCRC.ToolTipText = "选择此项后若加密文件被改动后将不能解密,以保护文件安全。"
    chkEXECRC.ToolTipText = "选择此项后若加密文件被改动后将不能解密,以保护文件安全。"

    chkDel.ToolTipText = "加密成功后完全删除源文件(无法恢复)。"

    txt_jia_PassWord1.ToolTipText = "请输入加密密码。"
    txt_EXEjia_PassWord1.ToolTipText = "请输入加密密码。"

    txt_jie_PassWord.ToolTipText = "请输入解密密码。"
    txt_EXEjie_PassWord.ToolTipText = "请输入解密密码。"

    txt_jia_PassWord2.ToolTipText = "请再输入一次密码,以防出错。"
    txt_EXEjia_PassWord2.ToolTipText = "请再输入一次密码,以防出错。"

    txt_jia_FileName.ToolTipText = "请输入要加密的文件路径，或点击浏览选择。"
    txt_EXEjia_FileName.ToolTipText = "请输入要加密的文件路径，或点击浏览选择。"

    txt_jie_FileName.ToolTipText = "请输入要解密的文件路径，或点击浏览选择。"
    txt_EXEjie_FileName.ToolTipText = "请输入要解密的文件路径，或点击浏览选择。"

    txt_jia_SaveName.ToolTipText = "请输入加密后的文件存放位置，或点击浏览选择。"
    txt_jie_SaveName.ToolTipText = "请输入解密后的文件存放位置，或点击浏览选择。"

End Sub

'*************************************************************************
'**函 数 名：GetFileNames
'**输    入：Title(String)
'**        ：Filter(String)
'**输    出：GetFileNames(String())
'**功能描述：调用打开对话框控件并返回用户选定的文件名
'**全局变量：无
'**调用模块：Filename
'**作    者：王滋华
'**日    期：2004年03月23日
'**修 改 人：
'**日    期：
'**版    本：V1.0
'*************************************************************************
Private Function GetFileNames(Title As String, Filter As String, Optional MultiSelect As Boolean = True) As String()

  Dim tmp() As String
  Dim strTmp As String

    On Error GoTo ErrGoto
    With dlgSelectFile
        If MultiSelect Then
            .Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly Or _
                     cdlOFNFileMu