Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

форма на WinInet [D6, Win95/98, Win2k, WinXP]


Kerch ©   (2004-02-18 20:15:00) 

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


Kerch   (2004-02-20 17:29:00) [1]

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


easy   (2004-02-19 11:08:00) [2]

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;


Наверх

Титульная страница Поиск, карта сайта Написать письмо