[Ramsay]

Hola , estoy haciendo una unit que hace multithreading , el codigo de la unit :

Código Delphi [-]
unit probando;

{$POINTERMATH ON}

interface

uses
  System.SysUtils, Vcl.Dialogs, Windows, TlHelp32, ShellApi,
  Classes, Math, Vcl.Forms, Vcl.Imaging.jpeg, Vcl.StdCtrls, Vcl.Graphics,
  Vcl.Controls,
  ComObj, ActiveX, Variants, Messages;

type
  T_probando = class
  private

  public
    constructor Create;
    destructor Destroy; override;
    function loader_tester(argument: string; count: integer): string;
  end;

implementation

constructor T_probando.Create;
begin
  inherited Create;
  //
end;

destructor T_probando.Destroy;
begin
  inherited Destroy;
end;

// Function loader_tester

type
  thread_loader_tester = class(TThread)
  protected
    procedure Execute; override;
  public
    argument: string;
  end;

procedure thread_loader_tester.Execute;
var
  command: string;
  info: string;
begin
  TThread.Synchronize(nil,
    procedure
    begin
      command := 'c:/xampp/titulo.txt';
      info := '';
      ShellExecute(0, 'open', Pchar(command), Pchar(info), nil, SW_NORMAL);
    end);
end;

function T_probando.loader_tester(argument: string; count: integer): string;
var
  thread_now: thread_loader_tester;
  i: integer;
  fThreadRefCount: integer;
  check: integer;
begin
  try
    fThreadRefCount := 0;
    begin

      For i := 1 to count do
      begin
        thread_now := thread_loader_tester.Create(True);
        thread_now.argument := argument;
        thread_now.FreeOnTerminate := True;
        thread_now.Start;
        Inc(fThreadRefCount);
      end;

      While fThreadRefCount > 1 do
      // While (fThreadRefCount > 1) and (fThreadRefCount < count) do
      begin
        Application.ProcessMessages;
        CheckSynchronize;
      end;

      Result := 'ok';
    end;
    Result := 'ok';
  except
    begin
      Result := 'error';
    end;
  end;
end;

end.

Debe funcionar tanto en aplicaciones graficas como en consola , lamentablemente estoy mejorandola para que funcione en consolas , el codigo de la consola.

Código Delphi [-]
program test;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Windows, System.SysUtils, probando;

var
  test_now: T_probando;

begin
  try
    test_now := T_probando.Create();
    Writeln('[+] Response');
    Writeln('response : '+test_now.loader_tester('c:/xampp/titulo.txt', 5));
    Readln;
  except
    on E: Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;

end.

Funciona , pero entra en un ciclo infinito :

Código Delphi [-]
While fThreadRefCount > 1 do

Intente checkeando que verificara la cantidad de threads y ahi terminara :

Código Delphi [-]
While (fThreadRefCount > 1) and (fThreadRefCount < count) do

Pero si hago esto no se ejecuta ningun thread.



¿ Alguien podria ayudarme ?