Httpsock.pas
Материал из DRKB
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.