Вопрос: Загрузка файла на сервер по HTTP

Добавлено: 01.10.04 13:59

Автор вопроса:  Resonator

Добрый день. Моя задача сделать аплоад файла по HTTP, который потом будет принят PHP криптом и соответственно обработан. В VB я еще новичок, нашел готовый код в дебрях интренета: You need reference to Microsoft WinHTTP Services 5.0 or 5.1 to use this example 'Credit to Joseph Z. Xu (jzxu@napercom.com) 'Modified by Mohd Idzuan Alias (iklan2k@yahoo.com) August 18, 2004 Dim WinHttpReq As WinHttp.WinHttpRequest Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0 Const HTTPREQUEST_SETCREDENTIALS_FOR_PROXY = 1 Const BOUNDARY = "Xu02=$" Const HEADER = "--Xu02=$" Const FOOTER = "--Xu02=$--" Function UploadFiles(strFileName As Variant, strURL As String, DirPath As String, Optional postVar As String, _                      Optional strUserName As String, Optional strPassword As String) As String     Dim fname As String     Dim strFile As String     Dim strBody As String     Dim aPostBody() As Byte     Dim nFile As Integer              Set WinHttpReq = New WinHttpRequest     ' Turn error trapping on     On Error GoTo SaveErrHandler     ' Assemble an HTTP request.     strURL = strURL & "?slots=" & CStr(UBound(strFileName) + 1) & "&" & postVar     WinHttpReq.Open "POST", strURL, False     Debug.Print strURL          If strUserName <> "" And strPassword <> "" Then         ' Set the user name and password.         WinHttpReq.SetCredentials strUserName, strPassword, _         HTTPREQUEST_SETCREDENTIALS_FOR_SERVER     End If          '-------------------------- Becareful not to mingle too much here -----------------------------------          ' Set the header     WinHttpReq.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & BOUNDARY             ' Assemble the body     strBody = HEADER ' Starting tag          For i = 0 To UBound(strFileName)              ' Grap the name         fname = strFileName(i)                  ' Grap the file         strFile = getFile(DirPath & "\" & fname)                      strBody = strBody & vbCrLf & "Content-Disposition: form-data; name=""" & "upload" & _             (i + 1) & """; filename=""" & fname & """ " & vbCrLf & "Content-type: file" & _             vbCrLf & vbCrLf & strFile & vbCrLf                  If i < UBound(strFileName) Then             strBody = strBody & "--Xu02=$" ' This is boundary tag between two files         End If         strFile = ""              Next i          strBody = strBody & FOOTER ' Ending tag     '----------------------------------------------------------------------------------------------------          ' Because of binary zeros, post body has to convert to byte array     aPostBody = StrConv(strBody, vbFromUnicode)          ' Send the HTTP Request.     WinHttpReq.Send aPostBody          ' Display the status code and response headers.     'UploadFiles = WinHttpReq.GetAllResponseHeaders & " " & WinHttpReq.ResponseText     UploadFiles = WinHttpReq.ResponseText          Set WinHttpReq = Nothing          Exit Function      SaveErrHandler:     UploadFiles = Err.Description          Set WinHttpReq = Nothing      End Function Function getFile(strFileName As String) As String     Dim strFile As String          ' Grap the file     nFile = FreeFile     Open strFileName For Binary As #nFile     strFile = String(LOF(nFile), " ")     Get #nFile, , strFile     Close #nFile          getFile = strFile      End Function Проблема в том, что файл приходит битый (нечетаемый), хоть его размер такой как нужно, также заметил, что дополнительнык параметры передаваемые в запросе так же битые, если они в кирилице. Ответить

Ответы

Всего ответов: 2

Номер ответа: 1 Автор ответа:  DaSharm ICQ: 780477  Вопросов: 72 Ответов: 1297	Web-сайт: dasharm.com  Профиль | | #1	Добавлено: 01.10.04 15:22
	передавай через винсок НТТР методами PUT или POST Ответить

Номер ответа: 2 Автор ответа:  Resonator Вопросов: 5 Ответов: 6	Профиль | | #2	Добавлено: 04.10.04 14:03
	Сделал как подсказали, но теперь сервер ругается , что запрос неверный: Option Explicit Const SockHost = "localhost" Const SockPort = 80 Const SockUrl = "/getfile.php?value1=Hello&value2=World&value3=ïðîáà&slots=1" Private Sub Command1_Click()     Sock.Close     Sock.Connect SockHost, SockPort End Sub Private Sub Sock_Connect()     im Buf As String     im Tmp() As Byte     Buf = _     "POST " & SockUrl & " HTTP/1.0" & vbNewLine & _     "Content-Type: multipart/form-data; boundary=---------------------------7d424a1a1c0232" & vbNewLine & _     "-----------------------------7d424a1a1c0232" & vbNewLine & _     "Content-Disposition: form-data; name=""upload1""; filename=""test_girl.jpg""" & vbNewLine & _     "Content-Type: image/pjpeg" & vbNewLine & vbNewLine & _     FileGetContents("e:\1.jpg" & vbNewLine & _     "-----------------------------7d424a1a1c0232--" & vbNewLine & vbNewLine     Tmp = StrConv(Buf, vbFromUnicode)     'Text1.Text = Tmp     Sock.SendData Tmp End Sub Private Sub Sock_DataArrival(ByVal bytesTotal As Long)     im Buf As String     Sock.GetData Buf, vbString, bytesTotal     Text1.Text = Buf     Sock.Close End Sub Private Sub Sock_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 "Connection error: " & Description, vbCritical, "Connection error" End Sub Private Function FileGetContents(strFilePath)     im Buf As String     im F As Integer     F = FreeFile     On Error GoTo ErrorHandler     Open strFilePath For Binary As F     Buf = String(LOF(F), " "     Get #F, , Buf     Close #F     FileGetContents = Buf     Exit Function ErrorHandler:     MsgBox "File erorr: " & Err.Description, vbCritical, "File error" End Function Ответить

Страница: 1 |