frmmain.frm

对文件的加密解密

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "请输入密码"
   ClientHeight    =   885
   ClientLeft      =   45
   ClientTop       =   315
   ClientWidth     =   2895
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   885
   ScaleWidth      =   2895
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox prg 
      Appearance      =   0  'Flat
      BackColor       =   &H00C00000&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   210
      Left            =   150
      ScaleHeight     =   210
      ScaleWidth      =   2595
      TabIndex        =   3
      Top             =   150
      Visible         =   0   'False
      Width           =   2595
   End
   Begin VB.TextBox txtPassWord 
      Height          =   270
      IMEMode         =   3  'DISABLE
      Left            =   120
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   120
      Width           =   2655
   End
   Begin VB.CommandButton cmdNo 
      Caption         =   "取消"
      Height          =   315
      Left            =   1740
      TabIndex        =   1
      Top             =   480
      Width           =   975
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   315
      Left            =   180
      TabIndex        =   0
      Top             =   480
      Width           =   975
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents jm As clsRC4
Attribute jm.VB_VarHelpID = -1
Dim meFileName As String
Dim mePath As String
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Private Sub FORM_Initialize()
  InitCommonControls
End Sub
Private Sub cmdNo_Click()

    End

End Sub

Private Sub cmdOk_Click()

  Dim strPassWord As String
  Dim tmpFile As String
  Dim RunFile As String

    tmpFile = Space$(255)
    GetTempPath 255, tmpFile
    tmpFile = Left$(tmpFile, InStrRev(tmpFile, "\"))
    tmpFile = GetTmpFile(tmpFile)
    Set jm = New clsRC4
    strPassWord = txtPassWord
    prg.Width = 1
    prg.Visible = True
    MakeCompFile tmpFile
    RunFile = GetTmpFile(mePath) & ".exe"
    If jm.DecryptFile(tmpFile, RunFile, strPassWord) Then
        SetAttr RunFile, vbHidden
        Me.Visible = False
        ShellWait RunFile, App.Path, Command
        SetAttr RunFile, vbNormal
        Kill RunFile
    End If
    SetAttr tmpFile, vbNormal
    Kill tmpFile
    Kill "*.tmp"
    Set jm = Nothing
    End

End Sub

Private Sub MakeCompFile(FileName As String)

  Dim fn As Byte
  Dim meLen As Long
  Dim Buffer() As Byte
  Dim tmp As Byte
  Dim tmp1 As Long

    fn = FreeFile
    meLen = FileLen(meFileName)
    Open meFileName For Binary Access Read As #fn
    Get #fn, meLen, tmp
    tmp = Val(Chr$(tmp))
    ReDim Buffer(1 To tmp)
    Get #fn, meLen - tmp, Buffer()
    tmp1 = Val(StrConv(Buffer(), vbUnicode))
    ReDim Buffer(1 To meLen - tmp1 - tmp - 1)
    Get #fn, tmp1 + 1, Buffer()
    Close #fn

    fn = FreeFile
    If Len(Dir$(FileName)) > 0 Then
        Kill FileName
    End If
    Open FileName For Binary As #fn
    Put #fn, , Buffer()
    Close #fn

End Sub

Private Function GetTmpFile(sPath As String) As String

  Dim sTemp As String

    sTemp = String$(260, 0)
    GetTempFileName sPath, "tg", 0, sTemp
    GetTmpFile = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)

End Function

Private Sub Form_Activate()

    txtPassWord.SetFocus

End Sub

Private Sub Form_Load()

    mePath = IIf(Right$(App.Path, 1) = "\", App.Path, App.Path & "\")
    meFileName = mePath & App.EXEName & ".exe"

End Sub

Private Sub jm_Progress(Percent As Long, State As String)

    Me.Caption = State
    On Error Resume Next
      Me.prg.Width = txtPassWord.Width * (Percent / 100) - 60
      DoEvents
    On Error GoTo 0

End Sub

Private Sub txtPassWord_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        cmdOk_Click
    End If

End Sub