TWebModuleMain = class(TWebModule)
//--------------------------------------------------------------------------
//Webservice für HTTP Requests
//--------------------------------------------------------------------------
//Default Web Handler, liefert
HTML Rumpf für "ungewöhnliche" Anfragen
procedure WebModule3DefaultHandlerAction ( Sender: TObject;
Request: TWebRequest;
Response: TWebResponse;
var Handled: Boolean);
//Webhandler für Requests
procedure WebModuleMaintcmAction ( Sender: TObject;
Request: TWebRequest;
Response: TWebResponse;
var Handled: Boolean);
procedure WebModuleCreate(Sender: TObject);
procedure WebModuleDestroy(Sender: TObject);
private
{ Private-Deklarationen }
procedure getNothing ( Request: TWebRequest; Response: TWebResponse); //test für memory leak
procedure send501(text : String);
public
{ Public-Deklarationen }
end;
var
WebModuleClass : TComponentClass = TWebModuleMain;
implementation
{%CLASSGROUP '
Vcl.Controls.TControl'}
{$R *.dfm}
//Default path (no path infos, only
url + port)
procedure TWebModuleMain.WebModule3DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.Content :=
'<
html>' +
'<head><title>Webserver-Anwendung</title></head>' +
'<body>Test Webservice'+
'</body>' +
'</
html>';
end;
procedure TWebModuleMain.WebModuleCreate(Sender: TObject);
var
test : STring;
begin
test := 'abcdef';
end;
procedure TWebModuleMain.WebModuleDestroy(Sender: TObject);
var
Test : String;
begin
Test := 'abcerf';
end;
procedure TWebModuleMain.WebModuleMaintcmAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Handled := true;
case Request.MethodType of
mtGet: tcmGet( Request, Response );
mtPut: send501('this function was not implemented');
mtPost: send501('this function was not implemented');
mtDelete: send501('this function was not implemented');
else begin
send501('this function was not implemented');
end;
end;
end;
procedure TWebModuleMain.getNothing(Request: TWebRequest;
Response: TWebResponse);
var
tst : String;
ADOConnection : TADOConnection;
ADOQuery : TADOQuery;
begin
try
CoInitialize(nil);
ADOConnection := TADOConnection.Create(nil);
ADOConnection.ConnectionString := 'Provider=MSDASQL.1;Password=CASS2HAR;Persist Security Info=True;User ID=ADMIN;Data Source=MaxDb_GOLD1';
ADOQuery := TADOQuery.Create(nil);
ADOQuery.Connection := ADOConnection;
ADOConnection.Connected := true;
ADOQuery.SQL.Text := 'SELECT Name, Age FROM customer WHERE id=1';
ADOQuery.Open;
ADOQuery.First;
tst := tst + ADOQuery.FieldByName('name').AsString;
Response.StatusCode := 200;
Response.Content := tst;
finally
FreeAndNil(ADOQuery);
ADOConnection.Connected := false;
FreeAndNil(ADOConnection);
CoUninitialize;
end;
end;
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// Help Classes
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TWebModuleMain.tcmGet(Request: TWebRequest;
Response: TWebResponse);
begin
if not Request.QueryFields.Values['action'].IsEmpty then
begin
if Request.QueryFields.Values['action'] = 'getnothing' then
begin
getNothing(Request, Response);
end;
´ //Mehr Actionhandling..
end;
end;
procedure TWebModuleMain.send501(text : String);
begin
Response.StatusCode := 501;
Response.ContentType := 'text/plain';
Response.Content := text;
Response.SendResponse;
end;
end.