upload.cls

医药进销存管理系统 全代码 很详细 可惜没有数据库 可供参考

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Upload"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Dim objcontext As ObjectContext
Dim Request As Request
Dim Response As Response
Dim Server As Server
Dim objstream, filedata, filefullpath

Private Sub Class_Initialize()

Set objcontext = GetObjectContext()
Set Request = objcontext("Request")
Set Response = objcontext("Response")
Set Server = objcontext("Server")
End Sub
Public Sub Guyu()
Dim streamdata, crlf, divstr, datastart, datasize, pos1, pos2

Set objstream = Server.CreateObject("ADODB.Stream")
objstream.mode = 3
objstream.Type = 1
objstream.open
objstream.Write Request.BinaryRead(Request.TotalBytes)
objstream.position = 0
streamdata = objstream.Read

crlf = ChrB(13) & ChrB(10)
divstr = LeftB(streamdata, CLng(InStrB(streamdata, crlf)) - 1)
pos1 = InStrB(streamdata, toByte("filename="""))
pos2 = InStrB(pos1 + 10, streamdata, toByte(""""))
filefullpath = MidB(streamdata, pos1 + 10, pos2 - pos1 - 10)

datastart = InStrB(streamdata, crlf & crlf) + 3   '这里一定是加3,不然会少截取数据
objstream.position = datastart
datasize = InStrB(datastart + 1, streamdata, divstr) - datastart - 3
filedata = MidB(streamdata, datastart, datasize)
End Sub
'将保存文件到服务器中
Public Function SaveAs(savePath)
    Dim aiyu
    Set aiyu = Server.CreateObject("ADODB.Stream")
    aiyu.mode = 3
    aiyu.Type = 1
    aiyu.open
    objstream.copyto aiyu, LenB(filedata)
    aiyu.SaveToFile Server.MapPath(savePath & GetFileName(toStr(filefullpath))), 2
    aiyu.Close
    Set aiyu = Nothing
End Function
' 将字符串转换成二进制
 Private Function toByte(Str)
   Dim i, iCode, c, iLow, iHigh
   toByte = ""
   For i = 1 To Len(Str)
   c = Mid(Str, i, 1)
   iCode = Asc(c)
   If iCode < 0 Then iCode = iCode + 65535
   If iCode > 255 Then
     iLow = Left(Hex(Asc(c)), 2)
     iHigh = Right(Hex(Asc(c)), 2)
     toByte = toByte & ChrB("&H" & iLow) & ChrB("&H" & iHigh)
   Else
     toByte = toByte & ChrB(AscB(c))
   End If
   Next
 End Function
'将二进制转换成字符串
 Private Function toStr(Byt)
   Dim blow
    toStr = ""
    For i = 1 To LenB(Byt)
    blow = MidB(Byt, i, 1)
    If AscB(blow) > 127 Then
    toStr = toStr & Chr(AscW(MidB(Byt, i + 1, 1) & blow)) '这里浪费了挺多的时间
    i = i + 1
    Else
    toStr = toStr & Chr(AscB(blow))
    End If
    Next
 End Function
'获得文件名
 Private Function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = Mid(FullPath, InStrRev(FullPath, "\") + 1)
  Else
   GetFileName = ""
  End If
 End Function
 '获得文件路径
 Private Function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = Left(FullPath, InStrRev(FullPath, "\"))
  Else
   GetFilePath = ""
  End If
 End Function
 '返回文件名
 Public Function filename() As String
    filename = GetFileName(toStr(filefullpath))
 End Function
 '返回文件路径
 Public Function filepath() As String
   filepath = GetFilePath(toStr(filefullpath))
 End Function
'返回文件大小
 Public Function filesize() As String
   filesize = "(" & Round(LenB(filedata) / 1024, 2) & "KB)"
 End Function

Private Sub Class_Terminate()
objstream.Close
Set objstream = Nothing
End Sub