des.frm

一个非常好的加密解密软件 vb编写的 实现了des的转换.

   Begin VB.CommandButton Command3 
      BackColor       =   &H00FF0000&
      Caption         =   "加密"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1800
      TabIndex        =   0
      Top             =   4320
      Width           =   2295
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "解密后文件："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   6840
      TabIndex        =   16
      Top             =   4560
      Width           =   1440
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "加密后文件："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   360
      TabIndex        =   15
      Top             =   4560
      Width           =   1440
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "原文件："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   360
      TabIndex        =   5
      Top             =   120
      Width           =   960
   End
   Begin APEXDESLib.ApexDes ApexDes1 
      Left            =   120
      Top             =   120
      _Version        =   65536
      _ExtentX        =   2566
      _ExtentY        =   2355
      _StockProps     =   0
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim output(8) As Integer
Dim plainfile As String
Dim cipherfile As String
Dim decipherfile As String
Private Sub Command1_Click()
'解密
Dim fp, op As Integer
Dim readstr, temp As String
Dim i As Integer
Dim plaintext As String
Dim count, filelength As Integer
Dim strng As String
ApexDes1.Key = Text3.Text
Text6.Text = ""
fp = FreeFile()
Open cipherfile For Binary Access Read As #fp
On Error Resume Next
Kill decipherfile
op = FreeFile()
Open decipherfile For Binary Access Write As #op
temp = ""
endflag = False
count = 1
filelength = LOF(fp)
While (count <= filelength) And (Not endflag)
   For i = 0 To 7
      output(i) = AscB(" ")
   Next i
   
   For i = 0 To 7
      output(i) = AscB(InputB(1, fp))
      If EOF(fp) Then
         endflag = True
         Exit For
      End If
   Next i
   
   ApexDes1.Crypt 0, output(0)
   strng = ""
   For i = 0 To 7
      Put #op, count, CByte(output(i))
      strng = strng & ChrB(output(i))
      count = count + 1
   Next i
   
   Text6.Text = Text6.Text & StrConv(strng, vbUnicode)
   
Wend
Close (fp)
Close (op)
End Sub

Private Sub Command2_Click()
'加密
Dim i As Integer
Dim strng As String
ApexDes1.Key = Text3.Text
strng = StrConv(Text1.Text, vbFromUnicode)
For i = 0 To 7
   If i < (LenB(strng)) Then
      output(i) = AscB(MidB(strng, i + 1, 1))
   Else
      output(i) = AscB(" ")
   End If
Next i
   
ApexDes1.Crypt 1, output(0)

strng = ""
For i = 0 To 7
   strng = strng & ChrB(output(i))
Next i
Text2.Text = StrConv(strng, vbUnicode)
End Sub

Private Sub Command3_Click()
'加密
Dim fp, op As Integer
Dim readstr, temp As String
Dim i As Integer
Dim plaintext As String
Dim count, filelength As Integer
Dim strng As String
ApexDes1.Key = Text3.Text
Text4.Text = ""
Text6.Text = ""
fp = FreeFile()
Open plainfile For Binary Access Read As #fp
On Error Resume Next
Kill cipherfile
op = FreeFile()
Open cipherfile For Binary Access Write As #op
temp = ""
endflag = False
count = 1
filelength = LOF(fp)
While (count <= filelength) And (Not endflag)
   For i = 0 To 7
      output(i) = 0
   Next i
   
   For i = 0 To 7
      output(i) = AscB(InputB(1, fp))
      If EOF(fp) Then
         endflag = True
         Exit For
      End If
   Next i
      
   ApexDes1.Crypt 1, output(0)
   strng = ""
   For i = 0 To 7
      Put #op, count, CByte(output(i))
      strng = strng & ChrB(output(i))
      count = count + 1
   Next i
   Text4.Text = Text4.Text & strng
Wend
Close (fp)
Close (op)
End Sub

Private Sub Command4_Click()
'解密
Dim i As Integer
Dim strng As String
ApexDes1.Key = Text3.Text
ApexDes1.Crypt 0, output(0)

strng = ""
For i = 0 To 7
   strng = strng & ChrB(output(i))
Next i
Text2.Text = StrConv(strng, vbUnicode)
End Sub

Private Sub Command5_Click()
'保存文本
Dim fp As Integer
fp = FreeFile()
Open plainfile For Output As #fp
Print #fp, Text5.Text
Close (fp)
End Sub

Private Sub Command6_Click()
'保证程序不异常终止
Dim fp As Integer
Dim tempstr As String
On Error Resume Next
DLGfileopen = 0 '设置函数返回值
CommonDialog1.Filter = "Text (*.txt)|*.txt|All (*.*)|*.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.Flags = &H4
CommonDialog1.DefaultExt = ".txt"
CommonDialog1.InitDir = App.Path
CommonDialog1.DialogTitle = "请输入明文文件"
CommonDialog1.FileName = ""
On Error GoTo messg
CommonDialog1.CancelError = True
CommonDialog1.ShowOpen '调用标准打开对话框
tempstr = CommonDialog1.FileName
'If LCase(Right$(Trim(tempstr), 4)) = ".txt" Then '是否有.txt后缀
'   tempstr = Trim(tempstr)
'Else '没有加上
'   tempstr = Trim(tempstr) & ".txt"
'End If
plainfile = tempstr
Text5.Text = ""
fp = FreeFile()
Open plainfile For Input As #fp
While Not EOF(fp)
   Input #fp, tempstr
   Text5.Text = Text5.Text & tempstr
Wend
Close (fp)
messg:
End Sub

Private Sub Form_Load()
Dim fp As Integer
Dim readstr As String
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
plainfile = App.Path & "\DESText.txt"
cipherfile = App.Path & "\cipher.txt"
decipherfile = App.Path & "\DESText1.txt"
Fplainfilename = ""
Text3.Text = "01234567"
Text2.Text = ""
Text1.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
fp = FreeFile()
Open plainfile For Input As #fp
While Not EOF(fp)
   Input #fp, readstr
   Text5.Text = Text5.Text & readstr & Chr(13) & Chr(10)
Wend
Close (fp)
End Sub