Det første jeg gør er at vælge et nyt projekt af typen WebServer Appilcation :
Og som type vælger jeg "Indy VCL Application", fordi den er meget nemt at debugge, idet det "bare" er en exe fil; Ønskes den senere lavet om til fx. en ISAPI dll er det bare DPR filen der skal udskiftes. Så der er på ingen måde noget endeligt ved valget.
Compiler og kør, tryk "Open browser" på GUI'en og din default browser åbner:
Der er liv. En af de smarte ting ved REST er at man kan bruge sin browser til at teste med undervejs, således er det nemt at ser om man får det ønskede tilbage.
Det næste er at opbygge en skabelon til fremtidig "handlers". En handler er en klasse der tager i mod en bestemt url og udfører en handling.
const HTTP_STATUS_OK = 200; HTTP_STATUS_CREATED = 201; HTTP_STATUS_UNAUTHORIZED = 401; HTTP_STATUS_FORBIDDEN = 403; HTTP_STATUS_NOT_FOUND = 404; HTTP_STATUS_METHOD_NOT_ALLOWED = 405; CONTENT_TYPE_TEXT = 'text/plain'; CONTENT_TYPE_HTML = 'text/html';
CONTENT_TYPE_JSON = 'application/json';
type TRESTRequestHandlerClass = class of TRESTRequestHandler; // metaclass type TRESTRequestHandler = class abstract private FPattern: string; FRegex: TRegEx; protected function GetPath: string; virtual; abstract; function HandleGet(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; virtual; function HandlePost(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; virtual; function HandleDelete(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; virtual; function HandlePut(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; virtual; function IsAuthenticated(const AuthenticationID: string; Response: TWebResponse): Boolean; virtual; public constructor Create; function Handle(Request: TWebRequest; Response: TWebResponse): Boolean; property Path: string read GetPath; end; TRESTWebModule = class(TWebModule) procedure RESTWebModuleDefaultHandlerAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean); privateclass var FHandlers: TObjectListpublic class procedure RegisterHandler(RequestHandlerClass: TRESTRequestHandlerClass); end;
Jeg vil her udelade selve implementeringen. Dels fordi de alle bare returnerer false, og dels fordi implementeringen kan ses i det færdige eksempel. Grunden til jeg har en nøsten tom klasse og ikke bare laver det til et interface er at hvis man udfører fx. en Delete på en Handler, og denne ikke tilbyder dette skal der retuneres en fejl kode til klienten.
Som det ses har jeg lavet en liste af Handlers på mit WebModule (class var FHandlers: TObjectList
Jeg vil ikke her gå i yderligere detaljer med opbygningen af WebModule klassen. Dels kan den ses i det førdige eksempel og dels er det noget man gør den ene gang, for så at genbruge den i server efter server.
Således igennem WebModule, vil jeg lige vises det første synlige resultat af koden. Kør programmet og tryk Open Browser.
Teksten er ændret, men vigtigst af alt har jeg nu opbygget en motor til at tage imod foresprøgelser.
Det er nu tid til at skrive den første handler. Tilføj en ny unit til projektet og gem den under navnet RESTHandlersU. Jeg vil her lave en Handler der retunerer hvilke variabler der er medgiver, og hvilke felter der er medgivet. Variabler er dem der er adskilt af skråstreger (/) mens felter er dem man skriver efter er spørgsmålstegn (?).
Der er to ting der skal implementeres. Dels hvilket URL man ønsker, dette angives i Path, og dels hvilken handling der skal udføres. Dette angiver du ved at overstyre en af de fire metoder : HandleGet, HandlePost, HandleDelete, HandlePut, alt efter hvilket HTTP Action man angiver.
I "Path" er det muligt at anvende Wild Cards (* og ?) , dette har jeg opnået gennem
function TRESTRequestHandler.Handle(Request: TWebRequest; Response: TWebResponse): Boolean;, se implementeringen i det færdige eksempel.
Jeg ønsker at man skal skriver /Test/ og så alt hvad der kommer der efter vil jeg vide på skærmen:
function TTestHandler.GetPath: string; begin Result := '/Test/*'; end;
Her efter skal jeg have implementeret den relevante metode. Jeg bruger HandleGet idet en Browser sender en Get:
function TTestHandler.HandleGet(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; var Buffer: string; begin Result := True; Response.ContentType := CONTENT_TYPE_HTML; Response.StatusCode := HTTP_STATUS_OK; Response.Content := 'Variabler medgivet:';
if Variables.Count = 0 then Response.Content := Response.Content + 'Ingen' else for Buffer in Variables do Response.Content := Response.Content + Buffer + ''; Response.Content := Response.Content + 'Felter medgivet:'; for Buffer in Request.QueryFields do Response.Content := Response.Content + Buffer + ''; end;
*** HUSK *** at registere din handler i bunden af din unit :
initialization TRESTWebModule.RegisterHandler(TTestHandler); end.
Og her ses så det smarte i at jeg ovre på mit WebModule brugte hhv. class var og class procedure. Nu kan jeg bare smide mine handlers på en liste i initialization delen og skal der efter ikke bekymre mig om mere.
Lad mig vise nogle url eksempler:
Som det fremgår af koden så variablerne ligger i en TList<String> og kommer ind i parameteren Variables, mens mine felter ligger i Request.QueryFields. Request.QueryFields er bare en TStrings så der kan spørges efter felter med Request.QueryFields.Values['Hest'] fx.
Nu hvor det mest grundlæggende er overstået vil jeg vise hvordan man overfører et object mellem en server og en klient. Til det formål bruger jeg SuperObject dog i en lettere modificeret udgave i det den jeg linker til her ikke understøtter Delphi XE ej heller XE2. Det gør den version jeg har med i mit eksempel dog.
Jeg skal her gøre opmærksom på at SuperObject er casesenestive Således bruger du versaler serverside, skal dette også gøres på klienten. Dette er dog mest relevant når jeg senere vil overføre et dataset.
Jeg Oprettet en ny unit og kalder den TestObjectU:
unit TestObjectU; interface uses SuperObject; type TMyTestObject = class public Tid: TDateTime; sTid: string; end; implementation { TObjectHelper } end.
Denne klasse vil jeg nu streame over net. Til det formål vil jeg skrive endnu en handler: TDateTimeHandler.
Selve oprettelsen og initialiseringen af TMyTestObject er gangske lige til. Det nye her et noget funktionalitet som SuperObject tilbyder: Nemlig at konvertere et object til en JSON string, blot ved at kalde ToJsonString op objektet. Dette er naturligvis implementeret vha en class helper nede i SuperObject.pas de interesserede kan selv dykke ned i kildekoden til SuperObject.... uses TestObjectU;
... { TDateTimeHandler } function TDateTimeHandler.GetPath: string; begin Result := '/DateTime*'; end; function TDateTimeHandler.HandleGet(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; var TestObject: TMyTestObject; begin TestObject := TMyTestObject.Create; try TestObject.Tid := now; TestObject.sTid := FormatDateTime(FormatSettings.LongDateFormat + #32 + FormatSettings.LongTimeFormat, TestObject.Tid); Response.ContentType := CONTENT_TYPE_JSON; Response.Content := TestObject.ToJsonString; finally FreeAndNil(TestObject); end; Result := True; end; ... initialization ... TRESTWebModule.RegisterHandler(TDateTimeHandler); end.
I første omgang vil jeg blot vise resultatet i en browser :
Næste naturlige skridt er at få TMyTestObject over i en Delphi applikation, Client - side.
Start en ny Delphi og opret en almindelig VCL applikation. Til at lave mine forespørgelse har jeg lavet en lille hjælpe klase til at pakket TidHttp ind, jeg vi ikke gå i detaljer med den her, blot benytte den.
uses SuperObject, TestObjectU, HttpHelperU; {$R *.dfm} const ServerURL = 'http://localhost:8080'; procedure TForm2.Button1Click(Sender: TObject); var Tmp: string; TestObject: TMyTestObject; begin Tmp := HttpHelper.HTTPGet(ServerURL + '/DateTime'); if not HttpHelper.RestError.ResponseOK then begin MessageDlg(HttpHelper.RestError.LastException, mtError, [mbOK], 0); exit; end; TestObject := TMyTestObject.FromJson(Tmp); MessageDlg(TestObject.sTid, mtInformation, [mbOK], 0); FreeAndNil(TestObject); end;
Igen her hjælper SuperObject. Jeg får min JSON string konverteret tilbage til et object simpelt ved hjælp af FromJson metoden.
Ofte vil det være interessant at gemme nogle kald bag et log ind. Jeg vil her vise et meget spmpelt login system. Jeg vil benytte mig af med msSQL server og tilgå den med ADO, fordi det er indbygget i Delphi.
Jeg starter med at lave en ny handler i min server :
function TAdminLogonRESTRequestHandler.GetPath: string; begin Result := '/system/logon'; end; function TAdminLogonRESTRequestHandler.HandleGet(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; var AuthenticationID: string; begin AuthenticationID := Model.AdminLogon(Request.QueryFields.Values['username'], Request.QueryFields.Values['password']); if AuthenticationID <> EMPTY_GUID then begin Response.StatusCode := HTTP_STATUS_OK; Response.Content := AuthenticationID; Response.ContentType := 'text/plain'; end else Response.StatusCode := HTTP_STATUS_UNAUTHORIZED; Result := True; end;
Som det sele tilgår jeg et objekt kaldet Model. Det er den klasse der styrer adgangen til databases. Så lad mig vise den her :
unit ModelU; interface uses ADODB, Dialogs, DateUtils; type TMSModel = class strict private FConnection: TADOConnection; procedure UpdateUserAuth(const UserName, Password: string; const AuthID: string); public function AdminCheckAuth(const AuthID: string): Boolean; function AdminLogon(const UserName, Password: string): string; function AdminListUsers: TADOQuery; constructor Create; destructor Destroy; override; end; const EMPTY_GUID = '{00000000-0000-0000-0000-000000000000['; var Model: TMSModel;
implementation uses SysUtils; const AuthID_TIMEOUT = 2; { TMSModel } function CreateUuid: string; var uuid: TGuid; begin if CreateGuid(uuid) = S_OK then Result := GuidToString(uuid) else Result := EMPTY_GUID; end; function TMSModel.AdminCheckAuth(const AuthID: string): Boolean; var Query: TADOQuery; begin Query := TADOQuery.Create(nil); try Query.Connection := FConnection; Query.SQL.Add('select * from Users where AuthID = :AuthID and datediff(hour,AuthTime,getdate()) < ' + IntToStr(AuthID_TIMEOUT)); Query.Parameters.ParamByName('AuthID').Value := AuthID; Query.Open; if not Query.IsEmpty then begin Query.Edit; Query['AuthTime'] := now; Query.Post; end; Result := not Query.IsEmpty; finally Query.Free; end; end; function TMSModel.AdminListUsers: TADOQuery; begin Result := TADOQuery.Create(nil); Result.Connection := FConnection; Result.SQL.Add('select * from users'); Result.Open; end; function TMSModel.AdminLogon(const UserName, Password: string): string; var Query: TADOQuery; begin Query := TADOQuery.Create(nil); try Query.Connection := FConnection; Query.SQL.Add('select * from users where [UserName]=:usr and [PassWord]=:passwd'); Query.Parameters.ParamByName('usr').Value := UserName; Query.Parameters.ParamByName('passwd').Value := Password; try Query.Open; except on e: Exception do ShowMessage(e.Message); end; if not Query.EOF then begin if Query.FieldByName('AuthID').IsNull or (HoursBetween(now, Query.FieldByName('AuthTime').AsDateTime) > AuthID_TIMEOUT) then Result := CreateUuid else Result := Query.FieldByName('AuthID').AsString; UpdateUserAuth(UserName, Password, Result); end else Result := EMPTY_GUID; finally Query.Free; end; end; constructor TMSModel.Create; begin inherited; FConnection := TADOConnection.Create(nil); FConnection.ConnectionString := 'FILE NAME=Connection.udl' end; destructor TMSModel.Destroy; begin FreeAndNil(FConnection); inherited; end; procedure TMSModel.UpdateUserAuth(const UserName, Password, AuthID: string); var Query: TADOQuery; begin Query := TADOQuery.Create(nil); try Query.Connection := FConnection; Query.SQL.Add('select * from users where [username]=:usr and [password]=:passwd'); Query.Parameters.ParamByName('usr').Value := UserName; Query.Parameters.ParamByName('passwd').Value := Password; try Query.Open; Query.Edit; Query['AuthID'] := AuthID; Query['AuthTime'] := now; Query.Post; except on e: Exception do ShowMessage(e.Message); end; finally Query.Free; end; end; initialization Model := TMSModel.Create; finalization FreeAndNil(Model); end.
Min model til går 1 tabel i min database : Users. Jeg vil lige inden jeg går videre vise mit tabel design :
CREATE TABLE [dbo].[Users]
(
[UserID] [INT] IDENTITY(1, 1) NOT NULL,
[UserName] [VARCHAR](50) NOT NULL,
[PassWord] [VARCHAR](50) NULL,
[AuthID] [UNIQUEIDENTIFIER] NULL,
[AuthTime] [DATETIME] NULL,
CONSTRAINT [PK_Users] PRIMARY KEY CLUSTERED ( [UserID] ASC )WITH (pad_index
= OFF, statistics_norecompute = OFF, ignore_dup_key = OFF, allow_row_locks
= on, allow_page_locks = on) ON [PRIMARY]
)
ON [PRIMARY]
Helt kort valideret jeg et brugernavn og et password mod min database i AdminLogon, hvis dette fejler retunerer jeg {00000000-0000-0000-0000-000000000000} for at fortælle at klienten ikke fik et Transaktions ID ellers opretter jeg et nyt ID, retunerer dette til klienten og gemmer dette i databasen. Med min konstant AuthID_TIMEOUT har jeg angivet at en session har en levetid på to timer. Dette betyder i praksis at klienten gemmet det transkations ID den fik og kan bruge dette i to timer uden at skulle logge ind igen.
Lad mig vise et praktisk eksempel. Jeg vil nu skrive en handler der kan give mig en liste af brugere i databasen, denne handler skal være beskyttet af et brugernavn og password.
Det første er at få klienten ind at logge ind. Jeg har i min Users tabel allerede oprettet en bruger Jens med password Jens. I denne test sender jeg brugernavn og password i klartekst over nettet. I real word eksempel vil jeg så afgjort anbefale at man bruger https eller på anden måde kryptere sine data.
Jeg tilføjer en knap til mit klient og kalder min logind handler:
procedure TForm2.Button2Click(Sender: TObject); begin LabeledEdit1.Text := HttpHelper.HTTPGet(ServerURL + '/system/logon?UserName=Jens&Password=Jens'); if not HttpHelper.RestError.ResponseOK then MessageDlg(HttpHelper.RestError.LastException, mtError, [mbOK], 0); end;
Og resultatet ses på skærmen :
Inden jeg går videre vil jeg lige vise en simpel handler der kræver login:
{ TAdminTestRESTRequestHandler } function TAdminTestRESTRequestHandler.GetPath: string; begin Result := '/system/admin/*/test'; end; function TAdminTestRESTRequestHandler.HandleGet(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; begin Result := True; if IsAuthenticated(Variables[0], Response) then begin Response.StatusCode := HTTP_STATUS_OK; Response.Content := 'Hurrra!!! Vi er logger ind'; Response.ContentType := 'text/plain'; end else Response.StatusCode := HTTP_STATUS_UNAUTHORIZED; end;Husk at registere din handlet i bunden, ellers virker den ikke.
Så skal den kaldet fra klienten. Bemærk at der i Path er en *, der skal SessionsID placeres i kaldet til serveren. :
procedure TForm2.Button3Click(Sender: TObject); begin LabeledEdit2.Text := HttpHelper.HTTPGet(ServerURL + '/system/admin/' + LabeledEdit1.Text + '/test') if not HttpHelper.RestError.ResponseOK then MessageDlg(HttpHelper.RestError.LastException, mtError, [mbOK], 0); end;
Koden til den ovenstående knap forudsætter at der er skaffet en SessionsId via den forgående knap først.
{ TAdminUsersRESTRequestHandler } function TAdminUsersRESTRequestHandler.GetPath: string; begin Result := '/system/admin/*/users'; end; function TAdminUsersRESTRequestHandler.HandleGet(Request: TWebRequest; Response: TWebResponse; Variables: TList<string>): Boolean; var Query: TADOQuery; begin Result := True; if not IsAuthenticated(Variables[0], Response) then begin Response.StatusCode := HTTP_STATUS_UNAUTHORIZED; Exit; end; Response.StatusCode := HTTP_STATUS_OK; Response.ContentType := 'application/json'; Response.Content := Model.AdminListUsers.AsJSONArrayString; FreeAndNil(Query); end;
Jeg benytter mig her af min egen class helper for TDataset, hvor jeg har implementeret nogle simple metoder til at lave et dataset om til JSON. Jeg vil ikke komme yderligere ind på implementeringen her, men blot benytte mig af den. Koden er naturligvis inkluderet i det færdige eksempel og ligger i JSONHelperU.pas.
Det, der er det interessante, er så hvordan jeg på client-side får det til at blive til et dataset igen. Det første jeg gør, er at oprette en klasse med de samme felter som i mit dataset :
TUser = class public UserID: Integer; UserName: string; PassWord: string; AuthID: string; AuthTime: TDateTime; end;Her er det vigtigt at overholde det med store og små bogstaver idet SuperObject er case-sensitive. Hvis jeg fx skriver Userid i min klasse definition og UserID i mit dataset vil det ikke fungere.
Så skal jeg have en knap, der kalder koden. Jeg benytter mig her af TdxMemtable og et cxGrid, men man kan benytte hvad som helst.
procedure TForm2.Button4Click(Sender: TObject); var Buffer: TStringList; Tmp: string; User: TUser; begin Tmp := HttpHelper.HTTPGet(ServerURL + 'system/admin/' + LabeledEdit1.Text + '/users'); if not HttpHelper.RestError.ResponseOK then begin ShowMessage(HttpHelper.RestError.LastResponseText); exit; end; dxMemData1.Close; dxMemData1.Open; Buffer := JSONStringToStringList(Tmp); for Tmp in Buffer do begin User := TUser.FromJson(Tmp); dxMemData1.AppendRecord([0, User.UserID, User.UserName, User.PassWord, User.AuthID, User.AuthTime]); FreeAndNil(User); end; end;
Som det ses, flytter jeg først data over i et object, for derefter at kopiere det over i mit dataset. Det kan virke lidt omstændigt, men til gengæld for lidt ekstra arbejde, kan man "nøjes" med en professionel udgave af Delphi.
Resultatet:
Sædvanen tro kan det komplette eksempel med source hentes her
Jens Borrisholt