Как в консольном приложении Delphi присвоить процедуру для события?

В консольном приложении создаю TIdHttpServer

program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils, IdContext,
  IdCustomHTTPServer, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdHTTPServer;

procedure HTTPServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  if (LowerCase(ARequestInfo.URI) = '/') or (LowerCase(ARequestInfo.URI) = '/index.html') then
  begin
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.ContentType := 'text/html; charset=utf-8';
    AResponseInfo.ContentText := '<html xmlns="http://www.w3.org/1999/xhtml"><body><div align="center">Works!<div></body></html>';
    AResponseInfo.WriteContent;
  end;
end;

var
  HttpServer: TIdHTTPServer;

begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    Writeln('hello');
    HttpServer := TIdHTTPServer.Create(nil);
    HttpServer.DefaultPort := 9876;
    HttpServer.OnCommandGet := HTTPServerCommandGet;
    HttpServer.Active := True;
    ReadLn;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Как, правильно, присвоить событию OnCommandGet, процедуру HTTPServerCommandGet?


Ответы (1 шт):

Автор решения: vegat4

примерно так в блокноте написал

program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils, IdContext,
  IdCustomHTTPServer, IdBaseComponent, IdComponent, IdCustomTCPServer,
  IdHTTPServer;


  type
    TSimp = class
      var  HttpServer: TIdHTTPServer;
      procedure HTTPServerCommandGet(AContext: TIdContext;
       ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
       constructor Create;
       destructor Destroy;override;
    end;


constructor TSimp.Create;
begin
 inherited;
    HttpServer := TIdHTTPServer.Create(nil);
    HttpServer.DefaultPort := 9876;
    HttpServer.OnCommandGet := HTTPServerCommandGet;
end;
destructor TSimp.Destroy;
begin
   HttpServer.Active:=false// или что там не помню
   FreeAndNil(HttpServer);
end;
procedure TSimp.HTTPServerCommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  if (LowerCase(ARequestInfo.URI) = '/') or (LowerCase(ARequestInfo.URI) = '/index.html') then
  begin
    AResponseInfo.ResponseNo := 200;
    AResponseInfo.ContentType := 'text/html; charset=utf-8';
    AResponseInfo.ContentText := '<html xmlns="http://www.w3.org/1999/xhtml"><body><div align="center">Works!<div></body></html>';
    AResponseInfo.WriteContent;
  end;
end;


var
  Simp: TSimp;

begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    Writeln('hello');
    Simp:= TSimp.Create(nil);
    try
      Simp.HttpServer.Active:= true;
      ReadLn;
    finally
      FreeAndNil(Simp);
    end;

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

end.
→ Ссылка