Code:
{***************************************************************************}
{ }
{ WSDL Helper Class }
{ }
{ Copyright © 2016 Muharrem ARMAN }
{ muharrem.arman@trt.net.tr }
{ }
{***************************************************************************}
{ }
{ Suya SOAP'a Dokunmadan [ : ) ] Web Service Altyapısını tek bir }
{ HelperUnit ile projenize kazandıran altyapıdır }
{ }
{ USES listesine bu UNIT'in eklenmesi yeterlidir. }
{ Ekstra bir tanımlamaya gerek yoktur. }
{ Gerekli WebService sınıfı kendiliğinden create edilecek, OnWebCagriGeldi }
{ eventi atanmışsa çağrı projeniz tarafından dikkate alınacaktır. }
{ }
{ Kullanımı : }
{ (1) Formunuzun Private kısmına aşağıdaki tanımı ekleyiniz... }
{ }
{ procedure OnWebCagriGeldi(Sender: TObject; Request : TWebRequest; }
{ Response: TWebResponse ); }
{ }
{ (2) Formun OnCreate olayına da aşağıdaki size özel tanımları yapınız. }
{ }
{ xWSDLHelper.DefaultPort := 7000; // sizin için uygun olanı neyse }
{ xWSDLHelper.ServerActive := True; }
{ xWSDLHelper.OnWebCagriGeldi := OnWebCagriGeldi; }
{ }
{ (3) OnWebCagriGeldi olayına da aşağıdaki dilediğinizi yapınız. }
{ }
{ procedure TForm1.OnWebCagriGeldi(Sender: TObject; Request : TWebRequest; }
{ Response: TWebResponse );}
{ Var }
{ strMesaj : WideString; }
{ begin }
{ Memo1.Lines.BeginUpdate; }
{ Memo1.Lines.Add( 'RemoteIp : ' + Request.RemoteIP ); }
{ Memo1.Lines.Add( 'RemoteHost: ' + Request.RemoteHost ); }
{ Memo1.Lines.Add( 'From : ' + Request.From ); }
{ Memo1.Lines.Add( 'Host : ' + Request.Host ); }
{ Memo1.Lines.Add( 'RemoteAddr: ' + Request.RemoteAddr ); }
{ Memo1.Lines.Add( 'URL : ' + Request.URL ); }
{ Memo1.Lines.Add( 'Content : ' + Request.Content ); }
{ Memo1.Lines.EndUpdate; }
{ strMesaj := '<html>' }
{ + '<meta http-equiv=Content-Type content="text/html;' }
{ + ' charset=Windows-1254">' }
{ + '<body>' }
{ + 'Merhaba.' + '</br>' }
{ + '<font color="red">Muharrem ARMAN</font>' + '</br>' }
{ + 'Dinamik WebService TEST...' + '</br>' }
{ + '<img src="Resim_01">' + '</br>' }
{ + '<img src="Resim_01">' + '</br>' }
{ + '<img src="Resim_01">' + '</br>' }
{ + '<img src="Resim_01">' + '</br>' }
{ ; }
{ if String(Request.Host) = String(Request.RemoteAddr) }
{ then strMesaj := strMesaj + 'Beni şu IP''den çağırdınız : ' }
{ + String(Request.Host) + '</br>' }
{ else strMesaj := strMesaj + 'Beni şu DOMAIN ile çağırdınız : ' }
{ + String(Request.Host) + '</br>'; }
{ }
{ strMesaj := strMesaj + 'Sizin IP Adresiniz : ' }
{ + String(Request.RemoteAddr) + '</br>' }
{ + '</body></html>'; }
{ Response.Content := strMesaj; }
{ end; }
{ }
{***************************************************************************}
{ }
{ Üzerinde değişiklik yapmak serbesttir ancak lütfen bu etiket bloğu }
{ içine yaptığınız değişikliği ve künyenizi yazmayı ihmal etmeyiniz. }
{ }
{***************************************************************************}
{ Değişikliği Yapan, Yapılan Ekleme/Değişiklik bilgisi : }
{ }
{ }
{ }
{***************************************************************************}
Unit WSDL_HelperUnit;
interface
Uses
Windows, SysUtils, Classes,
IdHTTPWebBrokerBridge, WebReq, HTTPApp;
Type
tARMAN_WSDL = class(TWebModule)
private
procedure ARMAN_DefaultHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
function ResimGonder(ResStream: TResourceStream; Response: TWebResponse): Boolean;
procedure Resim_01_Action(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
end;
Type
TOnWebCagriEvent = procedure(Sender: TObject; Request : TWebRequest; Response: TWebResponse ) of object;
TWSDL_Helper = Class(TObject)
private
FServer : TIdHTTPWebBrokerBridge;
FDefPort : Integer;
FOnWebCagriEvent : TOnWebCagriEvent;
Function FDefPortGet : Integer;
Procedure FDefPortSet( DefPort: Integer );
procedure FServerActivate( boolDurum: boolean = true );
function FIsServerActive: Boolean;
public
constructor Create;
destructor Destroy; Override;
property DefaultPort : Integer read FDefPortGet write FDefPortSet;
property ServerActive: boolean read FIsServerActive write FServerActivate;
property OnWebCagriGeldi: TOnWebCagriEvent read FOnWebCagriEvent write FOnWebCagriEvent;
end;
Var
WebModuleClass : TComponentClass = tARMAN_WSDL;
xWSDLHelper : TWSDL_Helper;
xTest : tARMAN_WSDL;
implementation
{$R RES\RES.RES} // basit Form Object ve Resim JPG dosyası bulunduruyor.
{ TWSDL_Helper }
constructor TWSDL_Helper.Create;
begin
inherited;
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
// Create server.
FServer := TIdHTTPWebBrokerBridge.Create;
// Register web module class.
FServer.RegisterWebModuleClass( tARMAN_WSDL );
end;
destructor TWSDL_Helper.Destroy;
begin
FServer.Active := False;
FServer.Bindings.Clear;
FreeAndNil(FServer);
inherited;
end;
function TWSDL_Helper.FDefPortGet: Integer;
begin
Result := FDefPort;
end;
procedure TWSDL_Helper.FDefPortSet(DefPort: Integer);
begin
FDefPort := DefPort;
if FServer.Active
then FServer.Active := False;
FServer.Bindings.Clear;
// Set default port.
FServer.DefaultPort := FDefPort;
// Start server.
FServer.Active := True;
end;
function TWSDL_Helper.FIsServerActive: Boolean;
begin
Result := FServer.Active;
end;
procedure TWSDL_Helper.FServerActivate(boolDurum: boolean);
begin
if FServer.Active
then FServer.Active := False;
FServer.Bindings.Clear;
FServer.Active := boolDurum;
end;
{ tARMAN_WSDL }
constructor tARMAN_WSDL.Create(AOwner: TComponent);
begin
inherited;
// Varsayalın (Default) Action Ekledim.
With Actions.Add do
begin
Default := True;
Name := 'DefaultHandler';
PathInfo := '/';
OnAction := ARMAN_DefaultHandlerAction;
end;
// Yeni bir Action Ekledim. Kodla ekledim açıklayıcı olsun istedim.
With Actions.Add do
begin
Default := False;
Enabled := True;
MethodType := mtAny;
Name := 'R01_Resim';
PathInfo := 'Resim_01';
OnAction := Resim_01_Action;
end;
end;
procedure tARMAN_WSDL.ARMAN_DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
Var
strMesaj : String;
begin
// Handled := True;
if Assigned( xWSDLHelper.OnWebCagriGeldi ) then
begin
xWSDLHelper.OnWebCagriGeldi( sender, Request, Response );
end else
begin
strMesaj := '<html>'
+ '<meta http-equiv=Content-Type content="text/html; charset=Windows-1254">'
+ '<body>'
+ 'Merhaba.' + '</br>'
+ '<font color="red">Muharrem ARMAN</font>' + '</br>'
+ 'WebService TEST...' + '</br>'
+ '<img src="' + String(Request.URL) + 'Resim_01">' + '</br>'
;
if String(Request.Host) = String(Request.RemoteAddr)
then strMesaj := strMesaj + 'Beni şu IP''den çağırdınız : '+ String(Request.Host) + '</br>'
else strMesaj := strMesaj + 'Beni şu DOMAIN ile çağırdınız : '+ String(Request.Host) + '</br>';
strMesaj := strMesaj + 'Sizin IP Adresiniz : ' + String(Request.RemoteAddr) + '</br>'
+ '</body></html>';
Response.Content := strMesaj;
end;
end;
function tARMAN_WSDL.ResimGonder( ResStream:TResourceStream; Response: TWebResponse ): Boolean;
begin
try
ResStream.Position := 0;
Response.ContentStream := ResStream;
Response.ContentType := 'image/jpeg';
Response.SendResponse;
Result := True;
//Dikkat: FileStream FREE edilmeyecek çünkü yayındayız...
except
on E: Exception do begin
Response.Content := '<html><body>Bir hata ile karşılaşıldı...' +
E.ClassName + ': ' + E.Message + '</body></html>';
Result := False;
end;
end;
end;
procedure tARMAN_WSDL.Resim_01_Action(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
begin
Handled := True;
// Response edilirken HTML içerisinde "Resim_01" kullanılan yerlerde
// bu Action devreye girererek daha önce belirlediğimiz resmi yollar...
ResimGonder( TResourceStream.Create(HInstance, Format('img_%.2d', [1]), RT_RCDATA), Response );
end;
initialization
xWSDLHelper := TWSDL_Helper.Create;
finalization
FreeAndNil(xWSDLHelper);
end.Download Example and project