Registriert seit: 10. Sep 2010
249 Beiträge
|
AW: TMemo (FireMonkey)
28. Jan 2014, 10:51
Im Endeffekt rufe ich aus einem Thread verschiedene prozeduren auf:
Delphi-Quellcode:
...
function write(msg : string) : string;
begin
Form1.Memo1.Lines.BeginUpdate;
try
Form1.Memo1.Lines.Add(DateToStr(Now)+' '+TimeToStr(Now)+' '+msg);
finally
Form1.Memo1.Lines.EndUpdate;
end;
end;
....
function RightsThread() : string;
var
groups, idprivs : TStringlist;
i,i2 : Integer;
idRole, right, prefix : String;
begin
result := ' ok';
write(' [RIGHTS] Thread started');
//SQL Connection
write(' - Connecting to Database ...');
if sqlst.connect_extdb(' 127.0.0.1', ' test', ' test', ' mainDB') <> ' OK' then begin
write(' - ERROR: Cannot connect to Database');
write(sqlst.assert);
result := ' error';
abort;
end;
write(' - SQL Connection established');
//prefix
if Form1.Switch1.IsChecked then
prefix := ' v3_'
else
prefix := ' ';
Write(' - Reading Groups...');
groups := TStringlist.Create;
sqlst.DoQuery(' select name from tbrole', groups);
i := 0;
if groups.Count < 1 then begin
write(' - ERROR: No Group(s) found. [GroupThread] finished');
result := ' error';
abort;
end;
idprivs := TStringlist.Create;
//Start it
Writeln(x, ' <!-- Define Group and Access Rights -->');
while i < groups.Count do begin
write(' - Processing Group '+groups[i]);
Writeln(x, ' <group name="'+prefix+groups[i]+' " enabled="true"/>');
Writeln(x, ' <groupRegion group="'+prefix+groups[i]+' " region="Standard"/>');
//Start Reading Access Rights
idRole := sqlst.query(' select idrole from tbrole where name = '' '+groups[i]+' '' ');
if idRole = ' ' then begin
write(' - ERROR: IDRole not found for '+groups[i]);
abort;
end;
//Read all rights
sqlst.DoQuery(' select idpriv from tbuserright where idrole = '+idrole+' and extra is NULL', idprivs);
Write(' - '+inttostr(idprivs.Count)+' Userright(s) found for group '+groups[i]);
i2 := 0;
while i2 < idprivs.Count do begin
right := sqlst.query(' select name from tbpriv where idpriv = '+idprivs[i2]);
right := convert_userright(right);
if right = ' unknown' then goto next;
Writeln(x, ' <accessRight group="'+prefix+groups[i]+' " accessRight="'+right+' "/>');
Write(' Added Right '+right);
next:
i2 := i2 + 1;
end;
i := i + 1;
idprivs.Clear;
Writeln(x, ' ');
end;
sqlst.close;
groups.Free;
idprivs.Free;
end;
Habe jetzt auch versucht weniger auszugeben sprich ich habe die Write's in der While loop entfernt...
Selber Effekt :/
|
|
Zitat
|