VERSION 5.00
Begin VB.Form FrmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "明文密文转换工具"
   ClientHeight    =   5970
   ClientLeft      =   6732
   ClientTop       =   3318
   ClientWidth     =   8922
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "FrmMain.frx":0000
   ScaleHeight     =   5970
   ScaleWidth      =   8922
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton CDClr 
      BackColor       =   &H00E0E0E0&
      Caption         =   "×"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   310
      Left            =   8520
      Style           =   1  'Graphical
      TabIndex        =   9
      ToolTipText     =   "把伪明文转换回密文"
      Top             =   245
      Width           =   246
   End
   Begin VB.CommandButton CDS 
      BackColor       =   &H00FFFFFF&
      Caption         =   "笑码"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   246
      Left            =   8280
      Style           =   1  'Graphical
      TabIndex        =   8
      ToolTipText     =   "把伪明文转换回密文"
      Top             =   4800
      Width           =   486
   End
   Begin VB.CheckBox ChkM 
      Height          =   180
      Left            =   120
      TabIndex        =   6
      Top             =   5700
      Value           =   1  'Checked
      Width           =   180
   End
   Begin VB.CommandButton CET 
      BackColor       =   &H00FFFFFF&
      Caption         =   "套壳"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   246
      Left            =   8280
      Style           =   1  'Graphical
      TabIndex        =   5
      ToolTipText     =   "使密文变成伪明文；套壳为实验性功能，可能会永远丢失部分文本，请做好备份"
      Top             =   5400
      Width           =   486
   End
   Begin VB.CommandButton CEB 
      BackColor       =   &H00FFFFFF&
      Caption         =   "剥壳"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   246
      Left            =   8280
      Style           =   1  'Graphical
      TabIndex        =   4
      ToolTipText     =   "把伪明文转换回密文"
      Top             =   5160
      Width           =   486
   End
   Begin VB.ComboBox CbKey 
      BeginProperty Font 
         Name            =   "华文中宋"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   318
      Left            =   960
      TabIndex        =   1
      Text            =   "10"
      Top             =   240
      Width           =   7566
   End
   Begin VB.CommandButton CmdEx 
      BackColor       =   &H00C0FFFF&
      Caption         =   "←明密转换→"
      BeginProperty Font 
         Name            =   "华文中宋"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3966
      Left            =   8280
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   720
      Width           =   486
   End
   Begin VB.Label LblM 
      BackStyle       =   0  'Transparent
      Caption         =   " 多行式密文"
      BeginProperty Font 
         Name            =   "华文中宋"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   246
      Left            =   240
      TabIndex        =   7
      Top             =   5700
      Width           =   1086
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   3
      X1              =   8320
      X2              =   8700
      Y1              =   5100
      Y2              =   5100
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00C000C0&
      BorderWidth     =   3
      FillColor       =   &H00FF00FF&
      Height          =   315
      Left            =   120
      Top             =   245
      Width           =   846
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "密钥："
      BeginProperty Font 
         Name            =   "华文中宋"
         Size            =   14.1
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00404040&
      Height          =   318
      Left            =   120
      TabIndex        =   2
      Top             =   240
      Width           =   846
   End
   Begin VB.Label LblT 
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Caption         =   "在这里输入明/密文..."
      Height          =   4926
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   8058
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False




Private Sub CbKey_Change()
KY = 0
Debug.Print Val(CbKey.Text), Len(Str(Val(CbKey.Text))) - 1, Len(CbKey.Text)
If Val(CbKey.Text) <> 0 And Len(Trim(Str(Val(CbKey.Text)))) - 1 = Len(CbKey.Text) Then
KY = CbKey.Text
Else
For i = 1 To Len(CbKey.Text)
KY = KY + Asc(Mid(CbKey.Text, i, 1))
Next
KY = KY / Len(CbKey.Text)
End If
End Sub

Private Sub CbKey_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then CmdEx.SetFocus
End Sub

Private Sub CbKey_LostFocus()
Dim Existed As Boolean
For i = 0 To CbKey.ListCount - 1
If CbKey.List(i) = CbKey.Text Then Existed = True
Next
If Not Existed Then CbKey.AddItem CbKey.Text
End Sub

Private Sub CDClr_Click()
CbKey.Text = 10
For i = 0 To CbKey.ListCount - 1
CbKey.RemoveItem 0
Next
End Sub

Private Sub CEB_Click()
IntPgs
TXT = ""

TXT = LblT.Caption
If IsM Then LblT.Caption = "/:-" & vbCrLf Else LblT.Caption = "/:-"
       For i = 1 To Len(TXT)
               If i <= Len(TXT) - 20 Then
'    PgsBar.TxtP(0).Text = Mid(TXT, i, 80)
'    PgsBar.TxtP(1).Text = Mid(TXT, i, 80)
'    PgsBar.TxtP(2).Text = Mid(TXT, i, 80)
    End If
PgsBar.Refresh
    PgsPlus Len(TXT), "正在剥壳..."
    If IsM Then
        If Mid(TXT, i, 1) = "{" Then
            Dim STO, EDO As Long
            STO = i
                For j = i To Len(TXT)
                    If Mid(TXT, j, 1) = "}" Then
                        EDO = j
                        GoTo otj
                    End If
                Next j
otj:        LblT.Caption = LblT.Caption & Mid(TXT, STO + 1, EDO - STO - 1) & ";" & vbCrLf
            i = i + EDO - STO
                PgsBar.SpP.Width = PgsBar.SpP.Width + 10000 / Len(TXT) * (EDO - STO)
            GoTo otif
        End If
        LblT.Caption = LblT.Caption & Asc(Mid(TXT, i, 1)) & ";" & vbCrLf
    Else
        If Mid(TXT, i, 1) = "{" Then
            STO = i
            For j = i To Len(TXT)
                If Mid(TXT, j, 1) = "}" Then
                    EDO = j
                    GoTo otj2
                End If
            Next j
otj2:       LblT.Caption = LblT.Caption & Mid(TXT, STO + 1, EDO - STO - 1) & ";" & vbCrLf
            i = i + EDO - STO
            GoTo otif
        End If
        LblT.Caption = LblT.Caption & Asc(Mid(TXT, i, 1)) & ";"
    End If

otif: Next i
UnloadPgs
'    PgsBar.TxtP(0).Text = ""
'    PgsBar.TxtP(1).Text = ""
'    PgsBar.TxtP(2).Text = ""
LblT.Caption = LblT.Caption & "-:/"
ReflashCE
FrmMain.Picture = LoadResPicture(101, vbResBitmap)
End Sub

Private Sub CET_Click()
IntPgs
TXT = ""
LblT.Caption = Trim(LblT.Caption)

TXT = LblT.Caption
TXT = Mid(TXT, 4, Len(TXT) - 6)
Dim SPTXT() As String
SPTXT() = Split(TXT, ";")
TXT = ""
For i = 0 To UBound(SPTXT)
If SPTXT(i) = "" Or SPTXT(i) = vbCrLf Then GoTo ot
On Error Resume Next
'Debug.Print Mid(SusTXT, i + 1, 1), Asc(Mid(SusTXT, i + 1, 1)) + KY, Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY), Asc(Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY)), "|||", Asc(Mid(SusTXT, i + 1, 1)), vbCrLf
'If i > 1 Then PgsBar.TxtP(0).Text = Mid(SusTXT, i - 1, 1) & "      " & Asc(Mid(SusTXT, i - 1, 1)) + KY & "      " & Chr(Asc(Mid(SusTXT, i - 1, 1)) + KY) & "      " & Asc(Chr(Asc(Mid(SusTXT, i - 1, 1)) + KY)) & "      " & "   |   " & "      " & Asc(Mid(SusTXT, i - 1, 1)) & vbCrLf
'If i > 0 Then PgsBar.TxtP(1).Text = Mid(SusTXT, i, 1) & "      " & Asc(Mid(SusTXT, i, 1)) + KY & "      " & Chr(Asc(Mid(SusTXT, i, 1)) + KY) & "      " & Asc(Chr(Asc(Mid(SusTXT, i, 1)) + KY)) & "      " & "   |   " & "      " & Asc(Mid(SusTXT, i, 1)) & vbCrLf
'If i < UBound(SPTXT) Then PgsBar.TxtP(2).Text = Mid(SusTXT, i + 1, 1) & "      " & Asc(Mid(SusTXT, i + 1, 1)) + KY & "      " & Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY) & "      " & Asc(Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY)) & "      " & "   |   " & "      " & Asc(Mid(SusTXT, i + 1, 1)) & vbCrLf
PgsBar.Refresh
PgsPlus UBound(SPTXT) + 1, "正在套壳..."
If (Asc(Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY)) > 0 And Asc(Mid(SusTXT, i + 1, 1)) < 0) Or Asc(Mid(SusTXT, i + 1, 1)) + KY > 126 Or Asc(Mid(SusTXT, i + 1, 1)) < -20000 Then
TXT = TXT & "{" & Asc(Mid(SusTXT, i + 1, 1)) + KY & "}"
Else
TXT = TXT & Chr(SPTXT(i))
End If
Next
ot: UnloadPgs
'PgsBar.TxtP(0).Text = ""
'PgsBar.TxtP(1).Text = ""
'PgsBar.TxtP(2).Text = ""
LblT.Caption = TXT
ReflashCE
FrmMain.Picture = LoadResPicture(102, vbResBitmap)
End Sub

Private Sub ChkM_Click()
IsM = ChkM.Value
If Left(LblT.Caption, 3) = "/:-" And Right(LblT.Caption, 3) = "-:/" Then
LblT.Caption = Trim(LblT.Caption)
FrmMain.Picture = LoadResPicture(102, vbResBitmap)
TXT = LblT.Caption
TXT = Mid(TXT, 4, Len(TXT) - 6)
Dim SPTXT() As String
SPTXT() = Split(TXT, ";")
TXT = ""
For i = 0 To UBound(SPTXT)
If SPTXT(i) = "" Or SPTXT(i) = vbCrLf Then GoTo ot
TXT = TXT & Chr(SPTXT(i) - KY)
Next
ot:  LblT.Caption = TXT
FrmMain.Picture = LoadResPicture(101, vbResBitmap)
TXT = LblT.Caption
If IsM Then LblT.Caption = "/:-" & vbCrLf Else LblT.Caption = "/:-"
For i = 1 To Len(TXT)
If IsM Then LblT.Caption = LblT.Caption & Asc(Mid(TXT, i, 1)) + KY & ";" & vbCrLf Else LblT.Caption = LblT.Caption & Asc(Mid(TXT, i, 1)) + KY & ";"
Next
LblT.Caption = LblT.Caption & "-:/"
End If
End Sub

Private Sub CmdEx_Click()
IntPgs
TXT = ""

If Left(LblT.Caption, 3) = "/:-" And Right(LblT.Caption, 3) = "-:/" Then
LblT.Caption = Trim(LblT.Caption)

TXT = LblT.Caption
TXT = Mid(TXT, 4, Len(TXT) - 6)
Dim SPTXT() As String
SPTXT() = Split(TXT, ";")
TXT = ""
For i = 0 To UBound(SPTXT)
If SPTXT(i) = "" Or SPTXT(i) = vbCrLf Then GoTo ot
'On Error Resume Next
TXT = TXT & Chr(SPTXT(i) - KY)

'If i > 1 Then PgsBar.TxtP(0).Text = Mid(SusTXT, i - 1, 1) & "      " & Asc(Mid(SusTXT, i - 1, 1)) + KY & "      " & Chr(Asc(Mid(SusTXT, i - 1, 1)) + KY) & "      " & Asc(Chr(Asc(Mid(SusTXT, i - 1, 1)) + KY)) & "      " & "   |   " & "      " & Asc(Mid(SusTXT, i - 1, 1)) & vbCrLf
'If i > 0 Then PgsBar.TxtP(1).Text = Mid(SusTXT, i, 1) & "      " & Asc(Mid(SusTXT, i, 1)) + KY & "      " & Chr(Asc(Mid(SusTXT, i, 1)) + KY) & "      " & Asc(Chr(Asc(Mid(SusTXT, i, 1)) + KY)) & "      " & "   |   " & "      " & Asc(Mid(SusTXT, i, 1)) & vbCrLf
'If i < UBound(SPTXT) Then PgsBar.TxtP(2).Text = Mid(SusTXT, i + 1, 1) & "      " & Asc(Mid(SusTXT, i + 1, 1)) + KY & "      " & Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY) & "      " & Asc(Chr(Asc(Mid(SusTXT, i + 1, 1)) + KY)) & "      " & "   |   " & "      " & Asc(Mid(SusTXT, i + 1, 1)) & vbCrLf
PgsBar.Refresh
PgsPlus UBound(SPTXT) + 1, "正在解密..."
Next
ot:  LblT.Caption = TXT
SusTXT = LblT.Caption
FrmMain.Picture = LoadResPicture(102, vbResBitmap)
Else

TXT = LblT.Caption
If IsM Then LblT.Caption = "/:-" & vbCrLf Else LblT.Caption = "/:-"
For i = 1 To Len(TXT)

If IsM Then LblT.Caption = LblT.Caption & Asc(Mid(TXT, i, 1)) + KY & ";" & vbCrLf Else LblT.Caption = LblT.Caption & Asc(Mid(TXT, i, 1)) + KY & ";"
On Error Resume Next
'    PgsBar.TxtP(0).Text = Mid(TXT, i, 80)
'    PgsBar.TxtP(1).Text = Mid(TXT, i, 80)
'    PgsBar.TxtP(2).Text = Mid(TXT, i, 80)
PgsBar.Refresh
PgsPlus Len(TXT), "正在加密..."
Next
LblT.Caption = LblT.Caption & "-:/"
FrmMain.Picture = LoadResPicture(101, vbResBitmap)
End If
ReflashCE
UnloadPgs
End Sub

Private Sub Form_Load()
KY = 10
ReflashCE
IsM = True
SusTXT = LblT.Caption
End Sub

Private Sub Label2_Click()
Clipboard.Clear
Clipboard.SetText "密钥：" & CbKey.Text
Msg "密钥已复制到剪贴板", &H80FF9E, 1000
End Sub

Private Sub LblM_Click()
If ChkM.Value = 1 Then ChkM.Value = 0 Else ChkM.Value = 1
IsM = ChkM.Value
End Sub

Private Sub LblT_DblClick()
TxtBox.Show
End Sub

