• Nieuwe artikelen

  • TEMDDataSet

    Paul van der Ven

    Iedere zichzelf respecterende NLDelphi bezoeker heeft natuurlijk het artikel van Jos Visser gelezen over het maken van een TDataset afgeleide, de TbigInifileDataset. In dat artikel laat Jos zien hoe een ini-bestand te gebruiken is met behulp van een TDataset-afgeleide.

    Waar Jos gestopt is, ga ik verder. Dit artikel is namelijk te zien als een aanvulling op Jos' artikel. Het eerste gedeelte is deels een stukje herhaling in vogelvlucht, weliswaar met een andere bestandsindeling. De rode draad is identiek, aangezien ook mijn artikel een TDataset-afgeleide betreft. Vervolgens laat ik zien hoe de TDataset-afgeleide aangevuld kan worden om gegevens te kunnen wijzigen, toevoegen en verwijderen.

    Als ik overigens aangeef dat ik code letterlijk gekopieerd heb, wil dat niet zeggen dat de code exact hetzelfde is gebleven. Ik pas namelijk, nadat het letterlijk gekopieerd is, bepaalde zaken naar eigen inzicht aan. Enkel belangrijke wijzigingen zal ik waar nodig toelichten.

    Voor we beginnen

    Ik ga er voor het artikel van uit dat de lezer een zekere basiskennis heeft in het programmeren met Delphi en enigszins bekend is met het gebruik van datasets, csv-bestanden en xml bestanden.

    Ik heb bijna alle code opgenomen in het artikel. Het is niet de insteek om de code een op een over te nemen, hoewel ik daar geen bezwaar tegen heb. De strekking van dit artikel is dat je leert hoe je een eigen TDataset-afgeleide kunt maken, die afgestemd is op je eigen wensen en eisen.

    Ik gebruik in dit artikel de termen 'database' en 'tabel' door elkaar. Een database is een verzameling tabellen, aldanniet met onderlinge relaties, maar in dit voorbeeld gaat het om een enkele tabel en vervaagt dat onderscheid.

    Bestandsindeling

    De bestandsindeling is gebaseerd op een csv-bestand. Een csv-bestand kan worden gegenereerd vanuit veel verschillende programma's. Ik gebruik meestal een combinatie van Excel, Notepad en Wordpad om deze bestanden te bewerken. Regelmatig loop ik tegen schaalbaarheidsproblemen aan. Het aantal regels in Excel is beperkt, wordpad is relatief traag bij kleine bestanden en notepad wordt traag bij grote bestanden.

    Ik werk doorgaans met csv-bestanden die maximaal 1 regel per record bevatten. Formeel zouden velden ook teksten met meerdere regels moeten kunnen bevatten. In dit voorbeeld beperkt ik mij tot 1 regel per record.

    De namen van de velden kunnen worden opgenomen op de eerste regel, maar wat ik een groot nadeel vind van csv-bestanden is dat men naar veldtypes over het algemeen moet gissen. Dit is voor mij een reden geweest om een header te definiëren met alle informatie die ik nodig meen te hebben. Deze header plaats ik ook op één regel. Ik gebruik een xml-indeling, zodat ik met een kleine aanpassing de hele tabel in internet-explorer kan bekijken. In xml moet alles wat gestart wordt, ook beëindigd worden. Dit is de reden dat ik ook een regel heb gereserveerd voor de footer, aan het einde van het bestand.

    De eerste meters

    Ik begin met een eerste aanzet van mijn class. FHeader, FFooter, FDelimiter en FQuoteChar zijn variabelen die inherent zijn aan de keuze van het bestandsformaat. FCSVFile en FCache zijn nodig om de data uit het bestand te verwerken. Hier kom ik later op terug. De functie van de overige genoemde variabelen worden uitgelegd in het artikel van Jos Visser.

    type
      TEMDDataSet = class(TDataSet)
      private
        FRecCount: Integer;    //Aantal records (=exclusief Header/Footer-regels)
        FRecNo: Integer;
        FBufSize: Integer;
        FFilename: String;     //Bestandsnaam
        FCached: Boolean;    
        FHeader: String;       //Eerste regel uit bestand
        FFooter: String;       //Laatste regel uit bestand
        FDelimiter: Char;      //Scheidingsteken
        FQuoteChar: Char;      //Aanhalingsteken
        FCSVFile: TStringlist; //Tabel-inhoud
        FCache: TStringList;   //Letterlijke inhoud van bestand
    

    Het bijhouden van records kan op exact dezelfde manier als in TbigInifileDataSet:

    type
      TRecInfo = record
        RecordNo: Integer;
        BookmarkFlag: TBookmarkFlag;
      end;
      PRecInfo = ^TRecInfo;
    
    
    function TEMDDataSet.GetRecordSize: Word;
    begin
      Result := FBufSize;
    end;
    
    procedure TEMDDataSet.InternalInitRecord(Buffer: PChar);
    begin
      FillChar(Buffer^, FBufSize, 0);
    end;
    
    function TEMDDataSet.AllocRecordBuffer: PChar;
    begin
      GetMem(Result, FBufSize);
    end;
    
    procedure TEMDDataSet.FreeRecordBuffer(var Buffer: PChar);
    begin
      FreeMem(Buffer, FBufSize);
    end;
    
    function TEMDDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
    begin
      Result := grOK;
      case GetMode of
        gmPrior:
        begin
          if FRecNo <= 0 then
          begin
            Result := grBOF;
            FRecNo := -1; //BOF
          end else begin
            Dec(FRecNo);
          end;
        end;
        gmNext:
        begin
          if FRecNo >= FRecCount - 1 then
          begin
            Result := grEOF;
            FRecNo := FRecCount; //EOF
          end else begin
            Inc(FRecNo);
          end;
        end;
        gmCurrent:
        begin
          if (FRecNo < 0) or (FRecno >= FRecCount) then
          begin
            result := grError;
          end;
        end;
      end;
      if (Result = grOK) and (Assigned(Buffer)) then
      begin
        with PRecInfo(Buffer)^ do
        begin
          RecordNo := FRecNo;
          BookmarkFlag := bfCurrent;
          ClearCalcFields(Buffer);
          GetCalcFields(Buffer);
        end;
      end;
    end;
    

    Navigatie

    De code voor het navigeren is eveneens letterlijk gekopieerd:

    procedure TEMDDataSet.InternalFirst;
    begin
      FRecNo := -1;  //BOF
    end;
    
    procedure TEMDDataSet.InternalLast;
    begin
      FRecNo := FRecCount;  //EOF
    end;
    
    procedure TEMDDataSet.InternalSetToRecord(Buffer: PChar);
    begin
      if Assigned(Buffer) then
      begin
        FRecNo := PRecInfo(Buffer)^.RecordNo;
      end;
    end;
    
    function TEMDDataSet.GetRecordCount: Integer;
    begin
      Result := FRecCount;
    end;
    
    function TEMDDataSet.GetRecNo: Integer;
    begin
      UpdateCursorPos;
      if (FRecNo = -1) and (FRecCount > 0) then
      begin
        Result := 0; //BOF
      end else begin
        Result := FRecNo;
      end;
    end;
    
    procedure TEMDDataSet.SetRecNo(Value: Integer);
    begin
      if (Value >= 0) and (Value <= FRecCount) then
      begin
        FRecNo := Value - 1;
        ReSync([]);
      end;
    end;
    

    Bookmarks

    Ook het gedeelte over bookmarks is letterlijk gekopieerd van TbigInifileDataSet:

    function TEMDDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
    begin
      Assert(Assigned(Buffer));
      Result := PRecInfo(Buffer).BookmarkFlag;
    end;
    
    procedure TEMDDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
    begin
      Assert(Assigned(Buffer));
      Integer(Data^) := PRecInfo(Buffer).RecordNo;
    end;
    
    procedure TEMDDataSet.InternalGotoBookmark(Bookmark: Pointer);
    begin
      FRecNo := Integer(Bookmark^);
    end;
    
    procedure TEMDDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
    begin
      PRecInfo(Buffer).RecordNo := Integer(Data);
    end;
    
    procedure TEMDDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
    begin
      PRecInfo(Buffer).BookmarkFlag := Value;
    end;
    

    Ook de volgende code is letterlijk gekopieerd. We kunnen bijna beginnen met de uitleg van de afwijkingen tenopzichte van TbigInifileDataset.

    procedure TEMDDataSet.InternalHandleException;
    begin
      Application.HandleException(Self);
    end;
    
    function TEMDDataSet.IsCursorOpen: Boolean;
    begin
      Result := FCsvFile <> nil;
    end;
    

    Bestand openen

    Het openen van een bestand begint bij het ingeven van de bestandsnaam. Het leek me leuk om te controleren of de database niet geopend is, alvorens de bestandsnaam te wijzigen. Het geeft anders zo'n vreemd effect als je gedurende het bewerken van de gegevens een andere Filename doorgeeft.

    published
        property Filename: String read FFilename write setFilename;
    
    procedure TEMDDataSet.setFilename(Filename: String);
    begin
      if FOpen then exit;
      inherited;
      FFilename := Filename;
    end;
    

    En nu begint dat eindelijk het echte werk. De variabele FCached is eigenlijk niet nodig, maar om nog te bedenken redenen zet ik die alvast op true. Misschien ga ik in de toekomst wel werken aan een variant die niet werkt met een cache. FCache bevat de letterlijke inhoud van het bestand, dus inclusief header en footer. InternalInitFieldDefs is belast met het lezen van de header, hier kom ik zometeen op terug. Nadat de header is uitgelezen zijn delimiter en quotechar ook bekend. Vervolgens krijgen we een passage over Default/Create/BindFields die we kennen van Jos Visser. Tenslotte volgt een vertrouwde aanroep van InternalRefresh, waar ik later ook nog op inga.

    procedure TEMDDataSet.InternalOpen;
    begin
      if FOpen then exit;
      try
        FModified := false;
        FCached := true; 
        FCache := TStringlist.Create;
        FCache.LoadFromFile(FFilename);
        FRecCount := FCache.count - 2; //zonder header/footer
        FHeader := FCache[0];
        FFooter := FCache[FCache.count-1];
        FCsvFile := TStringlist.Create;
        InternalInitFieldDefs;
        FCsvFile.Delimiter := FDelimiter;
        FCsvFile.QuoteChar := FQuoteChar;
        if DefaultFields then CreateFields;
        BindFields(True);
        InternalRefresh;
        FOpen := true;
      except
        raise;
      end;
    end;
    

    De procedure InternalRefresh zorgt ervoor dat de gegevens uit FCache worden geplaatst in FCsvFile. In FCache staat ieder record op een eigen regel. In FCsvFile staat ieder veld op een eigen regel.

    procedure TEMDDataSet.InternalRefresh;
    var
      S: String;
      i: Integer;
    begin
      s := '';
      for i := 1 to FRecCount do
      begin
        s := s + FCache[i] + EOL;
      end;
      FCsvFile.DelimitedText := s;
    end;
    

    De constante EOL is als volgt gedefinieerd:

    const
      LF = #10;     //Linefeed
      CR = #13;     //Carriage return
      EOL = LF+CR;  //End of Line
    

    Omdat ik nu dezelfde gegevens op twee afzonderlijke locaties (FCsvFile en FCache) heb staan, heb ik voor de overzichtelijkheid twee functies geproduceerd die de index van de TDataset omrekenen naar de index voor FCsvFile en FCache.

    function TEMDDataSet.GetCacheRecno(Recno: integer): Integer;
    begin
      Result := Recno + 1; //Cache bevat footer, vandaar + 1
    end;
    
    function TEMDDataSet.GetCsvFileRecno(Recno, FieldIndex: integer): Integer;
    begin
      Result := Recno*FieldDefs.Count+FieldIndex;
    end;
    

    En als we een tabel hebben geopend, moeten we hem ook kunnen sluiten. Bij het sluiten van de database moet nog even alles worden weggeschreven, maar alleen als er iets veranderd is. Aangezien we niet weten wat er veranderd is, moet de header opnieuw geformeerd worden. Het opnieuw formeren van de footer is nog niet nodig, maar mogelijk veranderd in de toekomst het formaat van de header én footer, en dan is het handig dat de code preventief backwards compatible is.

    procedure TEMDDataSet.InternalClose;
    begin
      if not FOpen then exit;
      if FModified then
      begin
        FCache[0] := GenerateHeader(FHeaderVersion);
        FCache[FCache.Count-1] := GenerateFooter(FHeaderVersion);
        FCache.SaveToFile(FFileName);
      end;
      FreeAndNil(FCache);
      FreeAndNil(FCsvFile);
      BindFields(False);
      if DefaultFields then DestroyFields;
      FOpen := false;
    end;
    

    Versiebeheer

    Aangezien ik verwacht dat er in de toekomst functionaliteiten worden toegevoegd, moet ik een versiebeheersysteem inbouwen in de header. In de toekomst wil ik bijvoorbeeld een tabel read-only kunnen maken of overstappen naar unicode. Het eerste gedeelte van de header bepaalt de versie. Ik maak een constante aan met de tekst die verwacht wordt in de header. Op dit moment is er maar één versie (van de header-indeling), dus is er ook maar één constante.

    const
      C10_ANSI_10 = '<?xml version="1.0" encoding="ANSI"?><header version="1.0">';
    

    Om meer inzicht te verschaffen in de structuur van de header laat ik eerst de code zien die ik gebruik om een nieuwe header te formeren. De structuur van de header is eenvoudig. De header bevat het aantal velden, per veld de naam en het type, het aantal records, de seperator en het quotechar. De werking van FParseFieldBehaviour behandel ik een stukje verderop.

    function TEMDDataSet.GenerateHeader(const Version: String): String;
    var
      i: integer;
    begin
      result := Version;
      if Version = C10_ANSI_10 then
      begin
        result := result + '<kolommen count="'+ IntToStr(Fields.count)+'">';
        for i := 0 to Fields.count - 1 do
        begin
          result := result + '<k'+inttostr(i)+' name="' + FieldDefs[i].Name;
          result := result + '" type="'; 
          result := result + FParseFieldBehaviour.ParseField(FieldDefs[i].DataType, FieldDefs[i].Size);
          result := result + '"/>';
        end;
        result := result + '</kolommen><records count="'+inttostr(FRecCount)+'"></records>';
        result := result + '<seperator char="'+FDelimiter+'"/>';
        result := result + '<qoutechar char="'+FQuotechar+'"/>';
        result := result + '</header><!--';
        exit;
      end;
      raise EDatabaseError('Unknown version :' + Version);
    end;
    
    De footer ziet er een factor 10 eenvoudiger uit.
    function TEMDDataSet.GenerateFooter(const Version: String): String;
    begin
      result := '';
      if Version = C10_ANSI_10 then
      begin
        result := '-->';
        exit;
      end;
      raise EDatabaseError('Unknown version :' + Version);
    end;
    

    Om een tabel te converteren naar een andere versie heb ik de volgende functie bedacht:

    property HeaderVersion: String read FHeaderVersion write setHeaderVersion;
    
    procedure TEMDDataSet.setHeaderVersion(HeaderVersion: String);
    begin
      if HeaderVersion = C10_ANSI_10 then
      begin
        FHeaderVersion := HeaderVersion;
      end else begin
        raise EParserError.Create('Unknown Headerversion: '+HeaderVersion);
      end;
    end;
    

    De oplettende lezer ziet nog een verwijzing naar FParseFieldBehaviour, die nog nergens genoemd is. We spreken hier over een mooi voorbeeld van het "Strategy-pattern". Uitleg over de structuur en werking strekt buiten de scope van dit artikel, maar het is zeker de moeite waard om eens toe kijken hoe eea werkt, en wat er aangepast moet worden als er een bestand moet worden geopend met een andere header-versie. Hij is als volgt in de klasse gedefinieerd:

    interface
      private
        FParseFieldBehaviour: IParseFieldBehaviour;
    
      type 
        IParseFieldBehaviour = interface
          function ParseFieldDef(ADef: string): TFieldType;
          function ParseFieldSize(ADef: string): integer;
          function ParseField(Def: TFieldType;Size:Integer): String;
        end;
    
        C10_ANSI_10_ParseFieldBehaviour = class(TInterfacedObject, IParseFieldBehaviour)
        private const
          MAXFIELDSIZE = 2048;
          CNAMES: array[0..4] of String[10] =('integer','boolean','string','date','time');
          CTYPES: array[0..4] of TFieldType = (ftInteger,ftBoolean,ftString,ftDate,ftTime);
        public
          function ParseFieldDef(ADef: string): TFieldType;
          function ParseFieldSize(ADef: string): integer;
          function ParseField(Def: TFieldType;Size:Integer): String;
        end;
    
    imlementation
    
    function C10_ANSI_10_ParseFieldBehaviour.ParseField(Def: TFieldType; 
        Size: Integer): String;
    var
      i: integer;
    begin
      result := '';
      for i := 0 to length(CTYPES) - 1 do
      begin
        if Def = CTYPES[i] then
        begin
          result := CNAMES[i];
          break;
        end;
      end;
      if Size = 0 then exit;
      if Size = MAXFIELDSIZE then exit;
      result := result + '['+IntToStr(Size)+']';
    end;
    
    function C10_ANSI_10_ParseFieldBehaviour.ParseFieldDef(ADef  : string): TFieldType;
    var
      i: integer;
    begin
      result := ftUnknown;
      for i := 0 to length(CNAMES) - 1 do
      begin
        if StartsText(CNAMES[i], ADef) then
        begin
          result := CTYPES[i];
          exit;
        end;
      end;
    end;
    
    function C10_ANSI_10_ParseFieldBehaviour.ParseFieldSize(ADe  f: string): integer;
    const
      MAGICNUMBER = 8;  //length('string[') + length(']');
    begin
      result := 0;
      if StartsText('string', ADef) then
      begin
        result := MAXFIELDSIZE;
        if StartsText('string[', ADef) then
        begin
          if ADef[length(ADef)] <> ']' then
          begin
            raise EParserError.Create('Onbekende Veldgrootte: '+ADef);
          end;
          result := StrToInt(Copy(ADef, MAGICNUMBER, length(ADef)-MAGICNUMBER));
        end;
      end;
    end;
    

    Bestand lezen

    Voor het inlezen van het bestand is het handig dat ik een regel tekst stukje bij beetje kan verwerken. Daarvoor gebruik ik een schaar, en ik noem hem "knip".

    function Knip(var Str: String; const C: String): boolean;
    begin // Zie ook StartsText in unit StrUtils
      result := false;
      if copy(Str,1,length(C)) = C then
      begin
        Str := copy(Str, length(C)+1, length(Str)-length(C));
        result := true;
      end;
    end;
    

    De grootste lap code komt er nu aan. Deze verwerkt de header. Als er een nieuwe versie van de header wordt gedefinieerd zal ik deze procedure grondig aan moeten passen. Zowel de oude als een eventuele nieuwe indeling moet door deze procedure verwerkt of gedelegeerd kunnen worden. De belangrijkste regel van onderstaande code is "FieldDefs.Add(...".

    procedure TEMDDataSet.InternalInitFieldDefs;
    var
      XMLVersion: String;
      Encoding: String;
      HeaderVersion: String;
      HeaderProcessed: Boolean;
      FieldCount: Integer;
      TempHeader: AnsiString;  //Nog te verwerken gedeelte van de header
      FCount: Integer;
    const
      CKOLOMMENCOUNT_PREFIX = '<kolommen count="';
      CKOLOMMENCOUNT_SUFFIX = '">';
      CKOLOM_PREFIX = '<k';
      CKOLOMNAAM_PREFIX = ' name="';
      CKOLOMTYPE_PREFIX = '" type="';
      CKOLOM_SUFFIX = '"/>';
      CKOLOMMEN_SUFFIX = '</kolommen>';
      CRECORDCOUNT_PREFIX = '<records count="';
      CRECORDCOUNT_SUFFIX = '"></records>';
      CSEPERATOR_PREFIX = '<seperator char="';
      CSEPERATOR_SUFFIX = '"/>';
      CQUOTECHAR_PREFIX = '<qoutechar char="';
      CQUOTECHAR_SUFFIX = '"/>';
      CHEADER_SUFFIX = '</header><!--';
      CFOOTER = '-->';
      procedure ProcessHeader_10_ANSI_10; //XML 1.0; Encoding ANSI; Header 1.0
      var
        i: Integer;
        Veldnamen: array of AnsiString;
        Typenamen: array of AnsiString;
      begin
        XMLVersion := '1.0';
        Encoding := 'ANSI';
        HeaderVersion := '1.0';
        HeaderProcessed := true;
        FHeaderVersion := C10_ANSI_10;
        if not (C10_ANSI_10+TempHeader = FHeader) then 
          raise EReadError.Create('Bug gevonden bij het verwerken van een header.' +
                EOL+C10_ANSI_10+EOL+TempHeader);
        if not knip(TempHeader, CKOLOMMENCOUNT_PREFIX) then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
        //In onderstaande code wordt het aantal kolommen uitgelezen
        FieldCount := 0;
        while Tempheader[1] in ['1','2','3','4','5','6','7','8','9','0'] do
        begin
          FieldCount := FieldCount * 10 + StrToInt(TempHeader[1]);
          TempHeader := copy(TempHeader, 2, length(TempHeader)-1);
        end;
        if not knip(TempHeader, CKOLOMMENCOUNT_SUFFIX) then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
        setLength(Veldnamen, FieldCount);
        setLength(Typenamen, FieldCount);
        for i := 0 to FieldCount - 1 do
        begin
          if not knip(TempHeader, CKOLOM_PREFIX+inttostr(i)+ CKOLOMNAAM_PREFIX) then 
            raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
          //In onderstaande code worden de veldnamen uitgelezen
          Veldnamen[i] := '';
          while TempHeader[1] <> '"' do
          begin
            Veldnamen[i] := Veldnamen[i] + tempHeader[1];
            TempHeader := copy(TempHeader, 2, length(TempHeader)-1);
          end;
          if not knip(TempHeader, CKOLOMTYPE_PREFIX) then 
            raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
          //In onderstaande code worden de veldtypes uitgelezen
          Typenamen[i] := '';
          while TempHeader[1] <> '"' do
          begin
            Typenamen[i] := Typenamen[i] + tempHeader[1];
            TempHeader := copy(TempHeader, 2, length(TempHeader)-1);
          end;
          if not knip(TempHeader, CKOLOM_SUFFIX) then 
            raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
          FieldDefs.Add(veldnamen[i],FParseFieldBehaviour.ParseFieldDef(Typenamen[i]), 
              FParseFieldBehaviour.ParseFieldSize(Typenamen[i]));
        end;
        if not knip(TempHeader, CKOLOMMEN_SUFFIX+CRECORDCOUNT_PREFIX) then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
        FCount := 0;
        while Tempheader[1] in ['1','2','3','4','5','6','7','8','9','0'] do
        begin
          FCount := FCount * 10 + StrToInt(TempHeader[1]);
          TempHeader := copy(TempHeader, 2, length(TempHeader)-1);
        end;
        if FCount <> FRecCount then raise 
          EReadError.Create('Afwijkend aantal records: Header:'+inttostr(FCount)+
                            ' Data: '+inttostr(FReccount));
        if not knip(TempHeader, CRECORDCOUNT_SUFFIX+CSEPERATOR_PREFIX) then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
        FDelimiter := TempHeader[1];
        if (FDelimiter = '"') and (TempHeader[2] <> CSEPERATOR_SUFFIX[1]) then 
          FDelimiter := #0 else Knip(TempHeader, FDelimiter);
        if not knip(TempHeader, CSEPERATOR_SUFFIX+CQUOTECHAR_PREFIX) then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
        FQuoteChar := TempHeader[1];
        if (FQuoteChar = '"') and (TempHeader[2] <> CQUOTECHAR_SUFFIX[1]) then 
          FQuoteChar := #0 else Knip(TempHeader, FQuoteChar);
        if not knip(TempHeader, CQUOTECHAR_SUFFIX+CHEADER_SUFFIX) then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
        if FFooter <> CFOOTER then 
          raise EReadError.Create('Onbekend bestandsformaat: '+FFooter);
      end;
    begin
      HeaderProcessed := false;
      FieldCount := 0;
      TempHeader := FHeader;
      FieldDefs.Clear;
      if Knip(TempHeader, C10_ANSI_10) then
      begin
        FParseFieldBehaviour := C10_ANSI_10_ParseFieldBehaviour.Create;
        ProcessHeader_10_ANSI_10;
      end;
      if (not HeaderProcessed) or (CFOOTER <> FFooter) then
      begin
        raise EReadError.Create('Onbekend bestandsformaat: '+FHeader);
      end;
    end;
    

    Record inlezen

    Voor het inlezen van records zoek ik de gegevens op in de stringlist FCsvFile. Aan de hand van het datatype worden de gegevens geconverteerd. Voor het bepalen van de juiste index roep ik GetCsvFileRecno aan.

    function TEMDDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
      function uummssStrToTime(inv: string): TTime;
      var
        uur: integer;
        minuten: integer;
        seconden: integer;
      const
        LENGTEUREN = 2;
        LENGTEMINUTEN = 2;
        LENGESECONDEN = 2;
        LENGTETIJD = LENGESECONDEN + LENGTEMINUTEN + LENGTEUREN;
        POSITIEUREN = 1;
        POSITIEMINUTEN = POSITIEUREN + LENGTEUREN;
        POSITIESECONDEN = POSITIEMINUTEN + LENGTEMINUTEN;
      begin
        uur := 0;
        minuten := 0;
        seconden := 0;
        if length(inv) = LENGTETIJD then
        begin
          if isGetal(copy(inv,POSITIEUREN,LENGTEUREN)) then
          begin
            uur := strtoint(copy(inv,POSITIEUREN,LENGTEUREN));
          end;
          if isGetal(copy(inv,POSITIEMINUTEN,LENGTEMINUTEN)) then
          begin
            minuten := strtoint(copy(inv,POSITIEMINUTEN,LENGTEMINUTEN));
          end;
          if isGetal(copy(inv,POSITIESECONDEN,LENGESECONDEN)) then
          begin
            seconden := strtoint(copy(inv,POSITIESECONDEN,LENGESECONDEN));
          end;
        end else begin
          raise EConvertError(inv + ' not valid time');
        end;
        result := EncodeTime(uur, minuten, seconden, 0);
      end;
      function eejjmmddStrToDate(inv: string): Controls.TDate;
      var
        jaar: integer;
        maand: integer;
        dag: integer;
      const
        LENGTEJAAR = 4;
        LENGTEMAAND = 2;
        LENGTEDAG = 2;
        LENGTEDATUM = LENGTEDAG+LENGTEMAAND+LENGTEJAAR;
        POSITIEJAAR = 1;
        POSITIEMAAND = POSITIEJAAR + LENGTEJAAR;
        POSITIEDAG = POSITIEMAAND + LENGTEMAAND;
      begin
        jaar := 0;
        maand := 0;
        dag := 0;
        if length(inv) = LENGTEDATUM then
        begin
          if isGetal(copy(inv,POSITIEJAAR,LENGTEJAAR)) then
          begin
            jaar := strtoint(copy(inv,POSITIEJAAR,LENGTEJAAR));
          end;
          if isGetal(copy(inv,POSITIEMAAND,LENGTEMAAND)) then
          begin
            maand := strtoint(copy(inv,POSITIEMAAND,LENGTEMAAND));
          end;
          if isGetal(copy(inv,POSITIEDAG,LENGTEDAG)) then
          begin
            dag := strtoint(copy(inv,POSITIEDAG,LENGTEDAG));
          end;
        end;
        if (jaar =0) or (maand=0) or (dag=0) then
        begin
          raise EConvertError.Create(inv + ' not valid date');
        end;
        Result := EncodeDate(jaar,maand,dag);
      end;
    var
      SourceBuffer: PChar;
      RNo: Integer;
      Rec, Fld: String;
    begin
      result := false;
      SourceBuffer := ActiveBuffer;
      if SourceBuffer = nil then
      begin
        exit;
      end;
      RNo := PRecInfo(SourceBuffer)^.RecordNo;
      if (RNo > -1) and (RNo < FRecCount) then
      begin
        Rec := FCsvFile[GetCsvFileRecno(Rno,Field.Index)];
        Fld := Field.Fieldname;
        try
          if assigned(buffer) then case FieldDefs.Find(Fld).DataType of
            ftString:  StrPLCopy(Buffer, Rec, Field.Size);
            ftInteger: Integer(Buffer^) := StrToInt(Rec);
            ftBoolean: Integer(Buffer^) := Ord((Rec = 'T'));
            ftDate: TDateTimeRec(Buffer^).Date := 
                DateTimeToTimeStamp(eejjmmddStrToDate(Rec)).Date;
            ftTime: TDateTimeRec(Buffer^).Time := 
                DateTimeToTimeStamp(uummssStrToTime(Rec)).Time;
          end;
          if FieldDefs.Find(Fld).DataType in [ftString, ftInteger, ftDate, ftTime] then
          begin
            result := true;
          end else if FieldDefs.Find(Fld).DataType = ftBoolean then
          begin
            result := (Rec = 'T') or (Rec = 'F');
          end;
        except
          result := false;
        end;
      end;
    end;
    

    Read only => Random Access

    Nu zijn we op een niveau dat vergelijkbaar is met de situatie waar Jos Visser gestopt is. We gaan ons nu richten op het beschrijfbaar maken van de gegevens. De eerste functie die we aanpassen is GetCanModify. Deze gaf in Jos' versie altijd false terug, in deze opzet schieten we door naar het andere uiterste. We maken er true van. Netter is om eerst te controleren of het databasebestand niet als read-only is gemarkeerd. Ik zat er ook aan te denken om bepaalde tabellen of velden als read-only te kunnen markeren met een vermelding in de header, maar ik heb er nog geen noodzaak voor gehad, en ik weet niet of ik dat ooit handig ga vinden. Een geboortedatum van een persoon zal niet zo snel veranderen, maar wat als de gegevens verkeerd zijn ingevoerd?

    function TEMDDataSet.GetCanModify: Boolean;
    begin
      Result := true;
    end;
    

    De kunst van het verwijderen

    De makkelijke stap om een interactieve database te krijgen is de implementatie van het verwijderen van records. Ik begin met het aanroepen van inherited. Deze kan ook worden weggelaten. Ik gebruik het soms als geheugensteuntje om aan te geven dat deze functie wordt geërfd. De tweede actie is het daadwerkelijk deponeren van een record in de prullenbak. We passen FRecCount aan, omdat het aantal records iets is afgenomen. De internalRefresh zorgt dat de gegevens weer opnieuw worden ingelezen in FCsvFile. Het zou enige performance schelen om de velden op dezelfde manier te verwijderen in FCsvFile zoals de records worden verwijderd uit FCache, maar dit werkt ook. Tenslotte zetten we FModified op true. We gaan het bestand niet meteen opslaan, dat zou namelijk nog meer tijdsverlies opbrengen. Als de tabel gesloten wordt, kunnen we de nieuwe inhoud van FCache in het bestand dumpen. Het verwijderde record zijn we dan definitief kwijt; De prullenbak is dan leeggemaakt.

    procedure TEMDDataSet.InternalDelete;
    begin
      inherited;
      FCache.Delete(GetCacheRecno(FRecNo));
      // Eerste en laatste regel tellen niet mee, ivm header en footer
      FRecCount := FCache.count - 2; 
      InternalRefresh;
      FModified := true;
    end;
    

    Wijzigingen

    Als de geboortedatum van een bepaalde persoon toch gewijzigd moet worden, moeten we eerst edit aanroepen, vervolgens de datum wijzigen en tenslotte een post te geven. Het wijzigen van een record begint dus bij edit. We moeten er rekening mee houden dat er ook nog een cancel tussendoor kan komen. We moeten dus zowel de gegevens bij houden van het oorspronkelijke record, als die van het nieuwe record. Bij internalEdit maken we dus een kopietje van de oorspronkelijke niet-gewijzigde gegevens uit de tabel, en het recordnummer wat daarbij hoort.

    procedure TEMDDataSet.InternalEdit;
    begin
      FClone := FCache[GetCacheRecno(FRecNo)];
      FCloneRecno := FRecNo;
    end;
    

    Het aanpassen van de gegevens is een handeling die enige complexiteit met zich meebrengt, vandaar dat ik me in eerste instantie beperkt tot de eenvoudigere taken. We beginnen met InternalPost. Deze procedure is meteen uit te voeren na een edit, waardoor deze al getest kan worden voor dat er een letter data veranderd is.

    Ik wil zeker weten dat ik gegevens mag wijzigen, dus begin ik met een elegante Assert. Vervolgens kom ik weer bij een inherited. Ook hierbij geldt dat deze inherited eigenlijk overbodig is. Als er niets gewijzigd kan worden, hoeft er ook niets opgeslagen te worden, vandaar de regel met de controle of State zich in de juiste toestand bevind. CheckActive spreekt ook voor zich, en heeft eenzelfde controlerend doel als de voorgaande regel. De oorspronkele gegevens hebben we niet meer nodig. Deze worden immers overschreven. Daarom kunnen FCloneRecno en FClone die bij edit gevuld werden nu dan ook leeg gemaakt worden. De InternalRefresh zorgt er voor dat de gegevens op de juiste plaats terecht komen. FModified wordt op true gezet zodat de wijzigingen ook daadwerkelijk in het databasebestand terechtkomen.

    procedure TEMDDataSet.InternalPost;
    begin
      Assert(GetCanModify);
      inherited;
      if (State <> dsEdit) and (State <> dsInsert) then exit;
      CheckActive;
      FCloneRecno := -1; //BOF
      FClone := '';
      InternalRefresh;
      FModified := true; //Door deze regel worden de wijzigingen opgeslagen
    end;
    

    De volgende stap is de InternalCancel. Wie een stap vooruit kan zetten wil soms ook een stapje terug. De cancel maakt de wijzigingen ongedaan. Omdat Instert en Edit allebei andere dingen doen, moet de cancel in beide gevallen anders reageren. Bij een insert hoeft enkel het laatste record te worden verwijderd, want dit is het record wat tijdelijk is toegevoegd. Bij een edit moet het record wat eerder is gebackupt weer worden teruggeplaatst. Eventueel kan ervoor gekozen worden om hier nog eens te controleren of FRecno nog steeds overeenkomt met FCloneRecno. De internalRefresh neemt de zorg verder over. De gegevens worden weer "gesynchroniseerd". Tenslotte worden FCloneRecno en FClone weer geleegd, net als bij InternalPost.

    procedure TEMDDataSet.InternalCancel;
    begin
      case State of
        dsInsert: //Laatste record verwijderen
          dec(FRecCount); 
        dsEdit: //Wijzigingen ongedaan maken
          FCache[GetCacheRecno(FRecNo)] := FClone;
      end;
      InternalRefresh;
      FCloneRecno := -1; //BOF
      FClone := '';
    end;
    

    Om gegevens daadwerkelijk te kunnen veranderen, dienen we gebruik te maken van SetFieldData. Dit werkt op ongeveer dezelfde wijze als GetFieldData. Om de gegevens te plaatsen is het uitermate handig om te weten om wat voor soort gegevens dat het gaat. We vragen de veldnaam op, om te weten welk veld gewijzigd moet worden. Vervolgens vragen we op wat het data type is. Nu moeten we aan de hand van het juiste data type de gegevens in de buffer converteren naar het gewenste formaat. Vervolgens is deze procedure er verantwoordelijk voor dat de zojuist geconverteerde gegevens worden weggeschreven in de database.

    procedure TEMDDataSet.SetFieldData(Field: TField; Buffer: Pointer);
      function DateToEejjmmddStr(inv: TDate): string;
      const
        LENGTEJAAR = 4;
        LENGTEMAAND = 2;
        LENGTEDAG = 2;
        LENGTEDATUM = LENGTEDAG+LENGTEMAAND+LENGTEJAAR;
      begin
        result := IntToStr(DayOf(inv)); //Dagen
        while length(result) < LENGTEDAG do 
          result := '0'+result;
        result := IntToStr( MonthOf(inv)) + result; //Maanden
        while length(result) < (LENGTEDAG + LENGTEMAAND) do 
          result := '0'+result;
        result := IntToStr( YearOf(inv)) + result; //Jaren
        while length(result) < (LENGTEDATUM) do 
          result := '0'+result;
      end;
      function TimeToUummssStr(inv: TTime): string;
      const
        LENGTEUREN = 2;
        LENGTEMINUTEN = 2;
        LENGESECONDEN = 2;
        LENGTETIJD = LENGESECONDEN + LENGTEMINUTEN + LENGTEUREN;
      begin
        result := IntToStr(SecondOf(inv)); //Seconden
        while length(result) < LENGESECONDEN do 
          result := '0'+result;
        result := IntToStr( MinuteOf(inv)) + result; //Minuten
        while length(result) < (LENGESECONDEN + LENGTEMINUTEN) do 
          result := '0'+result;
        result := IntToStr(HourOf(inv)) + result; //Uren
        while length(result) < LENGTETIJD do 
          result := '0'+result;
      end;
    var
      Fld: String;
      S: String;
      i: Integer;
      temptimestamp: TTimeStamp;
    begin
      Fld := Field.Fieldname;
      if assigned(buffer) then 
        case FieldDefs.Find(Fld).DataType of
          ftString: S := PChar(Buffer);
          ftInteger: S := inttostr(pInteger(Buffer)^);
          ftBoolean: if (pbyte(Buffer)^ <> 0) then S := 'T' else S := 'F';
          ftDate:
          begin
            temptimestamp.Date := (PDateTimeRec(Buffer)^).Date;
            S := DateToEejjmmddStr(TimeStampToDateTime(temptimestam  p));
          end;
          ftTime:
          begin
            temptimestamp.Time := (PDateTimeRec(Buffer)^).Time;
            S := TimeToUummssStr(TimeStampToDateTime(temptimestamp)  );
          end;
        end;
      FCsvFile[GetCsvFileRecno(FCloneRecno, Field.Index)] := S;
      if FQuoteChar = #0 then
      begin
        FCache[GetCacheRecno(FCloneRecno)] := 
            FCsvFile[GetCsvFileRecno(FCloneRecno,0)];
      end else begin
        FCache[GetCacheRecno(FCloneRecno)] := FQuoteChar + 
            FCsvFile[GetCsvFileRecno(FCloneRecno,0)] + FQuoteChar;
      end;
      for i := 1 to Fields.count - 1 do
      begin
        if FQuoteChar = #0 then
        begin
          FCache[GetCacheRecno(FCloneRecno)] := FCache[GetCacheRecno(FCloneRecno)] + 
              FDelimiter + FCsvFile[GetCsvFileRecno(FCloneRecno,i)];
        end else begin
          FCache[GetCacheRecno(FCloneRecno)] := FCache[GetCacheRecno(FCloneRecno)] + 
              FDelimiter + FQuoteChar + FCsvFile[GetCsvFileRecno(FCloneRecno,i)] + 
              FQuoteChar;
        end;
      end;
      InternalRefresh;
    end;
    

    Records toevoegen

    De volgende aktie die we implementeren handelt het toevoegen van records af. Ik dacht in eerste instantie dat dat met InternalAddRecord zou lukken, maar deze procedure leek niet aangeroepen te worden. We moeten het dus doen met InternalInsert. Het aantal records wordt logischerwijs opgehoogd. De header moet opnieuw worden geformeerd omdat anders het aantal records niet meer overeenkomt. Er worden lege velden en een leeg record toegevoegd aan respectievelijk FCsvFile en FCache. Bij FCache moet eerst de footer worden verwijderd, vervolgens moet het record worden toegevoegd en tenslotte moet een nieuwe footer geformeerd worden.
    Bij InternalRefresh komt een bug aan het licht. Als het laatste record allemaal lege velden bevat, worden er te weinig velden toegevoegd aan FCsvFile. Deze bug dient in InternalRefresh te worden verholpen, maar dit probleem valt buiten de strekking van dit artikel. Een database hoort nou eenmaal gevuld te zijn met data, en bij een gevulde database treedt het probleem niet op.

    procedure TEMDDataSet.InternalInsert;
    var
      i: Integer;
      s: String;
    begin
      inherited;
      FCloneRecno := FRecCount; //EOF
      inc(FRecCount);
      FCache[0] := GenerateHeader(HeaderVersion);
      for i := 0 to Fields.count - 1 do
      begin
        FCsvFile.Add('');
        if i > 0 then s := s + FDelimiter;
      end;
      if FCache[FCache.Count-1] = GenerateFooter(HeaderVersion) then
      begin
        FCache.Delete(FCache.Count-1);
      end else begin
        raise EDatabaseError.Create('No Footer found: '+ 
                                    FCache[FCache.Count-1]);
      end;
      FCache.Add(s);
      FCache.Add(GenerateFooter(HeaderVersion));
      //InternalRefresh;  // Worden 3 regels toegevoegd ipv 5 als 
                          // tekst ';;;;' wordt toegevoegd
      InternalLast;
      FModified := true;
    end;
    
  • Nieuwste forumberichten

    Christian

    FTDI 64 bit invalid handle

    Lekker bezig,

    Heb even een test gedaan warbij ik in de originele code de handle heb vervangen door de TFT_Handle = pointer.
    Hierna

    Christian Yesterday, 15:18 Go to last post
    flabber

    FTDI 64 bit invalid handle

    Nog een stukje vanuit mijn kant dan... het is maar een klein stukje hoor, je bent waarschijnlijk zelf al wel verder gekomen. Nog geen rekening gehouden

    flabber Yesterday, 14:30 Go to last post
    Christian

    FTDI 64 bit invalid handle

    met de hulp van Flabber een eigen unit gemaakt (met enkel de open close functie)
    Hiermee kan ik het device openen en sluiten op zowel 32 / 64 bit

    Christian Yesterday, 13:14 Go to last post
    rvk

    Met RTF-code een tabel zetten op RichMemo

    RichMemo heeft geen notie van wat er in de richedit dll gebeurd met een tabel. Dus het enige dat ik me voor kan stellen is een karakter onder de tabel

    rvk Yesterday, 11:53 Go to last post
    flabber

    FTDI 64 bit invalid handle

    een klein opzetje dan, niet gechecked:

    Delphi Code:
    1. type
    2.   PFT_HANDLE = ^TFT_HANDLE;
    3.   TFT_HANDLE = pointer;
    4.   TFT_STATUS = ULONG;

    flabber Yesterday, 11:14 Go to last post
    Dubbeld

    Met RTF-code een tabel zetten op RichMemo

    Hallo allemaal,

    Ik zet via RTF-code een tabel op Richmemo. De tabel bestaat uit één kolom. Deze kolom
    heeft een breedte van X cm

    Dubbeld Yesterday, 11:00 Go to last post