Delphi på Dansk: 2012

torsdag den 8. marts 2012

En introduktion til REST

Jeg vil i dette blogindlæg give en introduktion til hvordan man bygger en REST server og kommunikerer med med en ditto klient, vel at mørke ved bruge af en Professionel udgave af Delphi. Har man tilgang til en af de størrer udgaver af Delphi, Enterprice, Ultimate eller Architect vil jeg så afgjort anbefale at brugen af DataSnap.

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.

Jeg gemmer mit projekt under navnet RESTServer og omdøber mit WebModule til RESTWebModule. DefaultHanlder action skal også omdøbes. Det gør jeg ved at dobbelt klikke på mit WemModule, en ny dialog kommer frem og her retter jeg navnet til RESTWebModuleDefaultHandlerAction.

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);
  private    
    class var FHandlers: TObjectList
  public
    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), Tanken er at den skal indeholde alle klasserne på de Handlers som REST Serveren skal tilbyde. Jeg har også tilføjet en procedure til at registrer disse med.Årsagen til at disse er erklæret som henholdvis class var og class procedure, vil jeg vise senere, men det korte svar er at det er smart ;o)

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.

...

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.

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.

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.

Det første er at lave en handler server-side, der kan liste brugerne:

{ 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

søndag den 12. februar 2012

Et par gemte eller glemte funktioner

Denne gang vil jeg blogge om et par glemte eller gemte funktioner. Den ene hedder AttatchToConsole og den anden er IsDebuggerPresent.

Lad mig starte med den sidste først. Når jeg udvikler programmer har jeg tit brug for at teste noget mange gange under udviklingen. Typisk er der tale om en eller flere vinduer, hvori der skal udfyldes en 3-4 felter eller mere, klikkes på nogle knapper, aktiveres et par actions - eller på anden måde gøres forskelligt, inden jeg kommer til det, jeg udvikler på.

I den forbindelse er det meget almindeligt, at man bygger genveje ind i programmet. Jeg ved fra min tid på arbejdsmarkedet som Delphi programmør, at mange benytter sig af compiler direktiver fx {$IFDEF DEBUG}, men det giver det lille problem at programmer typisk opfører sig forskelligt, alt efter om det bliver afviklet med en compiler tilknyttet eller ej. Min erfaring siger mig at det er godt at kunne teste programmet uden for debuggeren. Så derfor bruger jeg altid funktionen IsDebuggerPresent.

Fra Delphi XE og frem kan man finde funktionen IsDebuggerPresent i Windows.pas, men ellers er den meget nemt at implementere selv, idet den ligger i kernel32.dll.

function IsDebuggerPresent: Bool stdcall; external 'kernel32.dll';

Som det fremgår af dokumentationen skal man som minimum bruge Wnindows 2000 før funktionen er tilgængelig. Skal du bruge den på en Windows 9x eller ME, skal du kode den selv:

//REF : http://en.wikipedia.org/wiki/Win32_Thread_Information_Block
function IsDebuggerAttached: Bool;
asm
  mov eax, fs:[$18]
  mov eax, dword ptr [eax + $30]  // Get the TIB's linear address
  mov eax, dword ptr [eax]        // Get the whole DWORD
  and eax, $00010000

  // The 3rd byte is the byte we really 
  //need to check for the presence of a debugger. (bit 16)
end;

Delphi (fx via dos-prompt), og derefter vælge "attach to process" i Delphi (menuen Run --> Attach To Process) for at få programmet til at standse på et breakpoint.

Det løser jeg ved at bruge et uendeligt loop, som bliver ved med at gå i ring indtil debuggeren er attached:

while not IsDebuggerPresent do

Sleep(50);

En anden lidt gemt eller glemt funktion hedder AttatchToConsole.

function AttachConsole(dwProcessId: DWORD): Bool; stdcall; external KERNEL32 name 'AttachConsole';

Hvis et program kan startes med en masse forskellige opstartsparametre, kan det være nemmere at starte programmet fra en dos-prompt. Til gengæld kan det være rart, at få vist en hjælpetekst, der beskriver de mulige parametre. AttatchToConsole kan bruges til at skrive en sådan hjælpetekst i dos-vinduet - uden at resten af programmet behøver at være et desideret console-applikationer.

En dos-prompt bruger CodePage 850, så alt hvad der skal ud i en sådan, skal konveteres til CP 850. I et ansicode miljø (Pre Delphi 2009) skal man gøre det selv, men i et Unicode miljø kan man bare definere en AnsiString med en bestemt codepage. Så det første jeg gør, er at oprette en datatype.

Det følgende kode skal indsættes i DPR filen:

Type
  DosString = {$IF CompilerVersion <= 18.5}AnsiString{$ELSE} type AnsiString(850){$IFEND};

Så skal der skriver en hjælpetekst. Jeg har valgt den følgende:

function GetHelpText: String;
var
  Buffer: TStringList;
begin
  Buffer := TStringList.Create;
  Buffer.Add('');
  Buffer.Add('');
  Buffer.Add('%s opretter forbindelse til en MSSQL Server. Programmet kan kaldes med nedenstående parametre. ');
  Buffer.Add('Udelades et af parametrene, eller de angivede værdier ugyldige, vises GUI og værdierne skal indtastes manuelt.');
  Buffer.Add('');
  Buffer.Add('');
  Buffer.Add('%s [/MSSQL: ]');
  Buffer.Add('%s [/LOG: ] /MSSQL: "Provider=SQLOLEDB.1;Password=;Persist Security Info=True;User ID=;Initial Catalog=;Data Source="');

Buffer.Add('/LOG: Navn og sti på logfil, hvori log skal skrives. Hvis dette parameter udelades, genererer programmet selv et unikt logfilnavn.');
  Buffer.Add('');
  Buffer.Add('');
  Buffer.Add('Eksempler:');
  Buffer.Add('');
  Buffer.Add('  %s /MSSQL:"Provider=SQLOLEDB.1;Password=pass1234;Persist Security Info=True;User ID=sa;Initial Catalog=P09999x;Data Source=." /LOG:"d:\Logfil.txt"');
  Buffer.Add('');
  Buffer.Add('  %s /MSSQL:"Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=pass1234;Initial Catalog=IMDB_JSON_SERVER;Data Source=Dellserver" /LOG:"d:\Logfil.txt"');
  Buffer.Add('');
  Buffer.Add('  %s (GUI vises og værdier skal vælges manuelt)');
  Buffer.Add('');
  Buffer.Add('Tryk på ENTER .. .');
  Result := Buffer.Text;
  FreeAndNil(Buffer);
end;

Til sidst skal det bare kaldes:

var
  s: DosString;

begin
  if (ParamCount = 1) and (Trim(ParamStr(1)) = '/?') and (AttachConsole(DWORD(-1))) then
    try
      s := DosString(StringReplace(GetHelpText, '%s', ExtractFileName(ParamStr(0)), [rfReplaceAll]));
{$IF CompilerVersion <= 18.5} CharToOemA(PAnsiChar(s), PAnsiChar(s)); {$IFEND}
      WriteLN(s);
    finally
      FreeConsole;
      Halt(0);
    end;

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Bemærk at i Delphi 2007 og tidligere er man nødt til selv at konvertere sin AnsiString til CodePage 850. Det gør jeg ved hjælp af CharToOemA-funktionen. Således har jeg opnået første delmål: Hvis man kalder sit program med "/?" fra en dos-prompt vil man få en hjælpetekst ud på skærmen:

Hvis der ikke medgives nogle opstartsparametre, startes programmet op som en almindelig GUI-applikation.

Som det ses, har jeg i mit eksempel, valgt at give en connectionstring med som det ene parameter samt et log-parameter hvortil programmet skal gemme loggen.

Så jeg kunne fx kalde mit program med de følgende parametre:
/MSSQL:"Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=harlov;Initial Catalog=IMDB_JSON_SERVER;Data Source=Dellserver" /LOG:"C:\Test\Logfil.txt"

Jeg vil ikke gå i detaljer med at parse en connectionstring etc. Det kan alt sammen ses i det komplette eksempel som sædvanen tro ligger til download her. Jeg vil bare her helt kort fortælle, hvordan man så får fat på de parametre, som er angivet til programmet, og det er her Commandline Parseren kommer ind i billedet. Som sagt vil jeg ikke gå i detaljer med den, men blot her liste de offentlige funktioner, der er i parseren:

function Parameters: TStringList; overload;
function Parameters(const aCommandLine: string; const KeepOriginal: Boolean = true): TStringList; overload;

function ParameterByIndex(const Index: Integer): string;
function ParameterByName(const Name: string): string;
function ParameterByNameDef(const Name: string; Default: string): string; overload;
function ParameterByNameDef(const Name: string; Default: Integer): Integer; overload;
function ParameterByNameDef(const Name: string; Default: Boolean): Boolean; overload;

function ParameterArgChars(AArgChars: string): string;

For at vende tilbage til mit program, så gør jeg følgende, når jeg vil teste om den angivede connectionstring er korrekt:

- Stærkt forenklet, for eksemplets skyld -

ADOConnection1.ConnectionString := ParameterByName('MSSQL');
  try
    ADOConnection1.Open;
    lSQLConnecting.Caption := 'Forbindelse til databasen opnået';
  except
    on e: Exception do
      lSQLConnecting.Caption := 'Forbindelse til databasen IKKE opnået, årsag: ' + e.Message;
  end;

Det færdige resultat ser sådan ud:

For at se hvordan, jeg parser en connectionstring, skriver i loggen, etc., så kig i de de komplette eksempel som sædvanen tro ligger til download her.

Til slut vil jeg gerne reklamere for ERFA-mødet i DAPUG-gruppen den onsdag d. 7. marts 2012. Det komplette program kan ses her på http://www.dapug.dk/ (åbner i et nyt vindue). Er det nogen der er nysgerrige efter at se giraffen (mig), er jeg om eftermiddagen vært ved et 2-timers seminar om REST.

Jens Borrisholt

lørdag den 28. januar 2012

Et loginsystem

Først vil jeg starte med at ønske mine læsere et godt nytår. Jeg håber alle kom godt ind i det. Dernæst skal jeg beklage den lange periode uden blogindlæg fra min side, men det er der flere grunde til. Dels, mellem jul og nytår, fik min computer et psysisk sammenbrud.

Jeg ville sætte en SSD disk i computeren som system disk, det gjorde computeren særdeles ustabil. Det viste sig efter lang tids søgen, at både grafikkort OG bund kort ikke var kompatibel med en SSD disk. Jeg endte med at købe en anden computer, fordi SSD disken ville jeg have.

Dernæst har jeg været ved at forsøge at flytte min blog over til sit eget domæne og dermed ud af Blogger.com - ikke fordi denne platform fejler noget, men nærmere fordi jeg ikke synes, jeg har ordenligt styr på min besøgsstatistik. Så indtil videre bliver bloggen her, men jeg vil stadig arbejde på at flytte den.

Ikke mere udenomssnak nu, nu til sagen.

I dette blog indlæg vil jeg fortælle om et login system baseret på en Microsoft SQL Server. Jeg har valgt SQLServer af flere grunde. Dels er det den jeg kender bedst både fra mit nuværende arbejde og tidligere jobs, og dels fordi den er gratis. Express udgaven af MS SQL er gratis og kan hentes på Microsofts hjemmeside her. Desværre må jeg skuffe de af mine læsere som ikke vil bruge MS SQL, fordi dette login system baserer sig meget på MS SQL, idet jeg bruger de interne system tabeller som rygraden.

Den første jeg vil gøre er at oprette en ny database og deri en tabel til mine brugere. Dette er kun nødvendigt i denne demo, men resten kan nemt flettets ind i en eksisterende applikation.

Jeg starter SQL Server Management Studio op og skriver det følgende:

CREATE DATABASE [LoginDEMO]
GO
USE [LoginDEMO]
GO
CREATE TABLE [dbo].[Users]
  (
     [UserID]       [INT] IDENTITY(1, 1) NOT NULL,
     [UserName]     [VARCHAR](50) NOT NULL,
     [UserPassword] [VARCHAR](50) 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]
GO
INSERT INTO Users (UserName, UserPassword)
VALUES      ('Jens1', 'pass1234')

INSERT INTO Users (UserName, UserPassword)
VALUES      ('Jens2', 'pass1234')

Dette giver en ny database "LoginDEMO" og en tabel "Users" med to brugere i: "Jens1" og "Jens2".

Dernæst skal jeg bruge en tabel til at registrere, hvem der er logget ind i mit program og fra hvilken computer. Den har jeg valgt skal se således ud:

CREATE TABLE [dbo].[USERSESSIONS]
  (
     [HOSTPROCESS]       [INT] NOT NULL,
     [LOCALCOMPUTERNAME] [VARCHAR](50) NOT NULL,
     [USERID]            [INT] NOT NULL,
     [LOGINTIME]         [DATETIME] NOT NULL,
     CONSTRAINT [PK_HOSTPROCESS] PRIMARY KEY CLUSTERED ( [HOSTPROCESS] ASC )WITH
     (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF,
     ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
  )
ON [PRIMARY]

Når en applikation logger ind i SQL Serveren første gang, får den tildelt et unikt Process ID - kaldet HostProcessID - på præcis samme måde som ProcessID i Windows. Når applikationen så opretter en eller flere connections til databasen, får hver af disse connections tildelt et "Server Process ID" - til daglig bare forkortet SPID. En given connection's SPID kan man iøvrigt få udleveret ved hjælp af SQL'en: SELECT @@SPID. HOSTPROCESS ID skal gemmes i tabellen over brugere, fordi det blandt andet skal bruges til at finde ud af, hvilken computer brugeren er logget ind fra.

Det må være det næste naturlige skridt: At skrive en funktion der kan fortælle, hvilken computer man kalder funktionen fra:

CREATE FUNCTION [dbo].[GetLocalComputerName]()
RETURNS VARCHAR(255)
AS
  BEGIN
      RETURN
        (SELECT s.hostname
         FROM   MASTER..sysprocesses S
         WHERE  s.spid = @@SPID)
  END

Som det ses, udnytter jeg system variablen @@SPID (som var ID'et på min connection) til at slå op i tabellen "sysprocesses" og finde ud af hvilken computer funktionen bliver kaldt fra.

Jeg vil lige vise her, at det rent faktisk virker :

Det ovenstående billede er fra min Management Studio. Som det ses hedder den computer jeg sidder ved JENSBORRISHOLT.

Når nu man kan finde computernavnet direkte via SQL, kan vi lige så godt lade SQL serveren selv udfylde det i USERSESSIONS tabellen, og det samme med LOGINTIME.

Jeg laver et par ændringer til tabellen:

ALTER TABLE [dbo].[USERSESSIONS] ADD CONSTRAINT
[DF_USERSESSIONS_LOCALCOMPUTERNAME] DEFAULT ([dbo].[GetLocalComputerName]()) FOR [LOCALCOMPUTERNAME]
GO
ALTER TABLE [dbo].[USERSESSIONS] ADD DEFAULT (getdate()) FOR [LOGINTIME]

Nu har jeg en tabel hvori jeg kan gemme hvem der er logget ind, og en tabel med mine brugere i. Og jeg har fået SQL serveren til at udfylde nogle af felterne i USERSESSIONS tabellen. Nu vil det være naturligt at skrive noget til at logge ind med. Denne procedure har jeg valgt at splitte op i to: En der arbejder på UserID, og en der tager et brugernavn og password. Grunden til jeg har valgt en opsplitning er, at den procedure der arbejder på UserID ,er den der udfører arbejdet. Den rydder op i UserSessions - altså fjerner de linjer fra de brugere der ikke længere er logget ind, og den tjekker om det pågældende UserID rent faktisk findes. Hvis denne funktion bliver kaldt med NULL som parameter UserID, laver den bare en oprydning i UserSessions, dette er ganske nyttigt hvis du fx. vil lave et skærmbillede med hvem der er logget ind.

Lad mig vise koden til de to procedurer:

CREATE PROCEDURE [dbo].[sp_InternalLogOnUser](@UserId INT)
AS
  BEGIN
      SET nocount ON

      DECLARE @HostProcess INT

      SELECT @HostProcess = S.HostProcess
      FROM   MASTER..SysProcesses S
      WHERE  S.spid = @@SPID

      DELETE FROM UserSessions
      WHERE  HostProcess = @HostProcess

      DELETE FROM UserSessions
      WHERE  HostProcess NOT IN (SELECT HostProcess
                                 FROM   MASTER..SysProcesses S)

      IF @UserId IS NULL
        RETURN @@ERROR;

      IF NOT EXISTS(SELECT 1 FROM   Users U WHERE  U.UserID = @UserId)
        BEGIN
            RAISERROR ('Brugeren findes ikke i databasen',16 /*kritisk ERROR*/,1)
            RETURN @@ERROR;
        END;

      INSERT INTO UserSessions
                  (HostProcess,USERID)
      VALUES      ( @HostProcess,@UserId )

      RETURN @@ERROR;
  END;

CREATE PROCEDURE [dbo].[sp_LogOnUser](@UserName VARCHAR(50),@Password VARCHAR(50))
AS
  BEGIN
      DECLARE @UserId INT

      SELECT @UserId = UserID
      FROM   Users U
      WHERE  U.UserName = @UserName
             AND U.UserPassword = @Password;

      IF ( @UserId IS NULL )
         AND ( @UserName IS NOT NULL )
        BEGIN
  RAISERROR ('Brugeren findes ikke i databasen',16 /*kritisk ERROR*/,1)
            RETURN @@ERROR;
        END;

      EXEC sp_InternalLogOnUser @UserId

      RETURN @@ERROR;
  END

Som det fremgår af koden vil det være muligt at kalde EXEC sp_LogOnUser NULL, NULL for at rydde op i UserSessions. Dette er dog kun nødvendigt, hvis man ønsker et øjebliksbillede af hvem, der er logger ind og hvorfra. Normalt vil sp_InternalLogOnUser foretage oprydningen, når man logger ind.

Hvis man ønsker yderligere brugerstyring kan proceduren sp_InternalLogOnUser udvides således, at samme bruger kun kan logge på fra 1 computer ad gangen, eller at man samlet set kun kan have 5 brugere. Jeg har implementeret det således, at samme bruger kun kan logge ind 1 gang.

Inden jeg giver mig i gang med Delphi delen, vil jeg lige vise hvordan man så rent faktisk logger ind:

Som det ses kalder jeg bare sp_LogOnUser med brugernavn og password, og så klarer SQL Serveren resten. Hvis man angiver et forkert brugernavn og password, vil SQL serveren rejse en exception:

Denne exception kan man så fange senere inde i sit Delphi program. Apropos nu til noget Delphi kode:

Det første jeg skal bruge for at teste mit login system er naturligvis en boks, hvor man kan indtaste brugernavn og password. Jeg har valgt en helt simpel model i mit eksempel - helt uden kode:

Så skal jeg bruge en funktion til - dels at logge brugeren ind i applikationen, og dels validere om brugeren har indtastet det rigtige brugernavn og password. Her havde jeg tidligere skrevet en stored procedure som klarede det job, så den skal bare kaldes. I min demo applikation har jeg valgt at benytte mig af dbGO (ADO) som databaselag - ikke fordi det er ret godt, men fordi det er indbygget i Delphi og det kræver ingen DLL el. lign. for at køre.

På designtime har jeg sat en connection komponent på min form og indsat en connectionstring i den. TAdoConnection'en kan også selv opbygge en connection string, hvis ikke lige du har en selv. Jeg regner med mine læsere et i stand til at oprette forbindelse til databasen gennem dbGO, så det vil jeg ikke komme yderligere ind på her. I stedet vil jeg gå direkte til sagen og vise min validerings-funktion:

function TMainForm.IsUserOK(const aUserName, aPassword: String): Boolean;
var
  Query: TADOQuery;
begin
  Result := False;
  Query := TADOQuery.Create(self);
  Query.Connection := ADOConnection1;
  try
    Query.SQL.Text := 'exec sp_LogOnUser ' +

AnsiQuotedStr(aUserName, #39) + ', ' + AnsiQuotedStr(aPassword, #39);
    try
      Query.ExecSQL;
      Result := True;
    except
      // vores SP retunerer en exception hvis man ikke kan logge ind
      // Her bør man i en rigtig applikation tjekke på error type etc.
      // Dette er udeladt her, da dette kun er en DEMO.
    end;
  finally

    FreeAndNil(Query);
  end;
end;

Som det ses er det ganske lige til: Kald proceduren sp_LogonUser med brugernavn og password og fang en eventuel exception. I et rigtigt program bær man nok lave det lidt mere intelligent end blot en simpel exception. Man kunne fx styre det vha. forskellige exception levels eller noget helt andet. Mulighederne er mange, og ude af scope for dette blogindlæg, Her vil jeg blot vise princippet.

Med denne funktion i hånden mangler vi bare to ting: Den ene er, at få funktionen ovenfor kaldt. Den anden er at liste brugere logget på systemet.

Det første først. Jeg har valgt at vise login skærmen i begyndelsen af FormCreate - og altså dermed lige når programmet starter. Når denne retunerer, er det bare at kalde IsUserOK funktionen.

procedure TMainForm.FormCreate(Sender: TObject);
begin
  with TLoginDialog.Create(self) do
    try
      if (ShowModal <> mrOk) or (not IsUserOK(LabeledEdit1.Text, LabeledEdit2.Text)  ) then
        Application.Terminate
      else
        ShowUserSessions;
    finally
      free;
    end;
end;

Og så en funktion til at vise, hvem der er logget ind:

procedure TMainForm.ShowUserSessions;
begin
  ADOQuery1.Close;
  ADOQuery1.SQL.Text := 'select * from UserSessions';
  ADOQuery1.Open;
end;

AdoQuery1 er forbundet med en ADOConnection på design time. Jeg bruger så en datasource til at vise resultatet i et DBGrid.

Til slut vil jeg vise min applikation med hhv. én og to brugere logget ind.

Det var det hele for denne gang. Sourcekoden kan sædvanen tro hentes her. I pakken findes både SQL scriptet og Delphi koden. Jeg håber vi ses til DAPUG erfamøde den 7. marts i Fredericia. Jeg har lovet at holde et oplæg. Emnet vil blive offentliggjort senere.

Jens Borrisholt