Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[54.224.52.210] |
|
Страницы: (5) « Первая ... 2 3 [4] 5 все ( Перейти к последнему сообщению ) |
Сообщ.
#46
,
|
|
|
Нашёл рабочий пример отправки файла на HTTP через WinSock(см. аттач). А нельзя ли передать на HTTP сервер текстовую строку, и чтобы она записалась там в файл, то есть не файл передавать, а массив текстовых строк, и чтобы там на сервере под этот массив создавался файл, куда собственно всё и будет записано. Можно так?
Прикреплённый файлfile_upload.rar (6,9 Кбайт, скачиваний: 253) |
Сообщ.
#47
,
|
|
|
Цитата salieri @ Можно так? да без проблем. этот (и любой другой) форум, кстати, так и работает браузер передаёт серверу строки ваших сообщений, на сервере скрипт их обдумывает, передаёт Базе Данных, и она пишет их в файл а серьёзно — никаких проблем нет, хоть POST-методом, хоть GET-ом вы можете передать строку серверу — но вам понадобится скрипт на сервере, который примет её и запишет куда надо. |
Сообщ.
#48
,
|
|
|
Почему я не осиливаю API, я в посте #29 выложил пример на API по отправке файла на сервер через API. Он почему-то не заработал. Может кто-нибудь знает, что нужно указать, чтобы файл отправился на сервер? HTTPClass.cls 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 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 <?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 <?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, всё безрезультатно 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 |
Сообщ.
#49
,
|
|
|
Цитата salieri @ всё безрезультатно давайте логи. что отсылается на сервер, что он отвечает? |
Сообщ.
#50
,
|
|
|
Цитата DarknessPaladin @ давайте логи. что отсылается на сервер, что он отвечает? а где их взять? они куда-то записываются? |
Сообщ.
#51
,
|
|
|
Цитата salieri @ а где их взять? они куда-то записываются? у вас есть ваша программа. в той части, что на бейсике, а не на php, логи вы можете писАть в консоль отладки, вставляя Debug.Print "абыргыр" в нужные места (переменные тоже можно так выводить). |
Сообщ.
#52
,
|
|
|
DarknessPaladin, я вывожу в debug.print результат запроса, в итоге поле immediate пустое, то есть туда ничего не выводится. А вообще правильно ли я вызываю функцию с методом POST???
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 |
Сообщ.
#53
,
|
|
|
Цитата 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 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 (много раз) и смотрите, что происходит. |
Сообщ.
#54
,
|
|
|
DarknessPaladin, прошёлся я по программе и выяснил, что Request=0 !!!
|
Сообщ.
#55
,
|
|
|
Цитата salieri @ Request=0 хм... Цитата salieri @ Dim Request As String я не понял, какой реквест и где. |
Сообщ.
#56
,
|
|
|
DarknessPaladin, я ошибся Request="" , то есть vbnullstring, Request расположен в функции SendRequest
|
Сообщ.
#57
,
|
|
|
в SendRequest:
Цитата salieri @ Request = BuildRequest Цитата salieri @ 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. если тут пусто — копай, где они должны были заполнится. |
Сообщ.
#58
,
|
|
|
DarknessPaladin, гемморойный пример я нашёл, некогда с ним разбираться. Буквально за 3 минуты накидал новый пример. Этот пример будет попроще. При нажатии на command1 проект зависает! В чём ошибка?
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 |
Сообщ.
#59
,
|
|
|
падает на RtlZeroMemory. я не знаю, что это за функция и почему на ней падает.
|
Сообщ.
#60
,
|
|
|
DarknessPaladin, это
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long) Я немного поправил код. Попробовал вызвать без ZeroMemory, хотябы не вылетает, но и результата нет! 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 |