kaisa.frm

来自「凯撒加密的一个小程序」· FRM 代码 · 共 304 行

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "加密/解密"
   ClientHeight    =   5700
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   7470
   Icon            =   "kaisa.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5700
   ScaleWidth      =   7470
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text3 
      Height          =   495
      Left            =   240
      TabIndex        =   6
      Top             =   4920
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.Frame Frame1 
      Caption         =   "控制台"
      Height          =   1095
      Left            =   960
      TabIndex        =   1
      Top             =   4560
      Width           =   5415
      Begin VB.CommandButton Command2 
         Caption         =   "解密"
         Height          =   495
         Left            =   3960
         TabIndex        =   5
         Top             =   360
         Width           =   1095
      End
      Begin VB.TextBox Text2 
         Height          =   390
         Left            =   2640
         TabIndex        =   3
         Top             =   345
         Width           =   615
      End
      Begin VB.CommandButton Command1 
         Caption         =   "加密"
         Height          =   495
         Left            =   360
         TabIndex        =   2
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "密钥："
         Height          =   255
         Left            =   1800
         TabIndex        =   4
         Top             =   480
         Width           =   735
      End
   End
   Begin VB.TextBox Text1 
      Height          =   4215
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   240
      Width           =   6615
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5760
      Top             =   4680
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DefaultExt      =   ".txt"
      Filter          =   "文本文档(*.txt)|*.txt|所有文件|*.*"
      InitDir         =   "c:\"
   End
   Begin MSComctlLib.ProgressBar pbar 
      Height          =   240
      Left            =   1800
      TabIndex        =   7
      Top             =   0
      Visible         =   0   'False
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   423
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Menu file 
      Caption         =   "文件(&F)"
      Begin VB.Menu new 
         Caption         =   "新建(&N)"
      End
      Begin VB.Menu open 
         Caption         =   "打开(&O)"
      End
      Begin VB.Menu STORE 
         Caption         =   "保存(&S)"
      End
      Begin VB.Menu ANSTORE 
         Caption         =   "另存为(&A)"
      End
      Begin VB.Menu exit 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助(&H)"
      Begin VB.Menu net 
         Caption         =   "访问网站(&P)"
      End
      Begin VB.Menu email 
         Caption         =   "02241EMAIL(&E)"
      End
      Begin VB.Menu au 
         Caption         =   "联系作者(A)"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim fname, b As String


Private Sub ANSTORE_Click()
CommonDialog1.ShowSave
fname = CommonDialog1.FileName
If fname <> "" Then
Open fname For Output As #1
Print #1, Text1.Text
Close #1
End If
Form1.Caption = fname
End Sub

Private Sub au_Click()
Call ShellExecute(Form1.hwnd, "open", "mailto:[e-mail]", vbNullString, vbNullString, &H0)
End Sub

Private Sub Command1_Click()
pbar.Visible = True
If Text2.Text = "" Then
MsgBox "请输入密钥！", 0, "错误！"
End If
If Text2.Text <> "" Then '判断是否为数字
Dim m, n As Integer, chc As String
m = Len(Text2.Text)
For n = 1 To m
chc = Mid(Text2.Text, n, 1)
If Asc(chc) > 57 Or Asc(chc) < 48 Then
MsgBox "请输入数字！", 0, "密钥错误！"
End If
Next
End If
'判断结束
If Text2.Text <> "" Then
Text3.Text = ""
Dim l, i As Long, cha, chb As String
pbar.Value = 1
l = Len(Text1.Text)
For i = 1 To l
pbar.Min = 1
pbar.Max = l
pbar.Value = i

cha = Mid(Text1.Text, i, 1)
If Asc(cha) >= 48 Or Asc(cha) <= 57 Then
chb = Asc(cha) + Val(Text2.Text)
Else
chb = Asc(cha) - Val(Text2.Text)
End If
Text3.Text = Text3.Text & Chr(chb)
Next
Text1.Text = Text3.Text
End If
pbar.Visible = False
End Sub

Private Sub Command2_Click()
pbar.Visible = True
If Text2.Text = "" Then
MsgBox "请输入密钥！", 0, "错误！"
End If
If Text2.Text <> "" Then '判断是否为数字
Dim m, n As Integer, chc As String
m = Len(Text2.Text)
For n = 1 To m
chc = Mid(Text2.Text, n, 1)
If Asc(chc) > 57 Or Asc(chc) < 48 Then
MsgBox "请输入数字！", 0, "密钥错误！"
End If
Next
End If
'判断结束
If Text2.Text <> "" Then
Text3.Text = ""
Dim l, i As Long, cha, chb As String

pbar.Value = 1
l = Len(Text1.Text)
For i = 1 To l
pbar.Min = 1
pbar.Max = l
pbar.Value = i
cha = Mid(Text1.Text, i, 1)

If Asc(cha) >= 48 Or Asc(cha) <= 57 Then
chb = Asc(cha) + Val(Text2.Text)
Else
chb = Asc(cha) - Val(Text2.Text)
End If
Text3.Text = Text3.Text & Chr(chb)
Next
Text1.Text = Text3.Text
End If
pbar.Visible = False
End Sub

Private Sub email_Click()
Call ShellExecute(Form1.hwnd, "open", "http://mail.02241.bjs.cn", vbNullString, vbNullString, &H0)
End Sub

Private Sub exit_Click()
Text1.Text = ""
End
End Sub



Private Sub file_Click()
If fname = "" Or fmane = "未命名" Then
ANSTORE.Enabled = False
Else
ANSTORE.Enabled = True
End If
End Sub

Private Sub Form_resize()
Text1.Left = 0
Text1.Top = 300
Text1.Height = Form1.Height - 2500
Text1.Width = Form1.ScaleWidth
Frame1.Top = Text1.Top + Text1.Height + 150
Frame1.Left = 960
Frame1.Width = Form1.Width - 960 * 2
Command1.Left = 360
Command2.Left = Frame1.Width - Command1.Left - Command2.Width
Label1.Left = Frame1.Width / 2 - 550
Text2.Left = Frame1.Width / 2
pbar.Width = Form1.Width - pbar.Left * 2
End Sub

Private Sub net_Click()
Call ShellExecute(Form1.hwnd, "open", "http://02241.bjs.cn", vbNullString, vbNullString, &H0)
End Sub

Private Sub new_Click()
Text1.Text = ""
Form1.Caption = "未命名"
Text1.SetFocus
End Sub

Private Sub open_Click()
CommonDialog1.ShowOpen
fname = CommonDialog1.FileName
If fname <> "" Then
Open fname For Input As #1
b = ""
Do Until EOF(1)
Line Input #1, nextline
b = b & nextline & Chr(13) & Chr(10)
Loop
Close #1
Text1.Text = b
Form1.Caption = fname
End If
End Sub


Private Sub STORE_Click()
If Form1.Caption = "未命名" Or Form1.Caption = "" Or Form1.Caption = "加密/解密" Then
CommonDialog1.ShowSave
fname = CommonDialog1.FileName
Else
fname = Form1.Caption
End If
If fname <> "" Then
Open fname For Output As #1
Print #1, Text1.Text
Close #1
Form1.Caption = fname
End If
End Sub