unit CodeTestDLL;
interface
uses
SysUtils,
Dialogs,
Classes;
type
PTmyDBRow = ^TmyDBRow;
TmyDBRow =
record
value:
Array of ShortString;
marker: Boolean;
next: PTmyDBRow;
end;
PTmyDBField = ^TmyDBField;
TmyDBField =
record
name: ShortString;
next: PTmyDBField;
end;
PTmyDB = ^TmyDB;
TmyDB =
record
name: ShortString;
fieldcnt: Integer;
fields: PTmyDBField;
data: PTmyDBRow;
next: PTmyDB;
end;
PTmyTmp = ^TmyTmp;
TmyTmp =
record
value: ShortString;
next: PTmyTmp;
end;
procedure MyDBDecode(
var pLine: ShortString);
procedure MyDBExplode(pHaystack:
String);
function MyDBFieldNr(FieldName: ShortString;
var p: Integer): Boolean;
function MyDBGetError(): ShortString;
stdcall;
function MyDBLoad(DBName, FileName: ShortString): Boolean;
stdcall;
procedure MyDBSelect(DBName, DBFields: ShortString);
stdcall;
procedure MyDBFilter(FieldName, Value: ShortString);
stdcall;
function MyDBGetResult(
var Values: ShortString): Boolean;
stdcall;
var
myDBs: PTmyDB;
myLastDB: ShortString;
myLastFields: ShortString;
myResult: PTmyDBRow;
myTmpVal: PTmyTmp;
myError: ShortString;
curDB: PTmyDB;
const
mySepStr : Char = '
|';
myErrOpenFailed : ShortString = '
Öffnen der Datenbank fehlgeschlagen';
myErrWrongHeader: ShortString = '
Format der Datenbank unbekannt';
myErrCorrupt : ShortString = '
Datenbank korrupt';
myFileHeader : ShortString = '
waspdbfile_v1.0';
implementation
// Da die Datenbankdateien verschlüssel sind, muss jede einzelne Zeile mit Hilfe
// dieser Routine entschlüsselt werden. Ist nicht gerade extrem sicher, aber
// reicht gegen "normale Hacker" ;)
procedure MyDBDecode(
var pLine: ShortString);
// [...]
end;
// Das Aufsplitten einer Zeile anhand des SepStrings übernimmt diese Routine.
// Das Ergebnis wird in einem verketteten, temporärem Record gespeichert. So
// kann es dann später leicht in verschiedene Datenformen umgewandelt werden.
procedure MyDBExplode(pHaystack:
String);
var
i: Integer;
sValue:
String;
TmpVal: PTmyTmp;
begin
TmpVal :=
nil;
// Erstmal das temporäre Feld löschen, falls noch voll
while (myTmpVal <>
nil)
do begin
TmpVal := myTmpVal;
myTmpVal := myTmpVal^.next;
Dispose(TmpVal);
end;
// Dann Stück für Stück die Zeile durchgehen und bei Auffinden des SplitChr
// den so gesammelten Wert in das verkettete Record setzen.
sValue := '
';
for i := 1
to Length(pHaystack)
do begin
if (pHaystack[i] = mySepStr)
then begin
// Zwischenwert im verketteten Record speichern
if (myTmpVal =
nil)
then begin
New(myTmpVal);
TmpVal := myTmpVal;
end
else begin
New(TmpVal^.next);
TmpVal := TmpVal^.next;
end;
TmpVal^.value := sValue;
TmpVal^.next :=
nil;
sValue := '
';
// Zwischenspeicher zurücksetzen
end
else begin
sValue := sValue + pHaystack[i];
end;
end;
end;
// Jedes Feld bekommt ja eine Nummer. Diese Routine ermittelt die zugehörige
// Nummer eines Feldes (=Spalte in Tabelle).
function MyDBFieldNr(FieldName: ShortString;
var p: Integer): Boolean;
var
curField: PTmyDBField;
begin
// An welcher Stelle steht denn Fieldname?
curField := curDB^.fields;
p := 0;
while (curField <>
nil)
and (curField^.
name <> FieldName)
do begin
curField := curField^.next;
Inc(p);
end;
Result := (curField <>
nil);
end;
// Diese Routine soll zu beginn der Anwendung erst einmal alle verfügbaren
// Datenbankdateien einlesen und in mehreren verketteten Records speichern.
// Die Routine sucht die Datenbanken nicht selber, sondern bekommt jede einzeln
// per Parameter (wird also pro DB einmal aufgerufen).
function MyDBLoad(DBName, FileName: ShortString): Boolean;
stdcall;
var
DBFile: TextFile;
FileOpened: Boolean;
Line: ShortString;
TmpVal: PTmyTmp;
curField: PTmyDBField;
curRow: PTmyDBRow;
cnt, n: Integer;
begin
myError := '
';
Result := false;
FileOpened := false;
curField :=
nil;
curRow :=
nil;
cnt := 0;
// Datei öffnen
AssignFile(DBFile, FileName);
{$I-}
FileMode := 0;
Reset(DBFile);
// Dateiheader lesen
if (IOResult = 0)
then begin
FileOpened := True;
Readln(DBFile, Line);
end
else myError := myErrOpenFailed;
if (myError = '
')
then begin
if (IOResult <> 0)
then myError := myErrOpenFailed;
end;
// Dateispalten einlesen ...
if (myError = '
')
then begin
if (Line = myFileHeader)
then begin
Readln(DBFile, Line);
end
else myError := myErrWrongHeader;
end;
// ... und merken
if (myError = '
')
then begin
if (IOResult = 0)
then begin
// Jetzt kommen ja definitiv Daten, also muss die neue Datenbank
// angelegt werden
if (myDBs =
nil)
then begin
New(myDBs);
curDB := myDBs;
end
else begin
curDB := myDBs;
while (curDB^.next <>
nil)
do
curDB := curDB^.next;
New(curDB^.next);
curDB := curDB^.next;
end;
curDB^.
name := DBName;
curDB^.fields :=
nil;
curDB^.data :=
nil;
curDB^.next :=
nil;
// Daten entschlüsseln und splitten
MyDBDecode(Line);
MyDBExplode(Line);
// Daten im Field-Record speichern und Felder (=Spalten) zählen
cnt := 0;
TmpVal := myTmpVal;
while (TmpVal <>
nil)
do begin
if (curDB^.fields =
nil)
then begin
New(curDB^.fields);
curField := curDB^.fields;
end
else begin
New(curField^.next);
curField := curField^.next;
end;
curField^.
name := TmpVal^.value;
curField^.next :=
nil;
TmpVal := TmpVal^.next;
Inc(cnt);
end;
curDB^.fieldcnt := cnt;
end
else myError := myErrCorrupt;
end;
// Daten einlesen und im Array ablegen
if (myError = '
')
then begin
while not Eof(DBFile)
do begin
Readln(DBFile, Line);
if (IOResult = 0)
and (Line <> '
')
then begin
// Daten entschlüsseln und splitten
MyDBDecode(Line);
MyDBExplode(Line);
// Neue Zeile (Datensatz, Row) erzeugen
if (curDB^.data =
nil)
then begin
New(curDB^.data);
curRow := curDB^.data;
end
else begin
New(curRow^.next);
curRow := curRow^.next;
end;
SetLength(curRow^.value, cnt);
curRow^.marker := true;
curRow^.next :=
nil;
// Werte in der Zeile speichern
TmpVal := myTmpVal;
n := 0;
while (TmpVal <>
nil)
do begin
if (n < cnt)
then begin
curRow^.value[n] := TmpVal^.value;
TmpVal := TmpVal^.next;
end;
Inc(n);
end;
end;
end;
Result := true;
end;
{$I+}
// Datei schließen
if (FileOpened = true)
then begin
CloseFile(DBFile);
end;
end;
// [...]