Thema: Delphi TMemo (FireMonkey)

Einzelnen Beitrag anzeigen

value is NULL

Registriert seit: 10. Sep 2010
249 Beiträge
 
#4

AW: TMemo (FireMonkey)

  Alt 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') <> 'OKthen 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 = 'unknownthen 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 :/
  Mit Zitat antworten Zitat