?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -