<html>
<body>
<img src="/webbin/project1.exe/GetImage">
</body>
</html>
[PROJECT1.DPR]
program Project1;
{$APPTYPE CONSOLE}
uses
WebBroker,
CGIApp,
Unit1 in 'Unit1.pas' {WebModule1: TWebModule};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TWebModule1, WebModule1);
Application.Run;
end.
[UNIT1.DFM]
object WebModule1: TWebModule1
OldCreateOrder = False
Actions = <
item
Default = True
Name = 'GetImage'
OnAction = WebModule1GetImageAction
end>
Left = 193
Top = 198
Height = 150
Width = 215
object Table1: TTable
Active = True
DatabaseName = 'DBDEMOS'
TableName = 'animals.dbf'
Left = 48
Top = 16
object Table1NAME: TStringField
FieldName = 'NAME'
Size = 10
end
object Table1SIZE: TSmallintField
FieldName = 'SIZE'
end
object Table1WEIGHT: TSmallintField
FieldName = 'WEIGHT'
end
object Table1AREA: TStringField
FieldName = 'AREA'
end
object Table1BMP: TBlobField
FieldName = 'BMP'
BlobType = ftTypedBinary
Size = 1
end
end
end
[UNIT1.PAS]
unit Unit1;
interface
uses
SysUtils, Classes, HTTPApp, DB, DBTables, Graphics, Jpeg;
type
TWebModule1 = class(TWebModule)
Table1: TTable;
Table1NAME: TStringField;
Table1SIZE: TSmallintField;
Table1WEIGHT: TSmallintField;
Table1AREA: TStringField;
Table1BMP: TBlobField;
procedure WebModule1GetImageAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WebModule1: TWebModule1;
implementation
{$R *.DFM}
procedure TWebModule1.WebModule1GetImageAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
Jpg: TJPEGImage;
S: TMemoryStream;
B: TBitmap;
begin
Jpg := TJPEGImage.Create;
try
B := TBitmap.Create;
try
B.Assign(table1BMP);
Jpg.Assign(B);
finally
B.Free
end;
S := TMemoryStream.Create;
Jpg.SaveToStream(S);
S.Position := 0;
Response.ContentType := 'image/jpeg';
Response.ContentStream := S;
// do not free the stream because the response
// object will handle that task.
finally
Jpg.Free;
end;
end;
end.
