// erzeugt eine Baumstruktur,
die nach dem Datensatzstatus (entliehen, zu bestellen ...) sortiert ist
procedure INIT0(getProcAdress:TFarProc; var name,
copyright, buttonname, buttonpicpath, menupicpath:PChar; var startoption:byte);
export;
begin
Name:=PChar('Datensatzstatus-Baum-TreeListPop
v1.0');
Copyright:=PChar('(c) 2001 by Jan W. Krieger');
buttonpicpath:=PChar('TREESCHLAG_BIG');
menupicpath:=PChar('TREESCHLAG');
buttonname:=PChar('Datensatzstatus-Baum');
startoption:=soTreeView;
@getProcA:=getProcAdress;
@GetStringField:=getProcA(gpGetStrField);
@SetStringField:=getProcA(gpSetStrField);
@CurrentControlSetText:=getProcA(gpCurrentControlSetText);
@DoMacro:=getprocA(gpDoMacro);
@LoadtreeList:=getprocA(gpTreeViewLoadFromFile);
@GetString:=getProcA(gpGetString);
@GetInteger:=getProcA(gpGetInt);
@SetString:=getProcA(gpSetString);
@SetInteger:=getProcA(gpSetInt);
@SetDBWorking:=getProcA(gpSetDBWorking);
@SetDBReady:=getProcA(gpSetDBReady);
end;
procedure START0; export;
var f:system.text;
filename, stat:string;
root,item:TStringList;
i, count:longint;
s:PCHAR;
found:TFound;
procedure WriteData(list:TStringList);
var j:longint;
begin
if list.count>0 then for j:=0
to list.count-1 do begin
if list[j]<>'' then
begin
writeln(f, '
<litdirectory name="'+EntityString(list[j])+'">');
WriteData(TStringList(list.objects[j]));
list.objects[j].free;
writeln(f, '
</litdirectory name="'+EntityString(list[j])+'">');
end else begin
WriteLn(f, '
<litcitation dataid="'+EntityString(TFound(list.objects[j]).num)+'"/>');
TFound(list.objects[j]).free;
end;
end;
end;
begin
SetDBWorking(PCHAR('Erstelle Datensatzstatus-Baum
...'));
root:=TStringList.create;
root.clear;
filename:=GetTempFileName;
assignfile(f, filename);
rewrite(f);
writeLn(f, '<?xml version="1.0" standalone="yes"?>');
writeLn(f, '<littree date="'+EntityString(datetostr(now))+'"
databasename="'+EntityString(StrPas(GetString(gdDBName)))+'"
tablename="'+EntityString(StrPas(GetString(gdTableName)))+'"
name="Schlagwort-Baum">');
DoMacro(dmSetClonePlugtable);
DoMacro(dmFirst);
count:=GetInteger(gdRecordCount);
SetInteger(siProgressMax, count);
try for i:=1 to count
do begin
SetInteger(siProgressPosition, i);
stat:=StrPas(GetStringField(PCHAR('Status')));
if stat<>'' then
begin
found:=TFound.create;
s:=GetStringField(PCHAR('DATAID'));
found.num:=strpas(s);
if root.IndexOf(stat)<0
then begin
item:=TStringList.create;
item.clear;
root.AddObject(stat, item);
end else item:=TStringList(root.objects[root.indexof(stat)]);
item.AddObject('',
found);
end;
DoMacro(dmNext);
flush(f);
end; finally
WriteData(root);
writeLn(f, '</littree>');
closefile(f);
end;
DoMacro(dmSetStndPlugtable);
SetInteger(siProgressPosition, 0);
LoadTreeList(PCHAR(filename));
sysutils.Deletefile(filename);
SetDBReady(PCHAR('...'));
try root.free; except end;
end;
procedure FREE0; export;
begin
end;