源码分享网络编程

使用winsock模拟http协议实现的上传文件

这里是使用的winsock模拟http协议实现的上传文件示例,

代码看起来是老外写的,下载自 newxing 网站。

有时间了我封装一个基于 winhttp 实现的,会比这个方便。

看代码:


'Download by http://www.NewXing.com
Option Explicit

Dim blnConnected As Boolean ' flag which indicates whether or not winsock has
                            ' a connection


' this function builds a http request baes on the following parameters:
'
' data = the data from the file to be uploaded
' DestUrl = a URL to containing information on where to send the data
' UploadName = the field upload name usually pass by <input type="file" name="uploadname"
' Filename = the name of the file
' The MIME type of the file
Private Function BuildFileUploadRequest(ByRef strData As String, _
                                        ByRef DestUrl As URL, _
                                        ByVal UploadName As String, _
                                        ByVal FileName As String, _
                                        ByVal MimeType As String) As String
    
    Dim strHttp As String ' holds the entire HTTP request
    Dim strBoundary As String 'the boundary between each entity
    Dim strBody As String ' holds the body of the HTTP request
    Dim lngLength As Long ' the length of the HTTP request
        
    ' create a boundary consisting of a random string
    strBoundary = RandomAlphaNumString(32)
    
    ' create the body of the http request in the form
    '
    ' --boundary
    ' Content-Disposition: form-data; name="UploadName"; filename="FileName"
    ' Content-Type: MimeType
    '
    ' file data here
    '--boundary--
    strBody = "--" & strBoundary & vbCrLf
    strBody = strBody & "Content-Disposition: form-data; name=""" & UploadName & """; filename=""" & _
                    FileName & """" & vbCrLf
    strBody = strBody & "Content-Type: " & MimeType & vbCrLf
    strBody = strBody & vbCrLf & strData
    strBody = strBody & vbCrLf & "--" & strBoundary & "--"
    
    ' find the length of the request body - this is required for the
    ' Content-Length header
    lngLength = Len(strBody)
    
    ' construct the HTTP request in the form:
    '
    ' POST /path/to/reosurce HTTP/1.0
    ' Host: host
    ' Content-Type: multipart-form-data, boundary=boundary
    ' Content-Length: len(strbody)
    '
    ' HTTP request body
    strHttp = "POST " & DestUrl.URI & "?" & DestUrl.Query & " HTTP/1.0" & vbCrLf
    strHttp = strHttp & "Host: " & DestUrl.Host & vbCrLf
    strHttp = strHttp & "Content-Type: multipart/form-data, boundary=" & strBoundary & vbCrLf
    strHttp = strHttp & "Content-Length: " & lngLength & vbCrLf & vbCrLf
    strHttp = strHttp & strBody

    BuildFileUploadRequest = strHttp
End Function
                                     
' this routine does all the work - it gathers the info required for the HTTP request
' and sends it via the winsock control
Private Sub cmdUpload_Click()
    Dim strFile As String
    Dim strHttp As String
    Dim DestUrl As URL
    
    ' if a request is allredy being sent
    ' exit
    If blnConnected Then Exit Sub
    
    ' check that a file was selected
    If txtUploadFile.Text = vbNullString Then
        MsgBox "No File Chosen", vbCritical, "ERROR"
        
        Exit Sub
    End If

    ' extract the URL using a helper function
    DestUrl = ExtractUrl(txtUrl.Text)
    
    If DestUrl.Host = vbNullString Then
        MsgBox "Invalid Host", vbCritical, "ERROR"
        
        Exit Sub
    End If
    
    ' clear the old response
    txtResponse.Text = ""
    
    ' read the file contents as a string
    ' N.B: in HTTP everything is a string, even binary files
    strFile = GetFileContents(txtUploadFile.Text)
    
    ' build the HTTP request
    strHttp = BuildFileUploadRequest(strFile, DestUrl, txtName.Text, file.FileName, txtMIMEType.Text)
    
    ' assign the protocol host and port
    Winsock1.Protocol = sckTCPProtocol
    Winsock1.RemoteHost = DestUrl.Host
    
    If DestUrl.Port <> 0 Then
        Winsock1.RemotePort = DestUrl.Port
    Else
        Winsock1.RemotePort = 80
    End If
            
    ' make the connection and send the HTTP request
    Winsock1.Connect
    
    While Not blnConnected
        DoEvents
    Wend
    
    txtRequest.Text = strHttp
    Winsock1.SendData strHttp
End Sub

' this is executed when winsock sneds us data
' in our case it will be the HTTP response
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String
    
    Winsock1.GetData strData, vbString, bytesTotal
    
    txtResponse.Text = txtResponse.Text & strData
    
End Sub

' this is executed when winsock generates an error
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    MsgBox Description, vbExclamation, "ERROR"
    
    Winsock1.Close
End Sub

' this is executed when we make a connection to winsock and it has been accepted
Private Sub Winsock1_Connect()
    blnConnected = True
End Sub

' this is executed when the connection to winsock is closed
Private Sub Winsock1_Close()
    Winsock1.Close
    blnConnected = False

End Sub

' this function retireves the contents of a file and returns it as a string
' this is also ture for binary files
Private Function GetFileContents(ByVal strPath As String) As String
    Dim StrReturn As String
    Dim lngLength As Long
    
    lngLength = FileLen(strPath)
    StrReturn = String(lngLength, Chr(0))
    
    On Error GoTo ERR_HANDLER
    
    Open strPath For Binary As #1
    
    Get #1, , StrReturn
    
    GetFileContents = StrReturn
    
    Close #1
    
    Exit Function
    
ERR_HANDLER:
    MsgBox Err.Description, vbCritical, "ERROR"
    
    Err.Clear
End Function

' generates a random alphanumeirc string of a given length
Private Function RandomAlphaNumString(ByVal intLen As Integer)
    Dim StrReturn As String
    
    Dim X As Integer
    Dim c As Byte
    
    Randomize
    
    For X = 1 To intLen
        c = Int(Rnd() * 127)
    
        If (c >= Asc("0") And c <= Asc("9")) Or _
           (c >= Asc("A") And c <= Asc("Z")) Or _
           (c >= Asc("a") And c <= Asc("z")) Then
           
            StrReturn = StrReturn & Chr(c)
        Else
            X = X - 1
        End If
    Next X
    
    RandomAlphaNumString = StrReturn
End Function

' the routines below have nothing to do with winsock
' they control the working of the GUI
Private Sub lblFile_Click()
    dir.SetFocus
End Sub

Private Sub lblMIMEType_Click()
    txtMIMEType.SetFocus
End Sub

Private Sub lblName_Click()
    txtName.SetFocus
End Sub

Private Sub lblUrl_Click()
    txtUrl.SetFocus
End Sub

Private Sub txtMIMEType_GotFocus()
    txtMIMEType.SelStart = 0
    txtMIMEType.SelLength = Len(txtMIMEType.Text) + 1
End Sub

Private Sub txtName_GotFocus()
    txtName.SelStart = 0
    txtName.SelLength = Len(txtName.Text) + 1
End Sub

Private Sub txtUrl_GotFocus()
    txtUrl.SelStart = 0
    txtUrl.SelLength = Len(txtUrl.Text) + 1
End Sub

Private Sub dir_Change()
    file.Path = dir.Path
End Sub

Private Sub file_Click()
    txtUploadFile.Text = file.Path & "\" & file.FileName
End Sub

Views: 98

Hi, I’m 邓伟

本来无一物,何处惹尘埃

发表回复