Серверное программирование в Delphi

Dr.Zlobyus

Xakep, номер #056, стр. 056-074-3

Удачи!

Листинг счетчика

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;

Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);

var

Bitmap: TBitmap;

Hits: Integer;

LogFile: Text;

FileName: string;

Jpeg1: TJpegImage;

Stream: TMemoryStream;

begin

FileName :='Count.log'; //задаем название лог-файла

System.Assign(LogFile, FileName);

try

if FileExists(FileName) then //если файл существует, то добавляем 1 к общему числу посещений

begin

Reset(LogFile);

Readln(LogFile, Hits);

Inc(Hits);

end

else //если нет, то пишем в файл 1

Hits := 1;

Rewrite(LogFile);

Writeln(LogFile, Hits);

finally

Close(LogFile);

end;

Bitmap := TBitmap.Create; //создаем изображение

try

Bitmap.Width := 120;

Bitmap.Height := 25;

Bitmap.Canvas.Font.Name := 'Arial';

Bitmap.Canvas.Font.Size := 14;

Bitmap.Canvas.Font.Color := RGB (255, 127, 0);

Bitmap.Canvas.Font.Style := [fsBold];

Bitmap.Canvas.TextOut (1, 1, 'Hits: ' + FormatFloat ('###,###,###', Int(Hits))); //выводим количество посещений

Jpeg1 := TJpegImage.Create;

try

Jpeg1.CompressionQuality := 50;

Jpeg1.Assign(Bitmap);

Stream := TMemoryStream.Create; //создаем поток

Jpeg1.SaveToStream (Stream); //помещаем в него изображение

Stream.Position := 0;

Response.ContentType := 'image/jpeg';

Response.ContentStream := Stream;

Response.SendResponse; //отсылаем результат

finally

Jpeg1.Free;

end;

finally

Bitmap.Free;

end;

end;