frmqp.frm

< VB高级网络编程技术>>随书源代码第2章,里面有很多有用的例程,希望对大家的开发工作有帮助!

VERSION 5.00
Begin VB.Form frmQp 
   Caption         =   "Form1"
   ClientHeight    =   3816
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   6024
   LinkTopic       =   "Form1"
   ScaleHeight     =   3816
   ScaleWidth      =   6024
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdEncode 
      Caption         =   "Quoted-printable编码"
      Height          =   432
      Left            =   1500
      TabIndex        =   2
      Top             =   2040
      Width           =   1752
   End
   Begin VB.CommandButton cmdDecode 
      Caption         =   "Quoted-printable解码"
      Height          =   372
      Left            =   1500
      TabIndex        =   1
      Top             =   2580
      Width           =   1752
   End
   Begin VB.TextBox Text1 
      Height          =   1032
      Left            =   1620
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   540
      Width           =   2952
   End
End
Attribute VB_Name = "frmQp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Public Sub QpDecode(infile As String, Outfile As String)
Dim Fnum, Fnum2 As Integer
Dim myB As Byte
Dim myByte1 As Byte, myByte2 As Byte
Dim mOutByte As Byte
Dim FinishPercent As Long
Fnum = FreeFile()
Fnum2 = Fnum + 1
Dim TotalB, k As Long
Open Outfile For Binary As #Fnum2
Open infile For Binary As #Fnum
TotalB = LOF(Fnum)
    k = 0
Do While Not EOF(Fnum)
    Get #Fnum, , myB
    If EOF(Fnum) Then Exit Do
    If myB = Asc("=") Then
        Get #Fnum, , myByte1
        If myByte1 = &HA Then
            '如果是回车,继续
        Else
            '取第二个字节
            Get #Fnum, , myByte2
            Call DecodeByte(myByte1, myByte2, mOutByte)
            Put #Fnum2, , mOutByte
        End If
    Else
        mOutByte = myB
        Put #Fnum2, , mOutByte
    End If
    
'    k = k + 1
'    FinishPercent = Fix(k * 45 * 100 / TotalB)
'    Text1.Text = "encoding " & k & " line" & vbCrLf
'    Text1.Text = Text1.Text & "finish " & FinishPercent & " %" & vbCrLf
'    DoEvents
Loop
Close (Fnum)
Close (Fnum2)
End Sub



Private Sub DecodeByte(mInByte1 As Byte, mInByte2 As Byte, mOutByte As Byte)
Dim tbyte1 As Integer, tbyte2 As Integer
If mInByte1 > Asc("9") Then
    tbyte1 = mInByte1 - Asc("A") + 10
Else
    tbyte1 = mInByte1 - Asc("0")
End If
If mInByte2 > Asc("9") Then
    tbyte2 = mInByte2 - Asc("A") + 10
Else
    tbyte2 = mInByte2 - Asc("0")
End If
mOutByte = tbyte1 * 16 + tbyte2
End Sub


Private Sub cmdDecode_Click()
Call QpDecode(App.Path & "\qpout.txt", App.Path & "\1.txt")
End Sub

Private Sub cmdEncode_Click()
Call QpEncode(App.Path & "\2.txt", App.Path & "\qpout.txt")
'MsgBox Hex(20) & " " & Len(Hex(20))

End Sub

Private Sub EncodeByte(mInByte As Byte, mOutStr As String)
If (mInByte >= 33 And mInByte <= 60) Or (mInByte >= 62 And mInByte <= 126) Then
    mOutStr = Chr(mInByte)
Else
    If mInByte <= &HF Then
        mOutStr = "=0" & Hex(mInByte)
    Else
        mOutStr = "=" & Hex(mInByte)
    End If
End If
End Sub


Public Sub QpEncode(infile As String, Outfile As String)
Dim Fnum, Fnum2 As Integer
Dim myB As Byte
Dim mOutStr As String
Dim FinishPercent As Long
Fnum = FreeFile()
Fnum2 = Fnum + 1
Dim TotalB, k As Long
Open Outfile For Output As #Fnum2
Open infile For Binary As #Fnum
TotalB = LOF(Fnum)
    k = 0
Do While Not EOF(Fnum)
    Get #Fnum, , myB
    If EOF(Fnum) Then Exit Do
        EncodeByte myB, mOutStr
        Print #Fnum2, mOutStr;
Loop
Close (Fnum)
Close (Fnum2)
End Sub