form1.frm

URL编码解码器,简单的将加密的URL解密

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H80000007&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "URL编码解码器 -By白痴娃娃 QQ:82690959"
   ClientHeight    =   2640
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   7425
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2640
   ScaleWidth      =   7425
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   7440
      Top             =   120
   End
   Begin VB.TextBox Text3 
      BackColor       =   &H80000006&
      ForeColor       =   &H00FFFFFF&
      Height          =   1815
      Left            =   3840
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   720
      Width           =   3495
   End
   Begin VB.TextBox Text2 
      BackColor       =   &H80000006&
      ForeColor       =   &H00FFFFFF&
      Height          =   1815
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Top             =   720
      Width           =   3615
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H80000006&
      ForeColor       =   &H00FFFFFF&
      Height          =   270
      Left            =   840
      TabIndex        =   0
      Top             =   120
      Width           =   6495
   End
   Begin VB.Label Label3 
      BackColor       =   &H80000006&
      Caption         =   "解码后URL:"
      ForeColor       =   &H8000000E&
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   480
      Width           =   975
   End
   Begin VB.Label Label2 
      BackColor       =   &H80000006&
      Caption         =   "编码后URL:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   3840
      TabIndex        =   4
      Top             =   480
      Width           =   975
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000006&
      Caption         =   "输入URL:"
      ForeColor       =   &H00FFFFFF&
      Height          =   250
      Left            =   120
      TabIndex        =   3
      Top             =   150
      Width           =   735
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Function UnEnscape(enstr As String) As String
Dim DataLen As Long
Dim TempData As String
Dim filepoint As Long
Dim ChinaText As Long
DataLen = Len(enstr)
filepoint = 1
Do While (filepoint <= DataLen)
    If Mid(enstr, filepoint, 1) = "%" Then
       If Mid(enstr, filepoint + 1, 1) = "u" Then
       On Error Resume Next
       ChinaText = CLng("&H" + Mid(enstr, filepoint + 2, 4))
       TempData = TempData + ChangeToChar(ChinaText)
       filepoint = filepoint + 6
       Else
       TempData = TempData + ChrW(CLng("&H" + Mid(enstr, filepoint + 1, 2)))
       filepoint = filepoint + 3
       End If
     Else
       TempData = TempData + Mid(enstr, filepoint, 1)
       filepoint = filepoint + 1
    End If
Loop
UnEnscape = TempData
End Function
Function Enscape(enstr As String) As String
Dim OutPutStr As String
Dim TmpStr As String
Dim DataLen As Long
TmpStr = ""
DataLen = Len(enstr)
Dim TempNum As Long
For i = 1 To DataLen
TempNum = AscW(Mid(enstr, i, 1))
   Debug.Print TempNum
   If TempNum < 16 And TempNum > 0 Then
      TmpStr = TmpStr + "%0" + Hex(TempNum)
   
   ElseIf 48 <= TempNum And TempNum <= 57 Then
      
      TmpStr = TmpStr + Mid(enstr, i, 1)
      
    ElseIf 65 <= TempNum And TempNum <= 90 Then
      
      TmpStr = TmpStr + Mid(enstr, i, 1)
      
    ElseIf 97 <= TempNum And TempNum <= 122 Then
      
      TmpStr = TmpStr + Mid(enstr, i, 1)
      
   
    ElseIf 16 <= TempNum And TempNum < 256 Then
      TmpStr = TmpStr + "%" + Hex(TempNum)
 
    ElseIf 4096 > TempNum And TempNum >= 256 Then
            If TempNum > 0 Then
      TmpStr = TmpStr + "%u0" + Hex(TempNum)
      Else
      TmpStr = TmpStr + "%u0" + Hex(CLng(&H10000) + TempNum)
      End If
    ElseIf Abs(TempNum) >= 4096 Then
      If TempNum > 0 Then
      TmpStr = TmpStr + "%u" + Hex(TempNum)
      Else
      TmpStr = TmpStr + "%u" + Hex(CLng(&H10000) + TempNum)
      End If
    End If
Next
Enscape = TmpStr
End Function
Function ChangeToChar(CharAsc As Long)
On Error GoTo OnError
       ChangeToChar = ChrW(CharAsc)
       Exit Function
OnError:
       Exit Function
End Function
Private Sub Timer1_Timer()
Text3.Text = Enscape(Text1.Text)
Text2.Text = UnEnscape(Text1.Text)
End Sub