Модераторы: Akina
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Отправка TXT-файла на сервер, по HTTP методом POST на WINAPI 
:(
    Опции темы
DonSalieri
  Дата 13.5.2020, 19:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 13.5.2020

Репутация: нет
Всего: нет



Здравствуйте! Всех с прошедшим Днём Победы!

Есть PHP-файл на сервере с формой отправки файла и есть локальный файл для передачи на сервер.
Проверил результаты функций: на выходе нуля нет. Параметр dwBytesWritten в функции InternetWriteFile выдаёт определённое число отличное от нуля, но файл на сервере не появляется.

Подскажите, пожалуйста, в чём у меня ошибка? Уже несколько дней сижу, не могу понять.

Файл http_in.php:
Код

<!DOCTYPE html>
<html>
<head></head>
<body>

<?php

if ( (is_uploaded_file($_FILES["upfile"]["tmp_name"])) && ($_FILES && $_FILES["upfile"]["error"]==UPLOAD_ERR_OK) )

{
move_uploaded_file($_FILES["upfile"]["tmp_name"], $_FILES["upfile"]["name"]);
echo ("Успешно!");
}

else {echo ("Неудача!");}

?>

<form action="http_in.php" method="post" enctype="multipart/form-data">
<input type="file" name="upfile">
<input type="submit" name="sender" value="Send">
</form>

</body>
</html>


Код, отправляющий файл на сервер:
Код

Option Explicit

Private Type prWinInetContext
dwExitFlag As Long
dwRetCode As Long
dwErrCode As Long
End Type

Private Type INTERNET_BUFFERS
dwStructSize As Long
Next As Long 
lpcszHeader As Long
dwHeadersLength As Long
dwHeadersTotal As Long
lpvBuffer As Long
dwBufferLength As Long
dwBufferTotal As Long
dwOffsetLow As Long
dwOffsetHigh As Long
End Type

Private Const INTERNET_FLAG_ASYNC As Long = &H10000000
Private Const INTERNET_SERVICE_HTTP As Long = 3
Private Const INTERNET_DEFAULT_HTTP_PORT As Long = 80
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const HSR_INITIATE = &H8
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Private Declare Function HttpSendRequestEx Lib "wininet.dll" Alias "HttpSendRequestExA" (ByVal hHttpRequest As Long, lpBuffersIn As INTERNET_BUFFERS, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As Long, ByVal lpBuffer As Long, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByRef hInternet As Long) As Boolean
Private Declare Function HttpEndRequest Lib "wininet.dll" Alias "HttpEndRequestA" (ByVal hHttpRequest As Long, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long

Private Sub Form_Load()

Dim hInternet As Long, hConnect As Long
Dim hRequest As Long
Dim dwContext As prWinInetContext
Dim sOutBuffer As String
Dim szRequest As String
Dim dBuffer As Long
Dim pBuffer() As Byte
Dim BufferIn As INTERNET_BUFFERS
Dim sRequest As String
Dim fLen As Long
Dim sFile As String
Dim i As Integer
Dim pos As Long
Dim dwBytesWritten As Long

Dim rslt1 As Long
Dim rslt2 As Long
Dim rslt3 As Long
Dim rslt4 As Long

hInternet = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hConnect = InternetConnect(hInternet, "www.***.ru", INTERNET_DEFAULT_HTTP_PORT, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
hRequest = HttpOpenRequest(hConnect, "POST", "/http_in.php", "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)


rslt1 = HttpSendRequest(hRequest, vbNullString, 0, vbNullString, 0)


Open App.Path & "\text_out.txt" For Binary Access Read As #71
fLen = LOF(71)
sFile = InputB(fLen, #71)
Close #71

BufferIn.dwStructSize = Len(BufferIn)
BufferIn.Next = 0 
BufferIn.lpcszHeader = 0 
BufferIn.dwHeadersLength = 0
BufferIn.dwHeadersTotal = 0
BufferIn.lpvBuffer = 0 
BufferIn.dwBufferLength = 0
BufferIn.dwBufferTotal = fLen
BufferIn.dwOffsetLow = 0
BufferIn.dwOffsetHigh = 0


rslt2 = HttpSendRequestEx(hRequest, BufferIn, 0, 0, 0)


dBuffer = 2048
ReDim pBuffer(1 To dBuffer)
i = 0

Do

i = i + 1
pos = 2048 * (i - 1) + 1
If fLen - pos < 2048 Then dBuffer = fLen - pos
ReDim pBuffer(1 To dBuffer + 1)

Open App.Path & "\text_out.txt" For Binary Access Read As #71
Get #71, , pBuffer
Close #71

rslt3 = InternetWriteFile(hRequest, VarPtr(pBuffer(1)), dBuffer, dwBytesWritten)

If Not fLen - pos > 2048 Then Exit Do

Loop


rslt4 = HttpEndRequest(hRequest, 0, 0, 0)


Call InternetCloseHandle(hRequest)
Call InternetCloseHandle(hConnect)
Call InternetCloseHandle(hInternet)
End Sub

PM MAIL   Вверх
DonSalieri
Дата 15.5.2020, 09:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 13.5.2020

Репутация: нет
Всего: нет



Вопрос с отправкой файла решён!
Всем огромное спасибо!

Код

Option Explicit
 
Private Const INTERNET_AUTODIAL_FORCE_ONLINE As Long = 1
Private Const INTERNET_OPEN_TYPE_PRECONFIG  As Long = 0
Private Const INTERNET_DEFAULT_HTTP_PORT    As Long = 80
Private Const INTERNET_SERVICE_HTTP         As Long = 3
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
Private Const HTTP_ADDREQ_FLAG_REPLACE      As Long = &H80000000
Private Const HTTP_ADDREQ_FLAG_ADD          As Long = &H20000000
 Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
 
 
 
Private Declare Function HttpSendRequestEx Lib "wininet.dll" Alias "HttpSendRequestExA" (ByVal hHttpRequest As Long, lpBuffersIn As INTERNET_BUFFERS, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
 Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function HttpEndRequest Lib "wininet.dll" Alias "HttpEndRequestA" (ByVal hHttpRequest As Long, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 
Private Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
 
 
 
 
Private Const HTTP_QUERY_CONTENT_TYPE = 1
Private Const HTTP_QUERY_CONTENT_LENGTH = 5
Private Const HTTP_QUERY_EXPIRES = 10
Private Const HTTP_QUERY_LAST_MODIFIED = 11
Private Const HTTP_QUERY_PRAGMA = 17
Private Const HTTP_QUERY_VERSION = 18
Private Const HTTP_QUERY_STATUS_CODE = 19
Private Const HTTP_QUERY_STATUS_TEXT = 20
Private Const HTTP_QUERY_RAW_HEADERS = 21
Private Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Private Const HTTP_QUERY_FORWARDED = 30
Private Const HTTP_QUERY_SERVER = 37
Private Const HTTP_QUERY_USER_AGENT = 39
Private Const HTTP_QUERY_SET_COOKIE = 43
Private Const HTTP_QUERY_REQUEST_METHOD = 45
Private Const HTTP_STATUS_DENIED = 401
Private Const HTTP_STATUS_PROXY_AUTH_REQ = 407
Private Const HSR_INITIATE = &H8
 
'Private Declare Function HttpSendRequestEx Lib "wininet.dll" Alias "HttpSendRequestExA" (ByVal hHttpRequest As Long, lpBuffersIn As INTERNET_BUFFERS, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
 
 
Private Type INTERNET_BUFFERS
dwStructSize As Long
Next As Long
lpcszHeader As Long
dwHeadersLength As Long
dwHeadersTotal As Long
lpvBuffer As Long
dwBufferLength As Long
dwBufferTotal As Long
dwOffsetLow As Long
dwOffsetHigh As Long
End Type
 
Function TranslateErrorCode(ByVal lErrorCode As Long) As String
 
 
Select Case lErrorCode
    Case 12001: TranslateErrorCode = "No more handles could be generated at this Time "
    Case 12002: TranslateErrorCode = "The request has timed out."
    Case 12003: TranslateErrorCode = "An extended error was returned from the server."
    Case 12004: TranslateErrorCode = "An internal error has occurred."
    Case 12005: TranslateErrorCode = "The URL is invalid."
    Case 12006: TranslateErrorCode = "The URL scheme could not be recognized, or is not supported."
    Case 12007: TranslateErrorCode = "The server name could not be resolved."
    Case 12008: TranslateErrorCode = "The requested protocol could not be located."
    Case 12009: TranslateErrorCode = "A request to InternetQueryOption or InternetSetOption specified an invalid option value."
    Case 12010: TranslateErrorCode = "The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified."
    Case 12011: TranslateErrorCode = "The request option can not be set, only queried. "
    Case 12012: TranslateErrorCode = "The Win32 Internet support is being shutdown or unloaded."
    Case 12013: TranslateErrorCode = "The request to connect and login to an FTP server could not be completed because the supplied user name is incorrect."
    Case 12014: TranslateErrorCode = "The request to connect and login to an FTP server could not be completed because the supplied password is incorrect. "
    Case 12015: TranslateErrorCode = "The request to connect to and login to an FTP server failed."
    Case 12016: TranslateErrorCode = "The requested operation is invalid. "
    Case 12017: TranslateErrorCode = "The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed."
    Case 12018: TranslateErrorCode = "The type of handle supplied is incorrect for this operation."
    Case 12019: TranslateErrorCode = "The requested operation can not be carried out because the handle supplied is not in the correct state."
    Case 12020: TranslateErrorCode = "The request can not be made via a proxy."
    Case 12021: TranslateErrorCode = "A required registry value could not be located. "
    Case 12022: TranslateErrorCode = "A required registry value was located but is an incorrect type or has an invalid value."
    Case 12023: TranslateErrorCode = "Direct network access cannot be made at this time. "
    Case 12024: TranslateErrorCode = "An asynchronous request could not be made because a zero context value was supplied."
    Case 12025: TranslateErrorCode = "An asynchronous request could not be made because a callback function has not been set."
    Case 12026: TranslateErrorCode = "The required operation could not be completed because one or more requests are pending."
    Case 12027: TranslateErrorCode = "The format of the request is invalid."
    Case 12028: TranslateErrorCode = "The requested item could not be located."
    Case 12029: TranslateErrorCode = "The attempt to connect to the server failed."
    Case 12030: TranslateErrorCode = "The connection with the server has been terminated."
    Case 12031: TranslateErrorCode = "The connection with the server has been reset."
    Case 12036: TranslateErrorCode = "The request failed because the handle already exists."
    Case Else: TranslateErrorCode = "Error details not available."
End Select
 
 
End Function
 
 
Private Function getQueryOption(info As String, hHttpOpenRequest As Long) As String
    Dim sBuffer         As String * 1024
    Dim lBufferLength   As Long
    Dim intRes As Integer
 
    sBuffer = vbNullString
    lBufferLength = Len(sBuffer)
    intRes = HttpQueryInfo(hHttpOpenRequest, info, ByVal sBuffer, lBufferLength, 0)
    If intRes > 0 Then
        getQueryOption = sBuffer
    Else
        getQueryOption = vbNullString
    End If
End Function
 
 
 
 
 
Private Function HttpPostFromFile(ByVal FileNameToSend As String, _
                                ByRef ReturnString As String, _
                                ByRef result As HTTPTransactionResult) As Boolean
 
 
 
 
    On Local Error GoTo error_handler
    Dim hInternetOpen As Long
    Dim hInternetConnect As Long
    Dim hHttpOpenRequest As Long
    Dim bRet As Boolean
    Dim lret As Long
    Dim iret As Integer
    Dim filenumb As Integer
    Dim macchina As String
    Dim doc As String
    Dim BufferIn As INTERNET_BUFFERS
    Dim abBin() As Byte
 
    Dim sbinfile As String
    Dim nbinfile As Integer
    Dim dwpostsize As Long
    Dim n As Long
    Dim letti As Long
    Dim pbuffer As String
    Dim MyOffset As Long
    Dim chunks As Long
    Dim BytesRemain As Long
    Dim ChunkLen As Long
    Dim bDoLoop             As Boolean
    Dim sReadBuffer         As String * 2048
    Dim lNumberOfBytesRead  As Long
    Dim sHeader As String
 
 
Dim sBoundary As String
 
 
    'Definitions
    ChunkLen = 2048
 
  '  On Error GoTo error_handler
    hInternetOpen = 0
    hInternetConnect = 0
    hHttpOpenRequest = 0
    result.strRETURN_ERROR = vbNullString
    result.intRETURN_ERROR = 0
  '  macchina = URLToMachineName(documento)
  '  doc = URLToPathFileName(documento)
hInternetOpen = InternetOpen("", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
Label1(0).Caption = hInternetOpen
    If hInternetOpen = 0 Then
        result.intRETURN_ERROR = Err.LastDllError
        result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
        HttpPostFromFile = False
    Else 'internetopen ok
hInternetConnect = InternetConnect(hInternetOpen, "www.***.ru", INTERNET_DEFAULT_HTTP_PORT, "", "", INTERNET_SERVICE_HTTP, 0, 0)
    Label1(1).Caption = hInternetConnect
        If hInternetConnect = 0 Then
            result.intRETURN_ERROR = Err.LastDllError
            result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
            HttpPostFromFile = False
        Else 'internetConnect Ok
'hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", "/http_in.php", "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
    hHttpOpenRequest = HttpOpenRequest(hInternetConnect, "POST", "/http_in.php", "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
 
 
         Label1(2).Caption = hHttpOpenRequest
            If hHttpOpenRequest = 0 Then
                result.intRETURN_ERROR = Err.LastDllError
                result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                HttpPostFromFile = False
            Else 'HTTPopenrequest OK
 
 
 
                sBoundary = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
sHeader = "Content-Type: multipart/form-data; boundary=" & sBoundary & vbCrLf
 
'rslt2 = HttpAddRequestHeaders(hRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
'    Label1(4).Caption = rslt2
 
 
    '--- post data
 
 
                  sbinfile = FileNameToSend
 
             ' Text2.Text = "--" & sBoundary & vbCrLf & _
"Content-Disposition: multipart/form-data; name=""upfile""; filename=""" & Mid$(sbinfile, InStrRev(sbinfile, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
"SOD" & vbCrLf & "--" & sBoundary & "--"
 
 
 
 
          '      sHeader = "Content-Type: application/x-octet-stream" & vbCrLf
                iret = HttpAddRequestHeaders(hHttpOpenRequest, _
                                             sHeader, _
                                             Len(sHeader), _
                                             HTTP_ADDREQ_FLAG_REPLACE Or _
                                             HTTP_ADDREQ_FLAG_ADD)
         Label1(3).Caption = iret
                If iret = 0 Then
                    result.intRETURN_ERROR = Err.LastDllError
                    result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                    HttpPostFromFile = False
                Else 'HttpAddRequestHeaders ok
 
                    sbinfile = FileNameToSend
                    nbinfile = FreeFile
                    Open sbinfile For Binary Access Read Lock Write As #nbinfile
 
'
 
                    ReDim abBin(ChunkLen)
    dwpostsize = LOF(nbinfile)
 
   ' Close #nbinfile
 
                    BufferIn.dwStructSize = 40   ' Must be set or error will occur
                    BufferIn.Next = 0
                    BufferIn.lpcszHeader = 0
                    BufferIn.dwHeadersLength = 0
                    BufferIn.dwHeadersTotal = 0
                    BufferIn.lpvBuffer = 0
                    BufferIn.dwBufferLength = 0
                    BufferIn.dwBufferTotal = dwpostsize 'This is the only member used other than dwStructSize
                    BufferIn.dwOffsetLow = 0
                    BufferIn.dwOffsetHigh = 0
                    'HSR_INITIATE try with the second last param.
bRet = HttpSendRequestEx(hHttpOpenRequest, BufferIn, 0, 0, 0)
     Label1(4).Caption = bRet
                    If (bRet = False) Then
                        result.intRETURN_ERROR = Err.LastDllError
                        result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                        HttpPostFromFile = False
                    Else 'SendRequestEx ok
 
 
               '      nbinfile = FreeFile
               '     Open sbinfile For Binary Access Read Lock Write As #nbinfile
 
 
                        chunks = dwpostsize \ ChunkLen
                        BytesRemain = dwpostsize - (chunks * ChunkLen)
                        MyOffset = 1
                        n = 0
                        bRet = True
                        Dim RealChunkLen As Long
                        RealChunkLen = 0
                        While (n < chunks) And (bRet = True)
                            Get #nbinfile, MyOffset, abBin
                            pbuffer = StrConv(abBin, vbUnicode)
 
 
 
 
'pbuffer = "--" & sBoundary & vbCrLf & _
"Content-Disposition: multipart/form-data; name=""upfile""; filename=""" & Mid$(sbinfile, InStrRev(sbinfile, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
StrConv(abBin, vbUnicode) & vbCrLf & "--" & sBoundary & "--"
 
 
 
                            bRet = InternetWriteFile(hHttpOpenRequest, _
                                                    pbuffer, _
                                                    ChunkLen, _
                                                    letti)
                            n = n + 1
                            Text1.Text = Text1.Text & "send " & n
 
                            MyOffset = 1 + (n * ChunkLen)
                        Wend
 
                       Label1(5).Caption = bRet
                        If bRet = False Then
                            result.intRETURN_ERROR = Err.LastDllError
                            result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                            HttpPostFromFile = False
                        Else 'all internetwritefile (- the last) ok
                            ReDim abBin(BytesRemain)
                            Get #nbinfile, MyOffset, abBin
                            pbuffer = StrConv(abBin, vbUnicode) ' & vbCrLf & "--" & sBoundary & "--"
                            'pbuffer = pbuffer & "--AaBbCcDd00--"
 
                            bRet = InternetWriteFile(hHttpOpenRequest, _
                                                        pbuffer, _
                                                        BytesRemain, _
                                                        letti)
 
                            Close #nbinfile
                  Label1(6).Caption = bRet
                            If bRet = False Then
                                result.intRETURN_ERROR = Err.LastDllError
                                result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                                HttpPostFromFile = False
                            Else 'the last internetwritefile ok
                                Dim param As Long
                                param = 0
                                'HSR_INITIATE penultimo
                                lret = HttpEndRequest(hHttpOpenRequest, 0, 0, 0)
Label1(7).Caption = lret
                                If lret = 0 Then
 
                                    result.intRETURN_ERROR = Err.LastDllError
                                    result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                                    HttpPostFromFile = False
                                Else 'HttpEndRequest ok
                                    result.HTTP_QUERY_CONTENT_TYPE = getQueryOption(HTTP_QUERY_CONTENT_TYPE, hHttpOpenRequest)
                                    result.HTTP_QUERY_CONTENT_LENGTH = getQueryOption(HTTP_QUERY_CONTENT_LENGTH, hHttpOpenRequest)
                                    result.HTTP_QUERY_LAST_MODIFIED = getQueryOption(HTTP_QUERY_LAST_MODIFIED, hHttpOpenRequest)
                                    result.HTTP_QUERY_PRAGMA = getQueryOption(HTTP_QUERY_PRAGMA, hHttpOpenRequest)
                                    result.HTTP_QUERY_EXPIRES = getQueryOption(HTTP_QUERY_EXPIRES, hHttpOpenRequest)
                                    result.HTTP_QUERY_VERSION = getQueryOption(HTTP_QUERY_VERSION, hHttpOpenRequest)
                                    result.HTTP_QUERY_STATUS_CODE = getQueryOption(HTTP_QUERY_STATUS_CODE, hHttpOpenRequest)
                                    result.HTTP_QUERY_STATUS_TEXT = getQueryOption(HTTP_QUERY_STATUS_TEXT, hHttpOpenRequest)
                                    result.HTTP_QUERY_RAW_HEADERS = getQueryOption(HTTP_QUERY_RAW_HEADERS, hHttpOpenRequest)
                                    result.HTTP_QUERY_RAW_HEADERS_CRLF = getQueryOption(HTTP_QUERY_RAW_HEADERS_CRLF, hHttpOpenRequest)
                                    result.HTTP_QUERY_FORWARDED = getQueryOption(HTTP_QUERY_FORWARDED, hHttpOpenRequest)
                                    result.HTTP_QUERY_SERVER = getQueryOption(HTTP_QUERY_SERVER, hHttpOpenRequest)
                                    result.HTTP_QUERY_USER_AGENT = getQueryOption(HTTP_QUERY_USER_AGENT, hHttpOpenRequest)
                                    result.HTTP_QUERY_SET_COOKIE = getQueryOption(HTTP_QUERY_SET_COOKIE, hHttpOpenRequest)
                                    result.HTTP_QUERY_REQUEST_METHOD = getQueryOption(HTTP_QUERY_REQUEST_METHOD, hHttpOpenRequest)
                                    If (Val(result.HTTP_QUERY_STATUS_CODE) <> 200) Then
                                        result.intRETURN_ERROR = Val(result.HTTP_QUERY_STATUS_CODE)
                                        result.strRETURN_ERROR = result.HTTP_QUERY_STATUS_TEXT
                                        HttpPostFromFile = False
                                    Else 'Not 200
                                        bDoLoop = True
                                        While bDoLoop = True And bRet = True
                                            sReadBuffer = vbNullString
                                            bRet = InternetReadFile(hHttpOpenRequest, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
                                            ReturnString = ReturnString & Left(sReadBuffer, lNumberOfBytesRead)
                                            If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
                                        Wend
                                   Label1(8).Caption = bRet
                                        If (bRet = False) Then
                                            result.intRETURN_ERROR = Err.LastDllError
                                            result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                                            HttpPostFromFile = False
                                        Else 'InternetReadFile Ok
                                            result.intRETURN_ERROR = 0
                                            result.strRETURN_ERROR = vbNullString
                                            HttpPostFromFile = True
                                        End If
                                    End If ' Not 200
                                End If 'HttpEndRequest
                            End If 'last internetwritefile
                        End If 'all the InternetWriteFile (- the last)
                    End If 'SendRequestEx
                    bRet = InternetCloseHandle(hHttpOpenRequest)
                    If (bRet = False) Then
                        result.intRETURN_ERROR = Err.LastDllError
                        result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                        HttpPostFromFile = False
                    End If
                End If 'HttpAddRequestHeaders ok
            End If 'HTTPopenrequest
            bRet = InternetCloseHandle(hInternetConnect)
            If (bRet = False) Then
                result.intRETURN_ERROR = Err.LastDllError
                result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
                HttpPostFromFile = False
            End If
        End If 'InternetConnect
        bRet = InternetCloseHandle(hInternetOpen)
        If (bRet = False) Then
            result.intRETURN_ERROR = Err.LastDllError
            result.strRETURN_ERROR = TranslateErrorCode(CLng(result.intRETURN_ERROR))
            HttpPostFromFile = False
        End If
    End If 'InternetOpen
    Exit Function
error_handler:
        result.strRETURN_ERROR = Err.Description
        result.intRETURN_ERROR = Err.Number
        HttpPostFromFile = False
 
        Exit Function
End Function
 
Private Sub Form_Load()
 
Dim rslt As HTTPTransactionResult
 
 
Me.Caption = HttpPostFromFile(App.Path & "\123456.txt", Text1.Text, rslt)
 
 
End Sub


Добавлено через 10 минут и 5 секунд
Файл, который я отправляю на сервер, я прикрепил к письму.
Вроде, ещё нужно, наверное, случайным образом Boundary получать, но это отдельный вопрос. Пока и так работает всё.

Присоединённый файл ( Кол-во скачиваний: 3 )
Присоединённый файл  123456.txt 26,61 Kb
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "VB6"
Akina

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по VB обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • Используйте теги [code=vb][/code] для подсветки кода. Используйтe чекбокс "транслит" (возле кнопок кодов) если у Вас нет русских шрифтов.


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Akina.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | VB6 | Следующая тема »


 




[ Время генерации скрипта: 0.1322 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.