Httpsock.pas

unit HttpSock;
{
 CrtSocket for Delphi 32
 Copyright (C) 1999-2001 Paul Toth <tothpaul@free.fr>
 http://tothpaul.free.fr
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
interface
function URLEncode(s: string): string;
function URLDecode(s: string): string;
function HttpGet(server, url: string; var header: string): string;
function HttpPost(server, url, Data: string; var header: string): string;
implementation
uses
 crtsock, SysUtils;
function URLEncode(s: string): string;
 // http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc1738.html
var
 i: Integer;
 c: Char;
begin
 Result := ;
 for i := 1 to Length(s) do
 begin
 c := s[i];
 case c of
 // non-ASCII
 #$00..#$1F, #$7F, #$80..#$FF,
 // unsafe
 {' ',}'<', '>', '"', '#', '%', '}', '|', '\', '^', '~', '[', ']', '`',
 // reserved
 ';', '/', '?', ':', '@', '=', '&',
 '$', '-', '_', '.', '+', '!', '*', ', '(', ')':
 Result := Result + '%' + IntToHex(Ord(c), 2);
 ' ': Result := Result + '+';
 else
 Result := Result + c;
 end;
 end;
end;
function URLDecode(s: string): string;
var
 i: Integer;
begin
 Result := ;
 i := 1;
 while i <= Length(s) do
 begin
 case s[i] of
 '+': Result := Result + ' ';
 '%': begin
 s[i] := '$';
 Result := Result + Chr(StrToInt(Copy(s, i, 3)));
 Inc(i, 2);
 end;
 else
 Result := Result + s[i];
 end;
 Inc(i);
 end;
end;
function HttpGet(server, url: string; var header: string): string;
var
 handle: Integer;
 sin, sout: textfile;
 s: string;
begin
 handle := CallServer(server, 80);
 if handle <= 0 then
 begin
 Result := ;
 exit;
 end;
 AssignCrtSock(handle, sin, sout);
 WriteLn(sout, 'GET ', url, ' HTTP/1.0');
 WriteLn(sout, 'Accept: */*');
 WriteLn(sout, 'Accept-Language: fr');
 WriteLn(sout, 'User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; FREE)');
 // writeln(sout,'User-Agent: MySoft/1.0 (Delphi)');
 WriteLn(sout, 'Connection: Keep-Alive');
 if header <> then WriteLn(sout, header);
 WriteLn(sout);
 header := ;
 Result := ;
 ReadLn(sin, s);
 while s <> do
 begin
 header := header + s;
 ReadLn(sin, s);
 end;
 while not EOF(sin) do
 begin
 ReadLn(sin, s);
 Result := Result + s;
 end;
 Disconnect(handle);
end;
function HttpPost(server, url, Data: string; var header: string): string;
var
 handle: Integer;
 sin, sout: textfile;
 s: string;
begin
 handle := CallServer(server, 80);
 if handle <= 0 then
 begin
 Result := ;
 exit;
 end;
 AssignCrtSock(handle, sin, sout);
 WriteLn(sout, 'POST ', url, ' HTTP/1.0');
 WriteLn(sout, 'Accept: */*');
 WriteLn(sout, 'Accept-Language: fr');
 WriteLn(sout, 'User-Agent: Mozilla/4.0 (compatible; MSIE 5.5; Windows 98; FREE)');
 // writeln(sout,'User-Agent: MySoft/1.0 (Delphi)');
 WriteLn(sout, 'Content-length: ', Length(Data));
 WriteLn(sout, 'Connection: Keep-Alive');
 if header <> then WriteLn(sout, header);
 WriteLn(sout);
 Write(sout, Data);
 header := ;
 Result := ;
 ReadLn(sin, s);
 while s <> do
 begin
 header := header + s;
 ReadLn(sin, s);
 end;
 while not EOF(sin) do
 begin
 ReadLn(sin, s);
 Result := Result + s;
 end;
 Disconnect(handle);
end;
end.
Category:Связь
Category:Сокеты