На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Правила раздела Visual Basic: Общие вопросы
Здесь обсуждаются вопросы по языку Visual Basic 1-6 (а так же по схожим языкам, как, например, PowerBASIC).
Вопросы по Visual Basic .NET (это который входит в состав Visual Studio 2002/2003/2005/2008+, для тех, кто не в курсе) обсуждаются в разделе .NET.

Обратите внимание:
1. Прежде чем начать новую тему или отправить сообщение, убедитесь, что Вы не нарушаете правил форума!
2. Обязательно воспользуйтесь поиском. Возможно, Ваш вопрос уже обсуждали. Полезные ссылки приведены ниже.
3. Темы с просьбой выполнить какую-либо работу за автора в этом разделе не обсуждаются. Студенты, вам сюда: ПОМОЩЬ СТУДЕНТАМ!
4. Используйте теги [ code=vba ] ...текст программы... [ /code ] для выделения текста программы подсветкой.
5. Помните, здесь телепатов нет. Формулируйте свой вопрос максимально грамотно и чётко: Как правильно задавать вопросы
6. Запрещено отвечать в темы месячной (и более) давности, без веских на то причин.

Полезные ссылки:
user posted image FAQ Сайта user posted image FAQ Раздела user posted image Кладовка user posted image Наши Исходники user posted image API-Guide user posted image Поиск по Разделу user posted image MSDN Library Online user posted image Google

Ваше мнение о модераторах: user posted image SCINER, user posted image B.V.
Модераторы: SCINER, B.V.
Страницы: (5) « Первая ... 2 3 [4] 5  все  ( Перейти к последнему сообщению )  
> Отправить файл на сервер
    Нашёл рабочий пример отправки файла на HTTP через WinSock(см. аттач). А нельзя ли передать на HTTP сервер текстовую строку, и чтобы она записалась там в файл, то есть не файл передавать, а массив текстовых строк, и чтобы там на сервере под этот массив создавался файл, куда собственно всё и будет записано. Можно так?

    Прикреплённый файлПрикреплённый файлfile_upload.rar (6,9 Кбайт, скачиваний: 253)
    Сообщение отредактировано: salieri -
      Цитата salieri @
      Можно так?

      да без проблем. этот (и любой другой) форум, кстати, так и работает ;)
      браузер передаёт серверу строки ваших сообщений, на сервере скрипт их обдумывает, передаёт Базе Данных, и она пишет их в файл ;)

      а серьёзно — никаких проблем нет, хоть POST-методом, хоть GET-ом вы можете передать строку серверу — но вам понадобится скрипт на сервере, который примет её и запишет куда надо.
        Цитата DarknessPaladin @
        не осиливаете апишки

        Почему я не осиливаю API, я в посте #29 выложил пример на API по отправке файла на сервер через API. Он почему-то не заработал. Может кто-нибудь знает, что нужно указать, чтобы файл отправился на сервер?

        HTTPClass.cls
        ExpandedWrap disabled
          Option Explicit
           
          Public Enum ePort
             INTERNET_DEFAULT_HTTP_PORT = 80
             INTERNET_DEFAULT_HTTPS_PORT = 443
          End Enum
           
          Private Const INTERNET_OPEN_TYPE_DIRECT = 1
          Private Const INTERNET_SERVICE_HTTP = 3
           
          Private Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100
          Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
          Private Const INTERNET_FLAG_SECURE = &H800000
          Private Const INTERNET_FLAG_FROM_CACHE = &H1000000
          Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
          Private Const INTERNET_FLAG_RELOAD = &H80000000
           
          Private Const BUFFER_LENGTH As Long = 1024
           
          Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal Agent As String, ByVal AccessType As Long, ByVal ProxyName As String, ByVal ProxyBypass As String, ByVal Flags As Long) As Long
          Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal ServerName As String, ByVal ServerPort As Integer, ByVal UserName As String, ByVal Password As String, ByVal Service As Long, ByVal Flags As Long, ByVal Context As Long) As Long
          Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Boolean
           
          Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hConnect As Long, ByVal Buffer As String, ByVal NumberOfBytesToRead As Long, NumberOfBytesRead As Long) As Boolean
           
          Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal Verb As String, ByVal ObjectName As String, ByVal Version As String, ByVal Referer As String, ByVal AcceptTypes As Long, ByVal Flags As Long, Context As Long) As Long
          Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal Headers As String, ByVal HeadersLength As Long, ByVal sOptional As String, ByVal OptionalLength As Long) As Boolean
           
          Private hHTTP As Long
          Private hConnection As Long
           
          Private Const FIELDS_BUFFER_LENGTH As Long = 10
          Private Const FIELDS_NAME_INDEX As Long = 0
          Private Const FIELDS_VALUE_INDEX As Long = 1
           
          Private DontEncode(255) As Boolean
           
          Private FieldCount As Long
          Private mFields() As String
           
          Public Property Let Fields(Name As String, Value As String)
           
             mFields(FIELDS_VALUE_INDEX, GetFieldIndex(Name, True)) = Value
           
          End Property
           
          Public Property Get Fields(Name As String) As String
           
             Dim l As Long
            
             l = GetFieldIndex(Name, False)
             If l > -1 Then
                Fields = mFields(FIELDS_VALUE_INDEX, l)
             End If
           
          End Property
           
          Public Function OpenHTTP(Server As String, Optional Port As ePort = INTERNET_DEFAULT_HTTP_PORT, Optional UserName As String, Optional Password As String) As Boolean
            
             CloseHTTP
            
             hHTTP = InternetOpen("HTTP Client", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
             If hHTTP <> 0 Then
                hConnection = InternetConnect(hHTTP, Server, INTERNET_DEFAULT_HTTP_PORT, UserName, Password, INTERNET_SERVICE_HTTP, 0, 0)
                If hConnection <> 0 Then
                   OpenHTTP = True
                Else
                   InternetCloseHandle hHTTP
                   hHTTP = 0
                End If
             End If
            
          End Function
           
          Public Sub CloseHTTP()
              
              If hConnection <> 0 Then
                InternetCloseHandle hConnection
              End If
              
              hConnection = 0
              
              If hHTTP Then
                InternetCloseHandle hHTTP
              End If
              
              hHTTP = 0
           
          End Sub
           
          Public Function SendRequest(ByVal File As String, Optional Method As String = "GET", Optional Referer As String, Optional Reload As Boolean = True) As String
           
             Dim hRequest As Long
             Dim r As Boolean
             Dim Buffer As String
             Dim Header As String
             Dim Request As String
             Dim POSTData As String
             Dim Response As String
             Dim Read As Long
             Dim Flags As Long
            
             Method = UCase$(Method)
             Request = BuildRequest
             Buffer = Space$(BUFFER_LENGTH)
            
             If Len(Request) > 0 Then
                If Method = "POST" Then
                   Header = "Content-Type: application/x-www-form-urlencoded"
                   POSTData = Request
                Else
                   File = File & "?" & Request
                End If
             End If
            
             If Reload Then
                Flags = Flags Or INTERNET_FLAG_PRAGMA_NOCACHE Or INTERNET_FLAG_RELOAD
             End If
            
             hRequest = HttpOpenRequest(hConnection, Method, File, "HTTP/1.1", "", 0, Flags, 0)
             If hRequest <> 0 Then
                If HttpSendRequest(hRequest, Header, Len(Header), POSTData, Len(POSTData)) Then
                   r = InternetReadFile(hRequest, Buffer, BUFFER_LENGTH, Read)
                   While r And (Read <> 0)
                      Response = Response & Left$(Buffer, Read)
                      r = InternetReadFile(hRequest, Buffer, BUFFER_LENGTH, Read)
                   Wend
                End If
                InternetCloseHandle hRequest
             End If
            
             SendRequest = Response
            
          End Function
           
          Private Function GetFieldIndex(Name As String, Optional Add As Boolean) As Long
           
             Dim l As Long
            
             For l = 0 To FieldCount - 1
                If StrComp(Name, mFields(FIELDS_NAME_INDEX, l), vbTextCompare) = 0 Then
                   GetFieldIndex = l
                   Exit Function
                End If
             Next
            
             If Add Then
                If FieldCount = UBound(mFields, 2) Then
                   ReDim Preserve mFields(1, UBound(mFields, 2) + FIELDS_BUFFER_LENGTH)
                End If
                mFields(FIELDS_NAME_INDEX, FieldCount) = Name
                GetFieldIndex = FieldCount
                FieldCount = FieldCount + 1
             Else
                GetFieldIndex = -1
             End If
            
          End Function
           
          Private Function BuildRequest() As String
           
             Dim l As Long
             Dim s As String
            
             For l = 0 To FieldCount - 1
                s = s & URLEncode(mFields(FIELDS_NAME_INDEX, l)) & "=" & URLEncode(mFields(FIELDS_VALUE_INDEX, l)) & "&"
             Next
           
             If Len(s) > 0 Then
                BuildRequest = Left$(s, Len(s) - 1)
             End If
           
          End Function
           
          Public Function URLEncode(Data As String) As String
           
             Dim l As Long
             Dim b() As Byte
             Dim s As String
             Dim c As String
            
             b = Data
             'This is fine for encoding small strings
             'To encode large ones I suggest you replace s with the String Class
             For l = 0 To UBound(b) Step 2
                If DontEncode(b(l)) Then
                   s = s & Chr(b(l))
                Else
                   c = Hex(b(l))
                   While Len(c) < 2
                      c = "0" & c
                   Wend
                   s = s & "%" & c
                End If
             Next
            
             URLEncode = s
            
          End Function
           
          Private Sub Class_Initialize()
           
             Dim l As Long
           
             ReDim mFields(1, FIELDS_BUFFER_LENGTH)
           
             For l = Asc("0") To Asc("9")
                DontEncode(l) = True
             Next
             For l = Asc("a") To Asc("z")
                DontEncode(l) = True
             Next
             For l = Asc("A") To Asc("Z")
                DontEncode(l) = True
             Next
           
          End Sub
           
          Private Sub Class_Terminate()
           
             Erase mFields
            
          End Sub


        Form1.frm
        ExpandedWrap disabled
          Private Sub Command2_Click()
           
          Dim h As HTTPClass
          Set h = New HTTPClass
           
          If h.OpenHTTP("http://arnoldgames.areal.ru") Then
          Debug.Print h.SendRequest("http://arnoldgames.areal.ru/example/post_dump.php", "POST")
          End If
           
          Set h = Nothing
          End Sub


        post_dump.php
        ExpandedWrap disabled
          <?php
              /* check for and loop through uploaded files */
              foreach ($_FILES as $name => $info) {
                  /* chekc the file has a valid name */
                  if (($info['name'] != 'ht.access' &&
                      substr($info['name'], 0,1) != '.' &&
                      $info['name'] != 'allowed_files')) {
           
                      /* attempt to move the file to the uploaded_files directory */
                      if (@move_uploaded_file($info['tmp_name'], "uploaded_files/files/{$info['name']}")) {
                          /* get the contenst of the array of files */
                          $file_arrays = @unserialize(@file_get_contents('uploaded_files/allowed_files'));        
              
                          /* if there are more already 5 files, remove the oldest item fomr the array
                           * and delete it
                           */
                          if (count(@$file_arrays['files']) == 5) {
                              $name = array_shift($file_arrays['files']);
                      
                              unset($file_arrays['types'][$name]);
                              @unlink('uploaded_files/files/' . $name);
                          }
           
                          /* add the new item to the arrays */
                          $file_arrays['files'][] = $info['name'];
                          $file_arrays['types'][$info['name']] = $info['type'];
           
                          /* serialize the array and write it back to the file */
                          if ($fhwnd = @fopen('uploaded_files/allowed_files', 'wb+')) {
                              fwrite($fhwnd, serialize($file_arrays));
                              fclose($fhwnd);
                          }
                      }          
                  }    
              }
          ?>
          <html>
              <head>
                  <title>Form Post Dump</title>
              </head>
              <body>
                  <?php if ($_POST): ?>
                      <p>You submitted the following POST variables with the following names:</p>
                      <ul><?php foreach($_POST as $name => $var) : ?>
                          <li><?php echo(htmlspecialchars($name)) ?> = <?php echo(htmlspecialchars($var)) ?></li>
                      <?php endforeach; ?></ul>
                  <?php endif; ?>
                  <?php if ($_GET): ?>
                      <p>You submitted the following fariables with the query string:</p>
                      <ul><?php foreach($_GET as $name => $var) : ?>
                          <li><?php echo(htmlspecialchars($name)) ?> = <?php echo(htmlspecialchars($var)) ?></li>
                      <?php endforeach; ?></ul>
                  <?php endif; ?>
                  <?php if ($_FILES): ?>
                      <p>You submitted the following FILES:</p>
                      <ul><?php foreach($_FILES as $name => $info): ?>
                          <li>File name: <?php echo(htmlspecialchars($name)) ?>
                      <ul>
                          <li>Client file name: <?php echo(htmlspecialchars($info['name'])) ?></li>
                          <li>File MIME type: <?php echo(htmlspecialchars($info['type'])) ?></li>
                          <li>File size: <?php echo(htmlspecialchars($info['size'])) ?></li>
                          <li>Download link: <a href="uploaded_files.php?file=<?php echo(htmlspecialchars($info['name'])) ?>"><?php echo(htmlspecialchars($info['name'])) ?></a></li>
                      </ul>
                      </li>
                  </ul>
                      <?php endforeach; ?></ul>
                  <?php endif; ?>
                  <form enctype="multipart/form-data" action="<?php echo($_SERVER['PHP_SELF']) ?>" method="post">
                      <p>Variable1: <input type="text" name="variable1" /></p>
                      <p>Variable2: <input type="text" name="variable2" /></p>
                      <p>Variable3: <input type="text" name="variable3" /></p>
                      <p>File: <input type="file" name="file1" /></p>
                      <p><input type="submit" value="Post" /></p>
                  </form>
              </body>
          </html>


        uploaded_files.php
        ExpandedWrap disabled
          <?php
              /* load the file containg the list of uploaded files in to an array */
              $file_arrays = @unserialize(@file_get_contents('uploaded_files/allowed_files'));
           
              /* check the data was loaded successfully - if not, create an empty array */
              if (!is_array($file_arrays)) {
                  $file_arrays = array('files' => array(), 'types' => array());
              }
           
              /* check for the existance of a file variable in the queery string
               * if its there, this contains the name of the file to be downlaoded
               */
              if (isset($_GET['file'])) {
                  $file = $_GET['file'];
                  
                  /* check the file is in the array retrieved from the file */
                  if (in_array($file, @$file_arrays['files'])) {
                      /* get the Content-Type of the file */
                      header('Content-Type: ' . $file_arrays['types'][$file]);
                      header('Content-Disposition: attachment; filename="' . $file . '"');
           
                      /* send the file */
                      @readfile("uploaded_files/files/$file");
                      exit;
                  }
              }
          ?>
          <html>
              <head>
                  <title>Uploaded Files</title>
              </head>
              <body>
                  <h3>Recently Uploaded Files</h3>
                  <ul>
                      <?php foreach($file_arrays['files'] as $file): ?>
                          <li><a href="<?php echo($_SERVER['PHP_SELF'] . '?file=' . htmlspecialchars($file))?>">
                              <?php echo(htmlspecialchars($file)) ?></a>
                          </li>
                      <?php endforeach; ?>
                  </ul>
              </body>
          </html>


        Добавлено
        Пробовал ещё через GET, всё безрезультатно

        ExpandedWrap disabled
          Dim fh As Long
          Dim h As HTTPClass
          Set h = New HTTPClass
           
          If h.OpenHTTP("http://arnoldgames.areal.ru") Then
          fh = FreeFile
          Open App.Path & "\123456.txt" For Binary As #fh
          Put #fh, , h.SendRequest("http://arnoldgames.areal.ru/example/post_dump.php", "GET")
          Close #fh
          End If
           
          Set h = Nothing
          Цитата salieri @
          всё безрезультатно

          давайте логи. что отсылается на сервер, что он отвечает?
            Цитата DarknessPaladin @
            давайте логи. что отсылается на сервер, что он отвечает?

            а где их взять? они куда-то записываются?
              Цитата salieri @
              а где их взять? они куда-то записываются?

              у вас есть ваша программа. в той части, что на бейсике, а не на php, логи вы можете писАть в консоль отладки, вставляя Debug.Print "абыргыр" в нужные места (переменные тоже можно так выводить).
                DarknessPaladin, я вывожу в debug.print результат запроса, в итоге поле immediate пустое, то есть туда ничего не выводится. А вообще правильно ли я вызываю функцию с методом POST???

                ExpandedWrap disabled
                  Private Sub Command2_Click()
                   
                  Dim h As HTTPClass
                  Set h = New HTTPClass
                   
                  If h.OpenHTTP("http://arnoldgames.areal.ru") Then
                  Debug.Print h.SendRequest("http://arnoldgames.areal.ru/example/post_dump.php", "POST")
                  End If
                   
                  Set h = Nothing
                  End Sub
                Сообщение отредактировано: salieri -
                  Цитата salieri @
                  я вывожу в debug.print результат запроса, в итоге поле immediate пустое

                  Цитата salieri @
                  If h.OpenHTTP("http://arnoldgames.areal.ru") Then
                  Debug.Print h.SendRequest("http://arnoldgames.areal.ru/example/post_dump.php", "POST")
                  End If

                  ExpandedWrap disabled
                    stop
                    If h.OpenHTTP("http://arnoldgames.areal.ru") Then
                    Debug.Print h.SendRequest("http://arnoldgames.areal.ru/example/post_dump.php", "POST")
                    else
                    msgbox "ooops..."
                    End If

                  else -- это раз.

                  а стоп — это два. после того, как встанет на стоп, нажимайте F8 (много раз) и смотрите, что происходит.
                    DarknessPaladin, прошёлся я по программе и выяснил, что Request=0 !!!
                      Цитата salieri @
                      Request=0

                      хм...
                      Цитата salieri @
                      Dim Request As String


                      я не понял, какой реквест и где.
                        DarknessPaladin, я ошибся Request="" , то есть vbnullstring, Request расположен в функции SendRequest
                        Сообщение отредактировано: salieri -
                          в SendRequest:
                          Цитата salieri @
                          Request = BuildRequest


                          Цитата salieri @
                          ExpandedWrap disabled
                            Private Function BuildRequest() As String
                             
                               Dim l As Long
                               Dim s As String
                             
                               For l = 0 To FieldCount - 1
                                  s = s & URLEncode(mFields(FIELDS_NAME_INDEX, l)) & "=" & URLEncode(mFields(FIELDS_VALUE_INDEX, l)) & "&"
                               Next
                             
                               If Len(s) > 0 Then
                                  BuildRequest = Left$(s, Len(s) - 1)
                               End If
                             
                            End Function


                          ну, и что мы видим? а видим мы, что возвращаемый запрос состоит из набора пар (mFields(FIELDS_NAME_INDEX, L), mFields(FIELDS_VALUE_INDEX, L)).

                          смотри что приходит в массиве mFields, чему равен FieldCount. если тут пусто — копай, где они должны были заполнится.
                            DarknessPaladin, гемморойный пример я нашёл, некогда с ним разбираться. Буквально за 3 минуты накидал новый пример. Этот пример будет попроще. При нажатии на command1 проект зависает! В чём ошибка?

                            ExpandedWrap disabled
                              Option Explicit
                               
                              Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
                              Private Declare Sub RtlZeroMemory Lib "kernel32" (dst As Any, ByVal nBytes&)
                              Private Declare Function InternetOpen Lib "wininet" 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 InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
                              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 lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, ByVal lpszReferer As String, ByVal lpszAcceptTypes As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
                              Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal lpOptional As String, ByVal dwOptionalLength As Long) As Boolean
                              Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
                              Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
                               
                               
                              Const INTERNET_OPEN_TYPE_DIRECT = 1
                              Const INTERNET_DEFAULT_HTTP_PORT = 80
                              Const INTERNET_SERVICE_HTTP = 3
                              Const MB_ICONINFORMATION As Long = &H20&
                               
                               
                              Private Function SendRequest(sUrl As String, pageAddr As String, postheader As String, returnBuf As String, bufLen As Long) As Long
                               
                              Dim hInternet As Long
                              Dim hConnect As Long
                              Dim hRequest As Long
                              Dim readed As Long
                              Dim ret As Long
                               
                              RtlZeroMemory returnBuf, bufLen
                              hInternet = InternetOpen("hoverlees", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
                               
                              hConnect = InternetConnect(hInternet, sUrl, INTERNET_DEFAULT_HTTP_PORT, 0, 0, INTERNET_SERVICE_HTTP, 0, 0)
                               
                              hRequest = HttpOpenRequest(hConnect, "POST", pageAddr, 0, 0, 0, 0, 0)
                               
                              ret = lstrlen(postheader)
                               
                              HttpSendRequest hRequest, "Content-Type: application/x-www-form-urlencoded", 47, postheader, ret
                              InternetReadFile hRequest, returnBuf, bufLen, readed
                              InternetCloseHandle hRequest
                              InternetCloseHandle hConnect
                              InternetCloseHandle hInternet
                               
                              SendRequest = readed
                               
                              End Function
                               
                              Private Sub Command1_Click()
                               
                              Dim retBuf As String
                               
                              SendRequest "http://arnoldgames.areal.ru", "/a.php", "item1=yes&item2=no&item3=yes", retBuf, 1000
                              MessageBox Me.hwnd, retBuf, "The Server returns", MB_ICONINFORMATION
                               
                              End Sub
                            Сообщение отредактировано: salieri -
                              падает на RtlZeroMemory. я не знаю, что это за функция и почему на ней падает.
                                DarknessPaladin, это
                                ExpandedWrap disabled
                                  Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)


                                Я немного поправил код. Попробовал вызвать без ZeroMemory, хотябы не вылетает, но и результата нет!

                                ExpandedWrap disabled
                                  Option Explicit
                                   
                                  Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
                                  Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
                                  Private Declare Function InternetOpen Lib "wininet" 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 InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
                                  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 lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, ByVal lpszReferer As String, ByVal lpszAcceptTypes As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
                                  Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal lpOptional As String, ByVal dwOptionalLength As Long) As Boolean
                                  Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
                                  Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
                                   
                                  Const INTERNET_OPEN_TYPE_PRECONFIG = 0
                                  Const INTERNET_OPEN_TYPE_DIRECT = 1
                                  Const INTERNET_DEFAULT_HTTP_PORT = 80
                                  Const INTERNET_SERVICE_HTTP = 3
                                  Const MB_ICONINFORMATION As Long = &H20&
                                   
                                   
                                  Private Function SendRequest(sUrl As String, pageAddr As String, postheader As String, returnBuf As String, bufLen As Long) As Long
                                   
                                  Dim hInternet As Long
                                  Dim hConnect As Long
                                  Dim hRequest As Long
                                  Dim readed As Long
                                  Dim ret As Long, ret2 As Long, ret3 As Long
                                   
                                  ZeroMemory returnBuf, bufLen
                                   
                                  hInternet = InternetOpen("hoverlees", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
                                   
                                  hConnect = InternetConnect(hInternet, sUrl, INTERNET_DEFAULT_HTTP_PORT, vbNullString, vbNullString, INTERNET_SERVICE_HTTP, 0, 0)
                                   
                                  hRequest = HttpOpenRequest(hConnect, "POST", pageAddr, vbNullString, vbNullString, vbNullString, 0, 0)
                                   
                                  ret = lstrlen(postheader)
                                   
                                  ret2 = HttpSendRequest(hRequest, "Content-Type: application/x-www-form-urlencoded", 47, postheader, ret)
                                  ret3 = InternetReadFile(hRequest, returnBuf, bufLen, readed)
                                  InternetCloseHandle hRequest
                                  InternetCloseHandle hConnect
                                  InternetCloseHandle hInternet
                                   
                                  SendRequest = readed
                                   
                                  End Function
                                   
                                  Private Sub Command1_Click()
                                   
                                  Dim retBuf As String, ret As Long, ret2 As Long
                                   
                                  ret = SendRequest("http://arnoldgames.areal.ru", "a.php", "item1=yes&item2=no&item3=yes", retBuf, 1000)
                                  ret2 = MessageBox(Me.hwnd, retBuf, "The Server returns", MB_ICONINFORMATION)
                                   
                                  End Sub
                                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                0 пользователей:


                                Рейтинг@Mail.ru
                                [ Script execution time: 0,0613 ]   [ 19 queries used ]   [ Generated: 30.03.24, 07:11 GMT ]