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;