Форум: "Сети";
Текущий архив: 2004.04.25;
Скачать: [xml.tar.bz2];

Вниз

форма на WinInet   Найти похожие ветки 

← →
Kerch   (2004-02-18 20:15) [0]

Помогите отослать форму с помощью WinInet

---

← →
easy ©   (2004-02-19 11:08) [1]

uses wininet;

const
 INTERNET_CONNECTION_OFFLINE = $20;

function GetPage(Host, Path, Postdata: string;
 Response: TMemoryStream): integer;
var
 hSession, hConnect, hRequest: hInternet;
 RequestMethod, Header: string;
 Buf: array[0..1023] of Char;
 ReadCount: Cardinal;
 BS: Cardinal;
 ConnectedState: DWord;
 procedure SetTimeOut;
 var
   TimeOut: integer;
 begin
   TimeOut := 8 * 1000;
   InternetSetOption(hSession, INTERNET_OPTION_RECEIVE_TIMEOUT, @TimeOut,
     SizeOf(TimeOut));
 end;
 procedure GetHttpStatus;
 var
   Len, Reserved: DWORD;
 begin
   Reserved := 0;
   Len := SizeOf(Result);
   HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
     @Result, Len, Reserved)
 end;
begin
 Result := 0;
 InternetGetConnectedState(@ConnectedState, 0);
 if INTERNET_CONNECTION_OFFLINE and ConnectedState =
   INTERNET_CONNECTION_OFFLINE then begin
   showmessage("Àâòîíîìíàÿ ðàáîòà");
   exit;
 end;
 hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
 try
   SetTimeOut;
   hConnect := InternetConnect(hSession, PChar(Host),
     INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
   try
     if Postdata = "" then
       RequestMethod := "GET"
     else
       RequestMethod := "POST";
     hRequest := HttpOpenRequest(hConnect, PChar(RequestMethod),
       PChar(Path), "HTTP/1.0", nil, nil,
       INTERNET_FLAG_RELOAD, 0);
     try
       if Postdata = "" then
         Header := ""
       else
         Header := "Content-type: application/x-www-form-urlencoded";

       HttpSendRequest(hRequest, PChar(Header),
         Length(Header), PChar(Postdata), Length(Postdata));
       GetHttpStatus;

       if Result <> HTTP_STATUS_OK then begin
         Exit;
       end;

       while True do
       begin
         if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), ReadCount) then
           Break;
         if ReadCount = 0 then
           Break
         else begin
           Response.Write(Buf, ReadCount);
         end;
       end;
     finally
       InternetCloseHandle(hRequest);
     end;
   finally
     InternetCloseHandle(hConnect);
   end;
 finally
   InternetCloseHandle(hSession);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 M: TmemoryStream;
 poststring: string;
begin
 memo1.Clear;
 M := TmemoryStream.Create;
 GetPage("url.ru", "/cgi-bin/script.pl", "user=12345&pass=54321", M);
 M.Position := 0;
 memo1.Lines.LoadFromStream(M);
 M.Free;
end;

---

← →
Kerch   (2004-02-20 17:29) [2]

Спасибо,easy ,все работает.

---

Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2004.04.25;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.04 c