* Replaced fphttpclient with indy10.
* Added compression support
This commit is contained in:
2874
indy/examples/httpget/Makefile
Normal file
2874
indy/examples/httpget/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
15
indy/examples/httpget/Makefile.fpc
Normal file
15
indy/examples/httpget/Makefile.fpc
Normal file
@@ -0,0 +1,15 @@
|
||||
[target]
|
||||
programs=httpget
|
||||
implicitunits=httpprothandler ftpprothandler prothandler
|
||||
[require]
|
||||
packages=indy
|
||||
packagedir=../../
|
||||
|
||||
[compiler]
|
||||
unittargetdir=units/$(CPU_TARGET)-$(OS_TARGET)
|
||||
#For some reason, we can't use "unitdir" here. It causes some strange bugs.
|
||||
#This is a workaround.
|
||||
options=-dUseCThreads -gl
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
351
indy/examples/httpget/ftpprothandler.pas
Normal file
351
indy/examples/httpget/ftpprothandler.pas
Normal file
@@ -0,0 +1,351 @@
|
||||
unit ftpprothandler;
|
||||
{$IFDEF FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$ENDIF}
|
||||
interface
|
||||
uses
|
||||
{$IFNDEF NO_FTP}
|
||||
IdFTP,
|
||||
IdFTPList, //for some diffinitions with FTP list
|
||||
IdAllFTPListParsers, //with FTP, this links in all list parsing classes.
|
||||
IdFTPListParseTandemGuardian, //needed ref. to TIdTandemGuardianFTPListItem property
|
||||
IdFTPListTypes, //needed for ref. to TIdUnixBaseFTPListItem property
|
||||
IdFTPListParseVMS, //needed for ref. to TIdVMSFTPListItem property ;
|
||||
IdIOHandler,
|
||||
IdTCPConnection,
|
||||
IdIOHandlerStack,
|
||||
{$ifdef usezlib}
|
||||
IdCompressorZLib, //for deflate FTP support
|
||||
{$endif}
|
||||
IdLogEvent, //for logging component
|
||||
{$ENDIF}
|
||||
prothandler,
|
||||
Classes, SysUtils, IdURI;
|
||||
|
||||
{$IFDEF VER200}
|
||||
{$DEFINE STRING_IS_UNICODE} // 'String' type is Unicode now
|
||||
{$ENDIF}
|
||||
{$IFDEF VER210}
|
||||
{$DEFINE STRING_IS_UNICODE} // 'String' type is Unicode now
|
||||
{$ENDIF}
|
||||
{$IFDEF VER220}
|
||||
{$DEFINE STRING_IS_UNICODE} // 'String' type is Unicode now
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
TFTPProtHandler = class(TProtHandler)
|
||||
protected
|
||||
FPort : Boolean;
|
||||
{$IFNDEF NO_FTP}
|
||||
procedure OnSent(ASender: TComponent; const AText: string; const AData: string);
|
||||
procedure OnReceived(ASender: TComponent; const AText: string; const AData: string);
|
||||
procedure MakeHTMLDirTable(AURL : TIdURI; AFTP : TIdFTP);
|
||||
procedure OnDataChannelCreating(ASender: TObject; ADataChannel: TIdTCPConnection);
|
||||
procedure OnDataChannelDestroy(ASender: TObject; ADataChannel: TIdTCPConnection);
|
||||
procedure OnDirParseStart(ASender : TObject);
|
||||
procedure OnDirParseEnd(ASender : TObject);
|
||||
{$ENDIF}
|
||||
public
|
||||
class function CanHandleURL(AURL : TIdURI) : Boolean; override;
|
||||
procedure GetFile(AURL : TIdURI); override;
|
||||
constructor Create;
|
||||
property Port : Boolean read FPort write FPort;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses IdGlobal;
|
||||
|
||||
class function TFTPProtHandler.CanHandleURL(AURL : TIdURI) : Boolean;
|
||||
begin
|
||||
{$IFDEF NO_FTP}
|
||||
Result := False;
|
||||
{$ELSE}
|
||||
Result := UpperCase(AURL.Protocol)='FTP';
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
constructor TFTPProtHandler.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FPort := False;
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.GetFile(AURL : TIdURI);
|
||||
{$IFDEF NO_FTP}
|
||||
begin
|
||||
{$ELSE}
|
||||
//In this procedure, URL handling has to be done manually because the
|
||||
//the FTP component does not handle URL's at all.
|
||||
var
|
||||
LStr : TMemoryStream;
|
||||
LIO : TIdIOHandlerStack;
|
||||
LF : TIdFTP;
|
||||
LDI : TIdLogEvent;
|
||||
{$ifdef usezlib}
|
||||
LC : TIdCompressorZLib;
|
||||
{$endif}
|
||||
LIsDir : Boolean;
|
||||
i : Integer;
|
||||
begin
|
||||
LIsDir := False;
|
||||
LDI := TIdLogEvent.Create;
|
||||
|
||||
LF := TIdFTP.Create;
|
||||
|
||||
{$ifdef usezlib}
|
||||
LC := TIdCompressorZLib.Create;
|
||||
if LC.IsReady then begin
|
||||
LF.Compressor := LC;
|
||||
end;
|
||||
{$endif}
|
||||
try
|
||||
LDI.Active := True;
|
||||
LDI.LogTime := False;
|
||||
LDI.ReplaceCRLF := False;
|
||||
LDI.OnReceived := OnReceived;
|
||||
LDI.OnSent := OnSent;
|
||||
LIO := TIdIOHandlerStack.Create;
|
||||
LIO.Intercept := LDI;
|
||||
LF.IOHandler := LIO;
|
||||
LF.Passive := not FPort;
|
||||
LF.UseMLIS := True;
|
||||
|
||||
LF.Host := AURL.Host;
|
||||
LF.Password := AURL.URLDecode(AURL.Password);
|
||||
LF.Username := AURL.URLDecode(AURL.Username);
|
||||
LF.IPVersion := AURL.IPVersion;
|
||||
LF.Password := AURL.Password;;
|
||||
if LF.Username = '' then
|
||||
begin
|
||||
LF.Username := 'anonymous';
|
||||
LF.Password := 'pass@httpget';
|
||||
end;
|
||||
if AURL.Document = '' then
|
||||
begin
|
||||
LIsDir := True;
|
||||
end;
|
||||
LStr := TMemoryStream.Create;
|
||||
if FVerbose then begin
|
||||
LF.OnDataChannelCreate := OnDataChannelCreating;
|
||||
LF.OnDataChannelDestroy := OnDataChannelDestroy;
|
||||
LF.OnDirParseStart := OnDirParseStart;
|
||||
LF.OnDirParseEnd := OnDirParseEnd;
|
||||
end;
|
||||
LF.Connect;
|
||||
try
|
||||
LF.ChangeDir(AURL.Path);
|
||||
//The thing is you can't always know if it's a file or dir.
|
||||
if not LIsDir then
|
||||
try
|
||||
LF.Get(AURL.Document,LStr,True);
|
||||
LStr.SaveToFile(AURL.Document);
|
||||
except
|
||||
LIsDir := True;
|
||||
end;
|
||||
if LIsDir then
|
||||
begin
|
||||
LF.List;
|
||||
if FVerbose then
|
||||
begin
|
||||
for i := 0 to LF.ListResult.Count -1 do
|
||||
begin
|
||||
WriteLn({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},LF.ListResult[i]);
|
||||
end;
|
||||
end;
|
||||
MakeHTMLDirTable(AURL,LF);
|
||||
end;
|
||||
finally
|
||||
LF.Disconnect;
|
||||
FreeAndNil(LStr);
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(LF);
|
||||
{$ifdef usezlib}
|
||||
FreeAndNil(LC);
|
||||
{$endif}
|
||||
FreeAndNil(LIO);
|
||||
FreeAndNil(LDI);
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFNDEF NO_FTP}
|
||||
procedure TFTPProtHandler.MakeHTMLDirTable(AURL : TIdURI; AFTP : TIdFTP);
|
||||
{
|
||||
This routine is in this demo to show users how to use the directory listing from TIdFTP.
|
||||
}
|
||||
var i : integer;
|
||||
LTbl : TStringList;
|
||||
LTmp : String;
|
||||
|
||||
procedure WriteTableCell(const ACellText : String; AOutput : TStrings);
|
||||
begin
|
||||
if ACellText = '' then
|
||||
begin
|
||||
AOutput.Add(' <TD> </TD>');
|
||||
end
|
||||
else
|
||||
begin
|
||||
AOutput.Add(' <TD>'+ACellText+'</TD>');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure MakeFileNameLink(const AURL :TIdURI; AFileName : String; AOutput : TStrings);
|
||||
begin
|
||||
if AURL.URI <>'' then
|
||||
begin
|
||||
if AURL.Document = '' then
|
||||
begin
|
||||
AOutput.Add(' <TD><A HREF="'+AURL.URI+'/'+AFileName+'">'+AFileName+'</A></TD>');
|
||||
end
|
||||
else
|
||||
begin
|
||||
AOutput.Add(' <TD><A HREF="'+AURL.URI +AFileName+'>'+AFileName+'</A></TD>');
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteTableCell(AFileName,AOutput);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
LTbl := TStringList.Create;
|
||||
try
|
||||
LTbl.Add('<HTML>');
|
||||
LTbl.Add(' <TITLE>'+AURL.URI+'</TITLE>');
|
||||
{$IFDEF STRING_IS_UNICODE}
|
||||
LTbl.Add(' <HEAD>');
|
||||
LTbl.Add(' <meta http-equiv="Content-Type" content="text/html;charset=utf-8" >');
|
||||
LTbl.Add(' </HEAD>');
|
||||
{$ENDIF}
|
||||
LTbl.Add(' <BODY>');
|
||||
LTbl.Add(' <TABLE>');
|
||||
LTbl.Add(' <TR>');
|
||||
LTbl.Add(' <TH>Name</TH>');
|
||||
LTbl.Add(' <TH>Type</TH>');
|
||||
LTbl.Add(' <TH>Size</TH>');
|
||||
LTbl.Add(' <TH>Date</TH>');
|
||||
LTbl.Add(' <TH>Permissions</TH>');
|
||||
LTbl.Add(' <TH>Owner</TH>');
|
||||
LTbl.Add(' <TH>Group</TH>');
|
||||
LTbl.Add(' </TR>');
|
||||
for i := 0 to AFTP.DirectoryListing.Count - 1 do
|
||||
begin
|
||||
LTbl.Add(' <TR>');
|
||||
//we want the name hyperlinked to it's location so a user can click on it in a browser
|
||||
//to retreive a file.
|
||||
MakeFileNameLink(AURL,AFTP.DirectoryListing[i].FileName,LTbl);
|
||||
case AFTP.DirectoryListing[i].ItemType of
|
||||
ditDirectory : LTmp := 'Directory';
|
||||
ditFile : LTmp := 'File';
|
||||
ditSymbolicLink, ditSymbolicLinkDir : LTmp := 'Symbolic link';
|
||||
ditBlockDev : LTmp := 'Block Device';
|
||||
ditCharDev : LTmp := 'Char Device';
|
||||
ditFIFO : LTmp := 'Pipe';
|
||||
ditSocket : LTmp := 'Socket';
|
||||
end;
|
||||
WriteTableCell(LTmp,LTbl);
|
||||
//Some dir formats will not return a file size or will only do so in some cases.
|
||||
if AFTP.DirectoryListing[i].SizeAvail then
|
||||
begin
|
||||
WriteTableCell(IntToStr(AFTP.DirectoryListing[i].Size),LTbl);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteTableCell('',LTbl);
|
||||
end;
|
||||
//Some dir formats will not return a file date or will only do so in some cases.
|
||||
if AFTP.DirectoryListing[i].ModifiedAvail then
|
||||
begin
|
||||
WriteTableCell(DateTimeToStr(AFTP.DirectoryListing[i].Size),LTbl);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteTableCell('',LTbl);
|
||||
end;
|
||||
WriteTableCell(AFTP.DirectoryListing[i].PermissionDisplay,LTbl);
|
||||
//get owner name
|
||||
if AFTP.DirectoryListing[i] is TIdOwnerFTPListItem then
|
||||
begin
|
||||
WriteTableCell(TIdOwnerFTPListItem(AFTP.DirectoryListing[i]).OwnerName,LTbl);
|
||||
end
|
||||
else
|
||||
begin
|
||||
WriteTableCell('',LTbl);
|
||||
end;
|
||||
//now get group name
|
||||
if AFTP.DirectoryListing[i] is TIdTandemGuardianFTPListItem then
|
||||
begin
|
||||
WriteTableCell(TIdTandemGuardianFTPListItem(AFTP.DirectoryListing[i]).GroupName,LTbl);
|
||||
end;
|
||||
if AFTP.DirectoryListing[i] is TIdUnixBaseFTPListItem then
|
||||
begin
|
||||
WriteTableCell(TIdUnixBaseFTPListItem(AFTP.DirectoryListing[i]).GroupName,LTbl);
|
||||
end;
|
||||
if AFTP.DirectoryListing[i] is TIdVMSFTPListItem then
|
||||
begin
|
||||
WriteTableCell(TIdVMSFTPListItem(AFTP.DirectoryListing[i]).GroupName,LTbl);
|
||||
end;
|
||||
LTbl.Add(' </TR>');
|
||||
end;
|
||||
LTbl.Add(' </TABLE>');
|
||||
LTbl.Add(' </BODY>');
|
||||
LTbl.Add('</HTML>');
|
||||
{$IFDEF STRING_IS_UNICODE}
|
||||
LTbl.SaveToFile('index.html', TEncoding.UTF8)
|
||||
{$ELSE}
|
||||
LTbl.SaveToFile('index.html');
|
||||
{$ENDIF}
|
||||
finally
|
||||
FreeAndNil(LTbl);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.OnSent(ASender: TComponent; const AText: string; const AData: string);
|
||||
var LData : String;
|
||||
begin
|
||||
LData := AData;
|
||||
if TextStartsWith(LData,'PASS ') then begin
|
||||
FLogData.Text := FLogData.Text + 'PASS ****';
|
||||
end;
|
||||
FLogData.Text := FLogData.Text + LData;
|
||||
if FVerbose then begin
|
||||
Write({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},LData);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.OnDataChannelCreating(ASender: TObject;
|
||||
ADataChannel: TIdTCPConnection);
|
||||
begin
|
||||
WriteLn({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},'Opening Data Channel');
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.OnDataChannelDestroy(ASender: TObject;
|
||||
ADataChannel: TIdTCPConnection);
|
||||
begin
|
||||
WriteLn({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},'Closing Data Channel');
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.OnDirParseEnd(ASender: TObject);
|
||||
begin
|
||||
WriteLn({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},'DIR Parsing finished');
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.OnDirParseStart(ASender: TObject);
|
||||
begin
|
||||
WriteLn('Dir Parsing Started');
|
||||
end;
|
||||
|
||||
procedure TFTPProtHandler.OnReceived(ASender: TComponent; const AText: string; const AData: string);
|
||||
begin
|
||||
FLogData.Text := FLogData.Text + AData;
|
||||
if FVerbose then
|
||||
begin
|
||||
Write({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},AData);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
114
indy/examples/httpget/httpget.pas
Normal file
114
indy/examples/httpget/httpget.pas
Normal file
@@ -0,0 +1,114 @@
|
||||
program httpget;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
prothandler,
|
||||
ftpprothandler,
|
||||
httpprothandler,
|
||||
Classes
|
||||
{ add your units here },
|
||||
IdGlobal, //for some helper functions I like
|
||||
IdURI,
|
||||
SysUtils;
|
||||
|
||||
procedure PrintHelpScreen;
|
||||
var LExe : String;
|
||||
begin
|
||||
LExe := ExtractFileName(ParamStr(0));
|
||||
WriteLn(LExe);
|
||||
WriteLn('');
|
||||
WriteLn('usage: '+LExe+' [-v] URL');
|
||||
WriteLn('');
|
||||
WriteLn(' v : Verbose');
|
||||
end;
|
||||
|
||||
var
|
||||
GURL : TIdURI;
|
||||
|
||||
i : Integer;
|
||||
LP : TProtHandler;
|
||||
|
||||
//program defaults
|
||||
GVerbose : Boolean;
|
||||
GHelpScreen : Boolean;
|
||||
GFTPPort : boolean;
|
||||
|
||||
const
|
||||
GCmdOpts : array [0..5] of string=('-h','--help','-v','--verbose','-P','--port');
|
||||
begin
|
||||
GFTPPort := False;
|
||||
GHelpScreen := False;
|
||||
GVerbose := False;
|
||||
LP := nil;
|
||||
GURL := TIdURI.Create;
|
||||
try
|
||||
if ParamCount > 0 then
|
||||
begin
|
||||
for i := 1 to ParamCount do
|
||||
begin
|
||||
if Copy(ParamStr(i),1,1) = '-' then
|
||||
begin
|
||||
WriteLn(ParamStr(i));
|
||||
case PosInStrArray(ParamStr(i),GCmdOpts) of
|
||||
0, 1 : begin
|
||||
GHelpScreen := True;
|
||||
break;
|
||||
end;
|
||||
2, 3 : GVerbose := True;
|
||||
4, 5 : GFTPPort := True;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
|
||||
GURL.URI := ParamStr(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
end
|
||||
else
|
||||
begin
|
||||
GHelpScreen := True;
|
||||
end;
|
||||
WriteLn(GURL.URI);
|
||||
if (GURL.URI = '') or GHelpScreen then
|
||||
begin
|
||||
GHelpScreen := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
try
|
||||
if THTTPProtHandler.CanHandleURL(GURL) then
|
||||
begin
|
||||
LP := THTTPProtHandler.Create;
|
||||
LP.Verbose := GVerbose;
|
||||
LP.GetFile(GURL);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if TFTPProtHandler.CanHandleURL(GURL) then
|
||||
begin
|
||||
LP := TFTPProtHandler.Create;
|
||||
LP.Verbose := GVerbose;
|
||||
TFTPProtHandler(LP).Port := GFTPPort;
|
||||
LP.GetFile(GURL);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(LP);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(GURL);
|
||||
end;
|
||||
if GHelpScreen then
|
||||
begin
|
||||
PrintHelpScreen;
|
||||
end;
|
||||
end.
|
||||
|
||||
|
||||
|
||||
196
indy/examples/httpget/httpprothandler.pas
Normal file
196
indy/examples/httpget/httpprothandler.pas
Normal file
@@ -0,0 +1,196 @@
|
||||
unit httpprothandler;
|
||||
interface
|
||||
{$IFDEF FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$ENDIF}
|
||||
{$ifdef unix}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$endif}
|
||||
{$IFDEF POSIX}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$ENDIF}
|
||||
{$ifdef win32}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$endif}
|
||||
{$ifdef win64}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
{$IFNDEF NO_HTTP}
|
||||
{$ifdef usezlib}
|
||||
IdCompressorZLib, //for deflate and gzip content encoding
|
||||
{$endif}
|
||||
IdAuthenticationDigest, //MD5-Digest authentication
|
||||
{$ifdef useopenssl}
|
||||
IdSSLOpenSSL, //ssl
|
||||
IdAuthenticationNTLM, //NTLM - uses OpenSSL libraries
|
||||
{$endif}
|
||||
Classes, SysUtils,
|
||||
IdHTTPHeaderInfo, //for HTTP request and response info.
|
||||
IdHTTP,
|
||||
{$ENDIF}
|
||||
prothandler,
|
||||
IdURI;
|
||||
|
||||
type
|
||||
THTTPProtHandler = class(TProtHandler)
|
||||
protected
|
||||
{$IFNDEF NO_HTTP}
|
||||
function GetTargetFileName(AHTTP : TIdHTTP; AURI : TIdURI) : String;
|
||||
{$ENDIF}
|
||||
public
|
||||
class function CanHandleURL(AURL : TIdURI) : Boolean; override;
|
||||
procedure GetFile(AURL : TIdURI); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
class function THTTPProtHandler.CanHandleURL(AURL : TIdURI) : Boolean;
|
||||
begin
|
||||
{$IFNDEF NO_HTTP}
|
||||
Result := UpperCase(AURL.Protocol)='HTTP';
|
||||
{$ifdef useopenssl}
|
||||
if not Result then
|
||||
begin
|
||||
Result := UpperCase(AURL.Protocol)='HTTPS';
|
||||
end;
|
||||
{$endif}
|
||||
{$ELSE}
|
||||
Result := False;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THTTPProtHandler.GetFile(AURL : TIdURI);
|
||||
{$IFNDEF NO_HTTP}
|
||||
var
|
||||
{$ifdef useopenssl}
|
||||
LIO : TIdSSLIOHandlerSocketOpenSSL;
|
||||
{$endif}
|
||||
LHTTP : TIdHTTP;
|
||||
LStr : TMemoryStream;
|
||||
i : Integer;
|
||||
LHE : EIdHTTPProtocolException;
|
||||
LFName : String;
|
||||
{$ifdef usezlib}
|
||||
LC : TIdCompressorZLib;
|
||||
{$endif}
|
||||
begin
|
||||
{$ifdef useopenssl}
|
||||
LIO := TIdSSLIOHandlerSocketOpenSSL.Create;
|
||||
{$endif}
|
||||
{$ifdef usezlib}
|
||||
LC := TIdCompressorZLib.Create;
|
||||
{$endif}
|
||||
try
|
||||
LHTTP := TIdHTTP.Create;
|
||||
try
|
||||
{$ifdef useopenssl}
|
||||
LHTTP.Compressor := LC;
|
||||
{$endif}
|
||||
//set to false if you want this to simply raise an exception on redirects
|
||||
LHTTP.HandleRedirects := True;
|
||||
{
|
||||
Note that you probably should set the UserAgent because some servers now screen out requests from
|
||||
our default string "Mozilla/3.0 (compatible; Indy Library)" to prevent address harvesters
|
||||
and Denial of Service attacks. SOme people have used Indy for these.
|
||||
|
||||
Note that you do need a Mozilla string for the UserAgent property. The format is like this:
|
||||
|
||||
Mozilla/4.0 (compatible; MyProgram)
|
||||
}
|
||||
LHTTP.Request.UserAgent := 'Mozilla/4.0 (compatible; httpget)';
|
||||
LStr := TMemoryStream.Create;
|
||||
{$ifdef useopenssl}
|
||||
LHTTP.IOHandler := LIO;
|
||||
{$endif}
|
||||
for i := 0 to LHTTP.Request.RawHeaders.Count -1 do
|
||||
begin
|
||||
FLogData.Add(LHTTP.Request.RawHeaders[i]);
|
||||
if FVerbose then
|
||||
begin
|
||||
WriteLn({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},LHTTP.Request.RawHeaders[i]);
|
||||
end;
|
||||
end;
|
||||
LHTTP.Get(AURL.URI,LStr);
|
||||
for i := 0 to LHTTP.Response.RawHeaders.Count -1 do
|
||||
begin
|
||||
FLogData.Add(LHTTP.Response.RawHeaders[i]);
|
||||
if FVerbose then
|
||||
begin
|
||||
WriteLn({$IFDEF FPC}stdout{$ELSE}output{$ENDIF},LHTTP.Response.RawHeaders[i]);
|
||||
end;
|
||||
end;
|
||||
LFName := GetTargetFileName(LHTTP,AURL);
|
||||
if LFName <> '' then
|
||||
begin
|
||||
LStr.SaveToFile(LFName);
|
||||
end;
|
||||
|
||||
except
|
||||
on E : Exception do
|
||||
begin
|
||||
if E is EIdHTTPProtocolException then
|
||||
begin
|
||||
LHE := E as EIdHTTPProtocolException;
|
||||
WriteLn({$IFDEF FPC}stderr{$ELSE}ErrOutput {$ENDIF},'HTTP Protocol Error - '+IntToStr(LHE.ErrorCode));
|
||||
WriteLn({$IFDEF FPC}stderr{$ELSE}ErrOutput {$ENDIF},LHE.ErrorMessage);
|
||||
if Verbose = False then
|
||||
begin
|
||||
for i := 0 to FLogData.Count -1 do
|
||||
begin
|
||||
Writeln({$IFDEF FPC}stderr{$ELSE}ErrOutput {$ENDIF},FLogData[i]);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Writeln({$IFDEF FPC}stderr{$ELSE}ErrOutput {$ENDIF},E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FreeAndNil(LHTTP);
|
||||
FreeAndNil(LStr);
|
||||
finally
|
||||
{$ifdef useopenssl}
|
||||
FreeAndNil(LIO);
|
||||
{$endif}
|
||||
{$ifdef usezlib}
|
||||
FreeAndNil(LC);
|
||||
{$endif}
|
||||
end;
|
||||
{$ELSE}
|
||||
begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFNDEF NO_HTTP}
|
||||
function THTTPProtHandler.GetTargetFileName(AHTTP : TIdHTTP; AURI : TIdURI) : String;
|
||||
|
||||
begin
|
||||
{
|
||||
We do things this way in case the server gave you a specific document type
|
||||
in response to a request.
|
||||
|
||||
eg.
|
||||
|
||||
Request: http://www.indyproject.org/
|
||||
Response: http://www.indyproject.org/index.html
|
||||
}
|
||||
if AHTTP.Response.Location <> '' then
|
||||
begin
|
||||
AURI.URI := AHTTP.Response.Location;
|
||||
end;
|
||||
Result := AURI.Document;
|
||||
if Result = '' then
|
||||
begin
|
||||
Result := 'index.html';
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
51
indy/examples/httpget/prothandler.pas
Normal file
51
indy/examples/httpget/prothandler.pas
Normal file
@@ -0,0 +1,51 @@
|
||||
unit prothandler;
|
||||
interface
|
||||
{$IFDEF FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$ENDIF}
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$ENDIF}
|
||||
{$IFDEF POSIX}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$ENDIF}
|
||||
{$IFDEF WIN32}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$ENDIF}
|
||||
{$IFDEF WIN64}
|
||||
{$define usezlib}
|
||||
{$define useopenssl}
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, IdURI;
|
||||
type
|
||||
TProtHandler = class(TObject)
|
||||
protected
|
||||
FLogData : TStrings;
|
||||
FVerbose : Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
class function CanHandleURL(AURL : TIdURI) : Boolean; virtual; abstract;
|
||||
procedure GetFile(AURL : TIdURI); virtual; abstract;
|
||||
property LogData : TStrings read FLogData;
|
||||
property Verbose : Boolean read FVerbose write FVerbose;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TProtHandler.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FLogData := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TProtHandler.Destroy;
|
||||
begin
|
||||
FreeAndNil(FLogData);
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user