frmuu.frm

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

VERSION 5.00
Begin VB.Form frmUU 
   Caption         =   "Form1"
   ClientHeight    =   4812
   ClientLeft      =   48
   ClientTop       =   336
   ClientWidth     =   6252
   LinkTopic       =   "Form1"
   ScaleHeight     =   4812
   ScaleWidth      =   6252
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text1 
      Height          =   3432
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   1
      Text            =   "frmUU.frx":0000
      Top             =   1020
      Width           =   5112
   End
   Begin VB.CommandButton cmdencode 
      Caption         =   "uuencode"
      Height          =   312
      Left            =   600
      TabIndex        =   0
      Top             =   240
      Width           =   1272
   End
End
Attribute VB_Name = "frmUU"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub UuEncode(infile As String, Outfile As String, OutName As String)
Dim Fnum, Fnum2, i, j As Integer
Dim myStr As Byte
Dim mInLine(45) As Byte '存放读入一行的数据
Dim mOutLine(61) As Byte
Dim mInLineLen As Integer '读入一行的字节数
Dim mInByte(3) As Byte
Dim mOutByte(4) As Byte
Dim mOutB 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)
Put #Fnum2, , "begin 600 " & OutName & vbCrLf
    '读入一行并进行编码
    k = 0
While Not EOF(Fnum)
    mInLineLen = 0
    i = 0
    j = 0
    While (Not EOF(Fnum)) And i < 45
        Get #Fnum, , myStr
        mInLine(i) = myStr
        i = i + 1
    Wend
    mInLineLen = i
    k = k + 1
    FinishPercent = Fix(k * 45 * 100 / TotalB)
    Text1.Text = "encoding " & k & " line" & vbCrLf
    Text1.Text = Text1.Text & "finish " & FinishPercent & " %" & vbCrLf
    DoEvents
    If mInLineLen > 0 Then
        '如果读入的大于0
        '对一行进行编码
        mOutB = mInLineLen + &H20
        Put #Fnum2, , mOutB
        'Put #Fnum2, , 46 'mOutB
        While (j * 3 < mInLineLen)
            mInByte(0) = mInLine(j * 3 + 0)
            mInByte(1) = mInLine(j * 3 + 1)
            mInByte(2) = mInLine(j * 3 + 2)
            j = j + 1
            
            Call EncodeByte(mInByte, mOutByte)
            For i = 0 To 3
                Put #Fnum2, , mOutByte(i)
            Next i
        Wend
    End If
    Put #Fnum2, , vbCrLf
Wend
    Put #Fnum2, , "`" & vbCrLf & "end"
Close (Fnum)
Close (Fnum2)
End Sub

Private Sub cmdencode_Click()
Text1.Text = "begin 600 1.txt" & vbCrLf
UuEncode App.Path & "\arrow.cur", App.Path & "\arrow.uue", "arrow1.cur"
Text1.Text = Text1.Text & "end"
End Sub

Public Sub EncodeByte(mInByte() As Byte, mOutByte() As Byte)
Dim tbyte As Byte
Dim i As Integer
'取第一个字符的a7~a2
'tbyte = mInByte(0) And &HFC
'mOutByte(0) = tbyte > 2
'tbyte = ((mInByte(0) And &H3) < 4) + (mInByte(1) And &HF0) > 4
'mOutByte(1) = tbyte
'tbyte = ((mInByte(1) And &HF) < 2) + ((mInByte(2) And &HF) > 6)
'mOutByte(2) = tbyte
'tbyte = (mInByte(2) And &H3F)
'mOutByte(3) = tbyte
tbyte = mInByte(0) And &HFC
mOutByte(0) = tbyte / 4
tbyte = ((mInByte(0) And &H3) * 16) + (mInByte(1) And &HF0) / 16
mOutByte(1) = tbyte
tbyte = ((mInByte(1) And &HF) * 4) + ((mInByte(2) And &HC0) / 64)
mOutByte(2) = tbyte
tbyte = (mInByte(2) And &H3F)
mOutByte(3) = tbyte

For i = 0 To 3
    If mOutByte(i) = 0 Then
        mOutByte(i) = &H60
    Else
        mOutByte(i) = mOutByte(i) + &H20
    End If
Next i
End Sub