TThread Syncronise & TCriticalSection.Enter

[Jonas Shinaniganz]

Delphi-Quellcode:

unit frmMain;

interface

uses
  System.SysUtils, System.Classes, FMX.Forms3D, IdGlobal, IdStack,
  FMX.Layers3D, FMX.StdCtrls,  FMX.Layouts, FMX.Memo, FMX.Edit, FMX.Controls,
  FMX.Controls3D, FMX.Types;

type
  TMainForm = class(TForm3D)
    Memo: TMemo;
    ProgressBar: TProgressBar;
    Layer3D1: TLayer3D;
    AniIndicator1: TAniIndicator;
    NumberBox1: TNumberBox;
    Label1: TLabel;
    NumberBox2: TNumberBox;
    NumberBox3: TNumberBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    Output : TStringlist;
    FProgress : Integer;
    procedure AddToMemo(Ip : Integer; Str : String);
    procedure Setprogress(const Value: Integer);
  public
    property Progress : Integer read FProgress write SetProgress;
  end;

  TLookupThread = class(TThread)
  protected
    Ip : Integer;
    procedure Execute; override;
  public
    constructor Create(Next : Integer);
  end;

var
  MainForm : TMainForm;
  NET : String = '172.17.4.';

implementation

{$R *.fmx}

procedure TMainForm.AddToMemo(Ip : Integer; Str : String);
begin
  Output.Add('...' + Format('%3d',[Ip])+ ' - ' + str);
  Progress := Progress + 1;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  i : integer;
  thrd : TLookupThread;
begin
  Output := TStringList.Create;

  NET := NumberBox1.Value.ToString + '.' + NumberBox2.Value.ToString + '.' + NumberBox3.Value.ToString + '.';

  for I := 1 to 254 do
    thrd := TLookupThread.Create(I);

  ProgressBar.Min := 0;
  ProgressBar.Max := 253;
  Progress := 0;

  AniIndicator1.Enabled := true;
  AniIndicator1.Visible := true;
end;

constructor TLookupThread.Create(Next : Integer);
begin
  inherited Create;
  Ip := Next;
end;

procedure TLookupThread.Execute;
var
  str : String;
begin
  inherited;
  TIdStack.IncUsage;
  try
    str := Gstack.HostByAddress(NET + IntToStr(Ip));
  except on E: Exception do
    str := 'inexistent domain';
  end;
  TIdStack.DecUsage;

  Synchronize(
  procedure
  begin
    MainForm.AddToMemo(Ip, Str);
  end);

  Self.Free;
end;

procedure TMainForm.Setprogress(const Value : Integer);
begin
  FProgress := Value;
  ProgressBar.Value := FProgress;
  if FProgress = 254 then
  begin
    AniIndicator1.Enabled := False;
    AniIndicator1.Visible := False;
    Output.Sort;
    Output.Insert(0, 'parse net: ' + NET + '...');
    Memo.Lines.Assign(Output);
    Output.Free;
  end;
end;

end.

Naja ich habe es so angepasst. Programm gibt's im Anhang, leicht erweitert.
Die While-Schleife macht ja einen Insertionsort... Das war auch vorher der Haken, habe es dann so ähnlich korrigiert. Danach fand ich das häufige hinzufügen von Lines zum Memo aber nicht mehr schön. Nutze letztlich eine TStringlist. Für mich ist das jetzt auch schon wieder abgehakt Danke an euch.

Edit:
Warum gibt es eigentlich keine Warnung das

Zitat:

stack : TIdStack;

nie benutzt wird? @Blup Das mit dem Event ist natürlich schöner designed.