Einzelnen Beitrag anzeigen

Benutzerbild von Jonas Shinaniganz
Jonas Shinaniganz

Registriert seit: 30. Aug 2011
249 Beiträge
 
Delphi XE5 Ultimate
 
#5

AW: TThread Syncronise & TCriticalSection.Enter

  Alt 15. Mai 2014, 10:51
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.
Angehängte Dateien
Dateityp: rar AreaLookup.rar (1,30 MB, 8x aufgerufen)
Die Leiter der Entwicklungsabteilung dreht total am Mausrad!

Geändert von Jonas Shinaniganz (15. Mai 2014 um 10:55 Uhr)
  Mit Zitat antworten Zitat