Delphi IdHTTP server load html - delphi

I have created a VCL application and I need to create an HTTP server that runs in my network. I have created the code that you can see below:
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
a: TStringList;
count, logN: integer;
begin
if ARequestInfo.Document = '/' then
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentText := IndexMemo.Lines.Text;
Memo1.Lines.Add(' Client: ' + ARequestInfo.RemoteIP);
end
else
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentText := '<html><body><b>404 NOT FOUND</b></body></html>';
end;
end;
Now I have only a test case if ARequestInfo.Document = '/' then but later I'll need a lot of them. I have found this solution:
Drop a memo in the form
Add the html inside the memo
Load the text of the memo in the ContextText
I don't think that this is very efficient because I'd have to drop like 20 TMemo in my form and the HTML will be difficult to maintain. I thought that I could load the html pages with the Deployment manager.
In the same folder of the Delphi project I have created a folder called pages and it will contain the html files. I am not sure on how to load html pages with an indy HTTP server, so my questions are:
Do I have to store the html pages somewhere in a folder and then load them using indy?
Can I load html pages with indy that are included in the Deployment page?
Note: I would like to have a single exe (which is the http server) and not a folder with exe + html files. The solution that I have found works pretty well because I use a lot of TMemo to store the code, but this is not easy to maintain.

First, the code you have shown is not thread-safe. TIdHTTPServer is a multi-threaded component, the OnCommand... events are triggered in the context of worker threads. You must synchronize with the main UI thread in order to access UI controls safely, eg:
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
s: string;
begin
if ARequestInfo.Document = '/' then
begin
TThread.Synchronize(nil,
procedure
begin
s := IndexMemo.Lines.Text;
Memo1.Lines.Add(' Client: ' + ARequestInfo.RemoteIP);
end
);
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentText := s;
AResponseInfo.ContentType := 'text/plain';
end
else
begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := '<html><body><b>404 NOT FOUND</b></body></html>';
AResponseInfo.ContentType := 'text/html';
end;
end;
Do I have to store the html pages somewhere in a folder and then load them using indy?
Can I load html pages with indy that are included in the Deployment page?
If you want to serve files from the local filesystem, you have to translate the ARequestInfo.Document property value to a local file path, and then you can either:
load the requested file into a TFileStream and assign it to the AResponseInfo.ContentStream property:
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
str, filename: string;
begin
str := ' Client: ' + ARequestInfo.RemoteIP + ' requesting: ' + ARequestInfo.Document;
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add(str);
end
);
if TextStartsWith(ARequestInfo.Document, '/') then
begin
filename := Copy(ARequestInfo.Document, 2, MaxInt);
if filename = '' then
filename := 'index.txt';
// determine local path to requested file
// (ProcessPath() is declared in the IdGlobalProtocols unit)...
filename := ProcessPath(YourDeploymentFolder, filename);
if FileExists(filename) then
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentStream := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
AResponseInfo.ContentType := IdHTTPServer1.MIMETable.GetFileMIMEType(filename);
Exit;
end;
end;
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := '<html><body><b>404 NOT FOUND</b></body></html>';
AResponseInfo.ContentType := 'text/html';
end;
pass the file path to the TIdHTTPResponseInfo.(Smart)ServeFile() method and let it handle the file for you:
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
str, filename: string;
begin
str := ' Client: ' + ARequestInfo.RemoteIP + ' requesting: ' + ARequestInfo.Document;
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add(str);
end
);
if TextStartsWith(ARequestInfo.Document, '/') then
begin
filename := Copy(ARequestInfo.Document, 2, MaxInt);
if filename = '' then
filename := 'index.txt';
// determine local path to requested file...
filename := ProcessPath(YourDeploymentFolder, filename);
AResponseInfo.SmartServeFile(AContext, ARequestInfo, filename);
Exit;
end;
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := '<html><body><b>404 NOT FOUND</b></body></html>';
AResponseInfo.ContentType := 'text/html';
end;
I would like to have a single exe (which is the http server) and not a folder with exe + html files.
In that case, save the HTML files into the EXE's resources at compile-time (using an .rc file, or the IDE's Resources and Images dialog. See Resource Files Support for more details) and then translate the ARequestInfo.Document into a resource ID/Name that you can load with TResourceStream for use as the AResponseInfo.ContentStream object:
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
str, resID: string;
strm: TResourceStream;
begin
str := ' Client: ' + ARequestInfo.RemoteIP + ' requesting: ' + ARequestInfo.Document;
TThread.Queue(nil,
procedure
begin
Memo1.Lines.Add(str);
end
);
if TextStartsWith(ARequestInfo.Document, '/') then
begin
// determine resource ID for requested file
// (you have to write this yourself)...
resID := TranslateIntoResourceID(Copy(ARequestInfo.Document, 2, MaxInt));
try
strm := TResourceStream.Create(HInstance, resID, RT_RCDATA);
except
on E: EResNotFound do
strm := nil;
end;
if strm <> nil then
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentStream := strm;
AResponseInfo.ContentType := 'text/html';
Exit;
end;
end;
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := '<html><body><b>404 NOT FOUND</b></body></html>';
AResponseInfo.ContentType := 'text/html';
end;

You can read the Content from a file
procedure TForm2.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var Page : TStringStream;
begin
Page := TStringStream.Create;
Page.LoadFromFile('put the file path here');
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentStream := page;
end;
You can read the Content from a Resource, go to Project Menu, Resources and Imagens, add the resources that you need.
procedure TForm2.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var page : TResourceStream;
begin
//home is the resource name
page := TResourceStream.Create(HInstance, 'home', RT_RCDATA);
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentStream := page;
end;

Related

Delphi SSL MITM Proxy based on INDY - problem with content loading

I'm writing MITM ssl proxy using indy. i use IdHTTPserver component with self signed certificate for proxy server, and on event of CommandOther i do TcpCleint request to site and return data in HTTPServer. But problem is, some scripts, especially JS and some pictures from web pages not being loaded at all, or load after timeout, so i recieve html code in browser, but crippled by not working js (mostly). Here's my code for CommandOther:
procedure TForm3.IdHTTPServer1CommandOther(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
client: TIdTCPClient;
Headers, headers1: TIdHeaderList;
s, ResponseCode, ResponseText: string;
req,req2:string;
Size: Int64;
Strm,strm2: TIdTCPStream;
ssl: TIdSSLIOHandlerSocketOpenSSL;
clientcount:integer;
begin
Memo3.lines.Add('start');
client := TIdtCPClient.Create(nil);
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(client);
client.IOHandler := ssl;
s := ARequestInfo.URI;
client.Host := Fetch(s, ':', True);
client.Port := StrToIntDef(s, 443);
client.ConnectTimeout := 2000;
s := '';
Memo3.lines.Add('connecting');
client.UseNagle:=true;
client.Connect;
//here i handle CONNECT command
AResponseInfo.ResponseNo := 200;
AResponseInfo.ResponseText := 'Connection established';
aresponseinfo.WriteHeader;
// activate SSL between this proxy and the client
TIdSSLIOHandlerSocketOpenSSL(AContext.Connection.Socket).PassThrough
:= false;
Memo3.lines.Add('connected');
while AContext.Connection.Connected and Client.Connected do
begin
try
memo4.Lines.Add('---start header-------');
headers1 := TIdHeaderList.Create(QuoteHTTP);
headers1.FoldLength := MaxInt;
repeat
s := AContext.Connection.IOHandler.ReadLn;
Memo4.lines.Add(s);
headers1.Add(s);
if s = '' then
Break;
until False;
client.WriteHeader(headers1);
memo4.Lines.Add('-----header written-----');
memo5.Lines.Add('----------');
if Headers1.IndexOfName('Content-Length') <> -1 then
begin
strm2:=TIdTCPStream.Create(client);
memo5.Lines.Add('post');
Size := StrToInt64(Headers1.Values['Content-Length']);
if Size > 0 then
AContext.Connection.IOHandler.ReadStream(Strm2, Size, False);
end;
memo4.Lines.Add('---response headers-------');
Headers := TIdHeaderList.Create(QuoteHTTP);
try
Headers.FoldLength := MaxInt;
repeat
s := client.IOHandler.ReadLn;
Memo4.lines.Add(s);
acontext.Connection.IOHandler.WriteLn(s);
Headers.Add(s);
if s = '' then
Break;
until False;
memo4.Lines.Add('---respone headers read-------');
Strm := TIdTCPStream.Create(AContext.Connection);
try
if Pos('chunked', Headers.Values['Transfer-Encoding']) <> 0 then
begin
memo4.Lines.Add('chunked');
repeat
s := client.IOHandler.ReadLn;
AContext.Connection.IOHandler.WriteLn(s);
Size := StrToInt64('$' + Fetch(s, ';'));
if Size = 0 then
Break;
client.IOHandler.ReadStream(Strm, Size, False);
s := client.IOHandler.ReadLn;
AContext.Connection.IOHandler.WriteLn(s);
until False;
repeat
s := client.IOHandler.ReadLn;
AContext.Connection.IOHandler.WriteLn(s);
until s = '';
end
else if Headers.IndexOfName('Content-Length') <> -1 then
begin
Size := StrToInt64(Headers.Values['Content-Length']);
end;
if Size > 0 then
client.IOHandler.ReadStream(Strm, Size, False);
end
else
begin
memo5.Lines.Add('big read(');
AResponseInfo.CloseConnection := true;
try
client.IOHandler.ReadStream(Strm, -1, True);
except
on E: EIdSocketError do
begin
raise;
end;
end;
end;
finally
Strm.Free;
end;
finally
Headers.Free;
strm2.Free;
headers1.Free;
end;
finally
client.Disconnect;
end;
client.Free;
end;
end;

Delphi indy send file to client and run

I'm making a small server type application.
In a web browser, I want the user to enter the server address and login, and then my server has to return a path to a file that exists on the server. The file has to be run on the user's local computer (these are small Excel files, so it will probably work quickly).
Is it possible to do? Do I have to download the file first and then run it?
The file should run automatically after login, so my server must send the file to the client machine and run it on the client machine.
Can you show me a small example?
P.S. I use Indy components, but if someone has a better idea, I'm open to suggestions.
What you are asking for is technically doable in HTTP, as the response to any HTTP request can be the actual Excel file. For example:
Using HTTP authentication:
procedure TMyForm.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/myfile.xlsx' then
begin
if not ARequestInfo.AuthExists then
begin
AResponseInfo.AuthRealm := 'myserver';
Exit;
end;
if not UserIsAuthenticated(ARequestInfo.AuthUsername, ARequestInfo.AuthPassword) then
begin
AResponseInfo.ResponseNo := 403;
Exit;
end;
case ARequestInfo.CommandType of
hcGET:
begin
AResponseInfo.SmartServeFile(AContext, ARequestInfo, '<path>\myfile.xlsx');
end;
hcHEAD:
begin
AResponseInfo.ContentType := IdHTTPServer1.MIMETable.GetFileMIMEType('myfile.xlsx');
AResponseInfo.ContentLength := FileSizeByName('<path>\myfile.xlsx');
AResponseInfo.ContentDisposition := 'attachment; filename="myfile.xlsx";';
end;
else
AResponseInfo.ResponseNo := 405;
end;
end else
begin
AResponseInfo.ResponseNo := 404;
end;
end;
Using HTML webform authentication:
index.html
<html>
<head>
<title>login</title>
</head>
<body>
<form action="/login" method="POST">
Username: <input type="text" name="user"><br>
Password: <input type="password" name="pswd"><br>
<input type="submit" value="Submit"> <input type="reset" value="Clear">
</form>
</body>
</html>
procedure TMyForm.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
begin
case ARequestInfo.CommandType of
hcGET, hcHEAD:
begin
AResponseInfo.ContentType := 'text/html';
if ARequestInfo.CommandType = hcGET then
AResponseInfo.ContentStream := TIdReadFileExclusiveStream.Create('<path>\index.html')
else
AResponseInfo.ContentLength := FileSizeByName('<path>\index.html');
end;
else
AResponseInfo.ResponseNo := 405;
end;
end
else if ARequestInfo.Document = '/login' then
begin
if ARequestInfo.CommandType <> hcPOST then
begin
AResponseInfo.ResponseNo := 405;
Exit;
end;
if not UserIsAuthenticated(ARequestInfo.Params.Values['user'], ARequestInfo.Params.Values['pswd']) then
begin
AResponseInfo.ResponseNo := 403;
Exit;
end;
AResponseInfo.ServeFile(AContext, '<path>\myfile.xlsx');
end else
begin
AResponseInfo.ResponseNo := 404;
end;
end;
Alternatively:
// make sure to set TIdHTTPServer.SessionState=True...
procedure TMyForm.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
begin
case ARequestInfo.CommandType of
hcGET, hcHEAD:
begin
AResponseInfo.ContentType := 'text/html';
if ARequestInfo.CommandType = hcGET then
AResponseInfo.ContentStream := TIdReadFileExclusiveStream.Create('<path>\index.html')
else
AResponseInfo.ContentLength := FileSizeByName('<path>\index.html');
end;
else
AResponseInfo.ResponseNo := 405;
end;
end
else if ARequestInfo.Document = '/login' then
begin
if ARequestInfo.CommandType <> hcPOST then
begin
AResponseInfo.ResponseNo := 405;
Exit;
end;
if ARequestInfo.Session = nil then
begin
IdHTTPServer1.CreateSession(AContext, AResponseInfo, ARequestInfo);
end;
if not UserIsAuthenticated(ARequestInfo.Params.Values['user'], ARequestInfo.Params.Values['pswd']) then
begin
AResponseInfo.Session.Content.Values['AuthOK'] := 'no';
AResponseInfo.ResponseNo := 403;
Exit;
end;
AResponseInfo.Session.Content.Values['AuthOK'] := 'yes';
//AResponseInfo.Redirect('/myfile.xlsx');
AResponseInfo.ResponseNo := 303;
AResponseInfo.Location := '/myfile.xlsx';
end
else if ARequestInfo.Document = '/myfile.xlsx' then
begin
if ARequestInfo.AuthExists then
begin
if ARequestInfo.Session = nil then
begin
IdHTTPServer1.CreateSession(AContext, AResponseInfo, ARequestInfo);
end;
ARequestInfo.Session.Content.Values['AuthOK'] := iif(UserIsAuthenticated(ARequestInfo.AuthUsername, ARequestInfo.AuthPassword), 'yes', 'no');
end;
if (ARequestInfo.Session = nil) or (ARequestInfo.Session.Content.IndexOf('AuthOK') = -1) then
begin
//AResponseInfo.Redirect('/');
AResponseInfo.ResponseNo := 303;
AResponseInfo.Location := '/';
Exit;
end;
if ARequestInfo.Session.Content.Values['AuthOK'] <> 'yes' then
begin
AResponseInfo.ResponseNo := 403;
Exit;
end;
case ARequestInfo.CommandType of
hcGET:
begin
AResponseInfo.SmartServeFile(AContext, ARequestInfo, '<path>\myfile.xlsx');
end;
hcHEAD:
begin
AResponseInfo.ContentType := IdHTTPServer1.MIMETable.GetFileMIMEType('myfile.xlsx');
AResponseInfo.ContentLength := FileSizeByName('<path>\myfile.xlsx');
AResponseInfo.ContentDisposition := 'attachment; filename="myfile.xlsx";';
end;
else
AResponseInfo.ResponseNo := 405;
end;
end else
begin
AResponseInfo.ResponseNo := 404;
end;
end;
However, either way, the user's web browser would have to be configured beforehand to automatically open .xlsx files in Excel (or whatever viewer/editor they want), or at least to prompt the user whether to open the files. The server can't force the files to be opened automatically, that would be a breach of the user's security.

Delphi indy send stream to client

I am new with indy servers and so I'm struggling for this simple task. I have to create a server and upload a little file; its size is always 128 bytes. Then when someone opens the homepage of the server the file is sent automatically. So:
Upload a file (the one that is 128 bytes) on the disk
Open a browser like Firefox
Type the url (below you can see that I've set 127.0.0.1:798) and when you press enter there is a white page but a dialog appears asking you to download the file.
I have written this code so far:
procedure TForm1.Button1Click(Sender: TObject);
begin
// IP = 127.0.0.1:798 (port is 798)
IdTCPServer1.Active := true;
Memo1.Lines.Add('Server started at: ' + TimeToStr(Now) + slinebreak);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IdTCPServer1.Active := false;
Memo1.Lines.Add('Server stopped at: ' + TimeToStr(Now));
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var a: TFileStream;
begin
a := TFileStream.Create('C:\Users\defaulr.user\Desktop\datfile.pkm', fmOpenWrite);
AContext.Connection.IOHandler.Write(a);
end;
This is the form:
Start is Button1 and End is Button2. As you can see I am loading in a stream the file and then I try to send it as output when I open the page. Is this the proper way to do it?
Since you are accessing the file via a web browser, you should be using TIdHTTPServer instead of TIdTCPServer:
procedure TForm1.Button1Click(Sender: TObject);
begin
// IP = 127.0.0.1:798 (port is 798)
IdHTTPServer1.Active := true;
Memo1.Lines.Add('Server started at: ' + TimeToStr(Now));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IdHTTPServer1.Active := false;
Memo1.Lines.Add('Server stopped at: ' + TimeToStr(Now));
end;
// TIdHTTPServer.OnCommandGet event handler...
procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if ARequestInfo.Document = '/' then
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ServeFile(AContext, 'C:\Users\defaulr.user\Desktop\datfile.pkm');
// alternatively:
// AResponseInfo.SmartServeFile(AContext, ARequestInfo, 'C:\Users\defaulr.user\Desktop\datfile.pkm');
end else
AResponseInfo.ResponseNo := 404;
end;

Cannot connect to TIdHTTPServer from TIdHTTP in delphi

I have an application with TIdHTTPServer and TIdHTTP in delphi and I have this code :
// This is for activating the HTTPServer - works as expected
HTTPServer1.Bindings.Add.IP := '127.0.0.1';
HTTPServer1.Bindings.Add.Port := 50001;
HTTPServer1.Active := True;
This is the OnCommandGet procedure of my HTTPServer :
procedure TDataForm.HttpServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ContentText := 'Hello, user';
end;
And I just don't know why this procedure isn't working :
procedure TDataForm.btnHTTPSendGetClick(Sender: TObject);
var
HTTPClient : TIdHTTP;
responseStream : TMemoryStream;
begin
HTTPClient := TIdHTTP.Create;
responseStream := TMemoryStream.Create;
try
try
HTTPClient.Get('http://127.0.0.1:50001', responseStream);
except on e : Exception do begin
showmessage('Could not send get request to localhost, port 50001');
end;
end;
finally
FreeAndNil(HTTPClient);
FreeAndNil(responseStream);
end;
end;
If I connect via browser I can see in the browser 'Hello, user', but if I try btnHTTPSendGetClick my program crashes with no exception or anything. Can anyone help me fix my code ?
HTTPServer1.Bindings.Add.IP := '127.0.0.1';
HTTPServer1.Bindings.Add.Port := 50001;
This is a common newbie mistake. You are creating two bindings, one bound to 127.0.0.1:DefaultPort, and one bound to 0.0.0.0:50001. You need one binding instead, that is bound to 127.0.0.1:50001 instead.
with HTTPServer1.Bindings.Add do begin
IP := '127.0.0.1';
Port := 50001;
end;
Or:
HTTPServer1.Bindings.Add.SetBinding('127.0.0.1', 50001, Id_IPv4);
Or:
HTTPServer1.DefaultPort := 50001;
HTTPServer1.Bindings.Add.IP := '127.0.0.1';
With that said, your server response is incomplete. Try this instead:
procedure TDataForm.HttpServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
AResponseInfo.ResponseNo := 200;
AResponseInfo.ContentType := 'text/plain';
AResponseInfo.ContentText := 'Hello, user';
end;

Using TidHttp to download Jpeg images from URL (only those that exist)?

I am trying to retrieve a large number of images from the web using a TidHttp component.
The problem is that there is a number of images that are missing (Example: 7403, 7412, etc)
How do i test for only those that exist and save those to file?
procedure TForm.Button1Click(Sender: TObject);
var
MS : TMemoryStream;
JPEGImage: TJPEGImage;
Url, numString: String;
I, Code: Integer;
begin
for I := 7400 to 7500 do
begin
{
Url :='http://www.mywebpage.com/images/DSC' + numString+ '.jpg';
try
idhttp1.Head(URL);
code := idhttp1.ResponseCode;
except on E: EIdHTTPProtocolException do
code := idhttp1.ResponseCode;
end;//try except
if code = 200 then
begin
MS := TMemoryStream.Create;
JPEGImage := TJPEGImage.Create;
try
try
idhttp1.Get(Url, MS); //Send the request and get the image
code := idhttp1.ResponseCode;
MS.Seek(0,soFromBeginning);
JPEGImage.LoadFromStream(MS);//load the image in a Stream
Image1.Picture.Assign(JPEGImage);//Load the image in a Timage component
Image1.Picture.SaveToFile('C:\Museum_Data\DSC' + numString + '.jpg');
Application.ProcessMessages;
except
on E: EIdHTTPProtocolException do
code := idhttp1.ResponseCode; // or: code := E.ErrorCode;
end; //try except
finally
MS.free;
JPEGImage.Free;
end; //try finally
end; //if
end;
end;
You don't have to do anything extra for that. If you try to access a non-existant URL, the HTTP server will report an error that TIdHTTP than wraps into an EIdHTTPProtocolException exception. You do not have to bother with calling TIdHTTP.Head() first, since you are downloading the images to a TMemoryStream before saving them. You can catch the exception when calling TIdHTTP.Get() by itself, no need to check the ResponseCode at all.
Try this:
procedure TForm.Button1Click(Sender: TObject);
var
MS: TMemoryStream;
JPEG: TJPEGImage;
Url: String;
I: Integer;
begin
MS := TMemoryStream.Create;
try
JPEG := TJPEGImage.Create;
try
for I := 7400 to 7500 do
begin
Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) + '.jpg';
MS.Clear;
try
IdHTTP1.Get(Url, MS);
except
on E: EIdHTTPProtocolException do
Continue;
end;
MS.Position := 0;
JPEG.LoadFromStream(MS);
Image1.Picture.Assign(JPEG);
JPEG.SaveToFile('C:\Museum_Data\DSC' + IntToStr(I) + '.jpg');
Application.ProcessMessages;
end;
finally
JPEG.Free;
end;
finally
MS.Free;
end;
end;
You do not actually need the TImage in order to save the data to file. If you can omit the TImage.Picture.Assign() stage, then the code a bit simpler by eliminating the TJPEGImage altogether (unless you are trying to validate the download files are valid), eg:
procedure TForm.Button1Click(Sender: TObject);
var
MS: TMemoryStream;
Url: String;
I: Integer;
begin
MS := TMemoryStream.Create;
try
for I := 7400 to 7500 do
begin
Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) + '.jpg';
MS.Clear;
try
IdHTTP1.Get(Url, MS);
except
on E: EIdHTTPProtocolException do
Continue;
end;
MS.Position := 0;
MS.SaveToFile('C:\Museum_Data\DSC' + IntToStr(I) + '.jpg');
Application.ProcessMessages;
end;
finally
MS.Free;
end;
end;
Or:
procedure TForm.Button1Click(Sender: TObject);
var
FS: TFileStream;
Url, FileName: String;
I: Integer;
begin
for I := 7400 to 7500 do
begin
Url := 'http://www.mywebpage.com/images/DSC' + IntToStr(I) + '.jpg';
FileName := 'C:\Museum_Data\DSC' + IntToStr(I) + '.jpg';
FS := TFileStream.Create(FileName, fmCreate);
try
try
try
IdHTTP1.Get(Url, FS);
except
on E: EIdHTTPProtocolException do
Continue;
end;
Application.ProcessMessages;
finally
Fs.Free;
end;
except
DeleteFile(FileName);
end;
end;
end;

Resources