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

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

TDictionary og TEqualityComparer

Forleden dag havde jeg brug for at vide, hvor mange rækker, der var i hver tabel i en database, og det havde jeg så brug for at spørge om mange gange. Til det brugte jeg en TDictionary. TDictionary er en af de strukturer vi fik sammen med Generics og dermed Delphi 2009. TDictionary bruges til at samle en nøgle med en værdi i en liste. Før Generics ville jeg have brugt en TStringList og læst alle tabelnavnene ind som strings, og de respektive tabellers rækkeantal ville jeg have skrevet som integer på TObject-pladsen i listen. Den slags hacks er vi heldigvis ovre idag - netop fordi vi har Generics.

Til brug i dette indlæg har jeg konstrueret et andet eksempel. Jeg har hentet teksten fra "The Adventures of Sherlock Holmes" fra Project Gutenberg og gemt den som tekstfil, så jeg kan lave en liste over alle de forskellige ord og deres antal. Til det vil jeg bruge en TDictonary struktur. Jeg vil også i dette blogindlæg vise, at det er muligt at skrive sin egen metode til at sammenligne to elementer i listen. Jeg har her valgt at sammenligne dels med hensyn til store og små bogstaver og dels uden - eller helt kort: er AAAA det samme som aaaa eller ej.

Det første jeg skal have gjort er, at få delt teksten ind i ord. Jeg bruger en TStringlist til at læse min tekst ind i og derfra parse den videre ud i de enkelte ord. Der findes helt sikkert hurtigere måder at gøre på end den jeg viser her, men nu er det læsbarheden og forståeligheden jeg går efter - ikke en opvisning i performancetæt kode :o)

Jeg vil ikke kommentere en hel masse på algoritmen. Dels ligger den udenfor scope af dette blog indlæg, og dels mener jeg den er rimelig selvforklarende. Skulle der være nogen blandt læserne der alligevel ønsker noget uddybet, så skriv endelig så skal jeg nok svare.

Split bogen ud i enkelte ord


function TMainForm.ParseFile: TStringList;

var
  P, Start: PChar;
  s: String;
  Buffer: TStringList;
const
  Delimiter = [#$00 .. #$30, #$3A, #$40, #$5B .. #$61, ';', '?'];
begin
  Result := TStringList.Create;

  Buffer := TStringList.Create;
  try
    Buffer.LoadFromFile('pg1661.txt');
    P := PChar(Buffer.Text);

    while P^ <> #0 do
    begin
      Start := P;
      while not CharInSet(P^, Delimiter) do
        Inc(P);

      SetString(s, Start, P - Start);
      Result.Add(s);

      while CharInSet(P^, Delimiter) do
        if P^ = #0 then
          break
        else
          Inc(P);
    end;

  finally
    FreeAndNil(Buffer);
  end;
end;

Nu hvor jeg har min liste af ord skal de stoppes ind i en TDictionary, således at vi har en nøgle der er ordet, og en værdi der angiver hvor mange gange ordet optræder i bogen. Som jeg nævnte vil jeg bruge to forskellige principper til at tælle forskellige ord med: "Case sensitive" (godt dansk ord ;-)) og "ikke case sensitive". Derfor har den procedure, der har til formål at vise resultatet på skærmen, også en IEqualityComparer<String> med ind som parameter.

IEqualityComparer er defineret i Generics.Defaults (System.Generics.Defaults hvis du bruger XE2), og ser således ud:

IEqualityComparer<T> = interface
    function Equals(const Left, Right: T): Boolean;
    function GetHashCode(const Value: T): Integer;
  end;

IEqualityComparer er således den skabelon som man skal bruge, hvis man vil lave en sammenligningsklasse til brug i fx TDirectory. Heldigvis har hver datatype allerede sin egen prædefinerede samlingningsklasse som man kan få fat på ved at skrive TEqualityComparer<T>.Default, hvor T kan være en hvilken som helst datatype. Således skriver man for en string:  TEqualityComparer<String>.Default.

Jeg vil her vise den procedure, jeg bruger til at synliggøre mit TDictonary:

procedure TMainForm.NumberInstances(const AComparer: IEqualityComparer<string>; TheListView: TListView);
var
  Dictionary: TDictionary<string, Cardinal>;
  AWord: string;
  Buffer: TStringList;
  Words: TStringList;
begin
  // Opret en ny instans af TDictionary, der bruger AComparer som "sammenligner"
  Dictionary := TDictionary<string, Cardinal>.Create(AComparer);

  // Hent ord fra filen
  Words := ParseFile;

  Buffer := TStringList.Create;

  // Deaktiver skærmopdatering af hensyn til performance
  TheListView.Items.BeginUpdate;
  try
    TheListView.Clear;

    {
      Løb listen med ord igennem.
      Hvis den findes i Dictionary allerede så opdater tælleren med 1
      ellers opret et nyt element i Dictionary og sæt tælleren til 1
    }
    for AWord in Words do
      if Dictionary.ContainsKey(AWord) then
        Dictionary[AWord] := Dictionary[AWord] + 1
      else
        Dictionary.Add(AWord, 1);

    // Tag alle forskellige ord og smid den på en liste
    for AWord in Dictionary.Keys do
      Buffer.Add(AWord);

    // Sorter listen
    Buffer.Sort;

    // Vis listen på skærmen
    for AWord in Buffer do
      with TheListView.Items.Add do
      begin
        Caption := AWord;
        SubItems.Add(IntToStr(Dictionary[AWord]));
      end;

  finally
    //Slå skærm opdateringer til
    TheListView.Items.EndUpdate;
   
    //Frigiv hukommelse
    FreeAndNil(Buffer);
    FreeAndNil(Dictionary);
    FreeAndNil(Words);
  end;
end;

Jeg vil ikke her kommentere yderligere på proceduren, idet jeg allerede har skrevet kommentarer i koden. Det komplette eksempel kan sædvanen tro hentes her.

Nu hvor jeg kan skille min fil ad i enkelte ord, og jeg har skrevet en procedure til at vise det på skærmen, må det være på tide at få skrevet en case insensitive sammenligningsklasse. Jeg har tidligere vist at en sådan skal bygges over skabelonen IEqualityComparer. Så nu er det blot at gå i gang.

type

  //opbyg klassen over IEqualityComparer
  TCaseInsensitiveStringComparer = class(TEqualityComparer<string>)
  public
    function Equals(const Left, Right: string): Boolean; override;
    function GetHashCode(const Value: string): Integer; override;
  end;

function TCaseInsensitiveStringComparer.Equals(const Left, Right: string): Boolean;
begin
  //Sammenlign de to strings uden hensyn til store og små bogstaver
  Exit(SameText(Left, Right));
end;

function TCaseInsensitiveStringComparer.GetHashCode(const Value: string): Integer;
begin
// Da vi sammenligner case insensitive kalder vi
// TEqualityComparer<string>.Default.GetHashCode med AnsiUpperCase(Value)
  Result := TEqualityComparer<string>.Default.GetHashCode(AnsiUpperCase(Value));
end;

Som det ses bruger jeg blot den oprindelige hash-algoritme fra TEqualityComparer<string>, men jeg kunne i princippet havde skrevet min egen her.

Til sidst er der blot at få kaldt koden. Henholdsvis for case sensitive og case insensitive versionen af min sammenligner:

Case sensitive kald:
  NumberInstances(TEqualityComparer<string>.Default, default);

Case insensitive kald :
  NumberInstances(TCaseInsensitiveStringComparer.Create(), Custom);

Det skal her bemærkes at det andet parameter er det listview, som jeg ønsker at vise mit resultat i. Mine listviews har jeg navngivet henholdsvis "Default" og "Custom".

Til slut vil jeg blot vise skærmbilledet for programmet :

Som det ses, så har den ene sammenligningsklasse fundet 15 forekomster af "Adler" og 1 forekomst af "ADLER". Hvorimod den anden "kun" har fundet "Adler", men til gengæld har den fundet 16 forekomster (15 + 1). Samme ses bl.a. med "Adventure".

Således har jeg nu illustreret, hvordan man bruger en TDictionary og skriver sin egen sammenligningsklasse. I mit eksempel her har jeg bare brugt to simple datatyper, men der er ikke noget i vejen for at bruge mere komplicerede datatyper som fx klasser og records, og så dertil skrive sin egne sammenligningsklasse.

Jeg vil lige minde om at det komplette eksempel kan hentes her.

Tilbage er blot at ønske alle mine læsere glædelig jul og godt nytår. Jeg vil bruge tiden mellem jul og nytår til at komme på plads på en ny blogging platform. Men mere om det senere.

Jens Borrisholt