给出一段VB6和代码,谁能帮转成DELPHI的??(见内容)(20分)

  • 主题发起人 主题发起人 yagas
  • 开始时间 开始时间
Y

yagas

Unregistered / Unconfirmed
GUEST, unregistred user!
Private Declare Function CharLower Lib "user32" Alias "CharLowerA" (ByVal lpsz As String) As String
Dim inputfile As String
Dim outfile As String
Dim inputsize As Long
Dim outsize As Long
Private Sub cmdopen_Click()
On Error GoTo errhandler
HTMLadd.DialogTitle = "请选择要压缩的文件..."
HTMLadd.Filter = "All Files|*.asp;*.html;*.htm"
HTMLadd.ShowOpen
texinput.Text = HTMLadd.FileName
If HTMLadd.FileName <> vbNullString then
Open HTMLadd.FileName For Binary As #1
inputfile = Input(LOF(1), #1)
outfile = inputfile
Close #1
inputsize = Len(outfile)
laboldsize.Caption = inputsize &
" bytes"
file_change
End If
errhandler:
Exit Sub
End Sub
Private Sub Command1_Click()
On Error GoTo errhandler
HTMLadd.FileName = vbNullString
HTMLadd.Filter = "*.ASP|*.asp|*.HTM|*.htm|*.HTML|*.html"
HTMLadd.ShowSave
Open HTMLadd.FileName For Output As #1
Print #1, outfile
Close #1
MsgBox "压缩完成!"
errhandler:
Exit Sub
End Sub
Private Sub texinput_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 then
If texinput.Text = vbNullString then
MsgBox "请输入文件路径!", vbInformation, "请输入文件路径.."
texinput.SetFocus
End If
End If
End Sub
Private Sub file_change()
do
While InStr(1, outfile, ">" &
vbCrLf)
outfile = Replace(outfile, ">" &
vbCrLf, ">")
Loop

do
While InStr(1, outfile, Chr(10))
outfile = Replace(outfile, Chr(10), vbNullString)
Loop

do
While InStr(1, outfile, Chr(13))
outfile = Replace(outfile, Chr(13), vbNullString)
Loop

do
While InStr(1, outfile, ">" &
Chr(13))
outfile = Replace(outfile, ">" &
Chr(13), ">")
Loop

do
While InStr(1, outfile, Chr(9))
outfile = Replace(outfile, Chr(9), vbNullString)
Loop

do
While InStr(1, outfile, Chr(9) &
Chr(9))
outfile = Replace(outfile, Chr(9) &
Chr(9), vbNullString)
Loop

do
While InStr(1, outfile, Chr(9) &
"<")
outfile = Replace(outfile, Chr(9) &
"<", "<")
Loop

do
While InStr(1, outfile, Chr(32) &
"<")
outfile = Replace(outfile, Chr(32) &
"<", "<")
Loop

do
While InStr(1, outfile, Chr(32) &
Chr(32))
outfile = Replace(outfile, Chr(32) &
Chr(32), vbNullString)
Loop

outsize = Len(outfile)
labnewsize.Caption = outsize &
" bytes"
labout.Caption = Int((inputsize - outsize) / inputsize * 100) &
" %"
End Sub
 
后退
顶部