Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs,sip,sipclient, Vcl.StdCtrls, sEdit,
sButton,call, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
sButton1: TsButton;
sButton2: TsButton;
sEdit1: TsEdit;
Memo1: TMemo;
sEdit2: TsEdit;
sEdit3: TsEdit;
sEdit4: TsEdit;
procedure sButton1Click(Sender: TObject);
procedure sButton2Click(Sender: TObject);
private
{ Private declarations }
public
number:string;
host,password,user:string;
end;
type
TMyClass = class(TObject)
public
SIP1:TSipClient;
call: Icall;
procedure SipClientRegistration(Sender: TObject; const Registered: Boolean);
procedure SipClientCall(Sender: TObject; const ACall: ICall);
procedure callme;
constructor Create();
destructor Delete();
end;
TmyThread = class(TThread)
private
{ private declarations }
protected
procedure Execute; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TMyClass.callme;
begin
call:= SIP1.Call(Form1.number);
end;
constructor TMyClass.Create;
begin
inherited;
SIP1:= TSipClient.Create(nil);
sip1.Host:=Form1.host;
SIP1.User:=Form1.user;
SIP1.Password:=Form1.password;
SIP1.OnRegistration := SipClientRegistration;
SIP1.OnCall:= SipClientCall;
SIP1.Active:=True;
SIP1.Register;
end;
destructor TMyClass.Delete;
begin
inherited;
end;
procedure TMyClass.SipClientRegistration(Sender: TObject; const Registered: Boolean);
begin
if Registered then callme else ShowMessage('не верный логин/пароль');
end;
procedure TMyClass.SipClientCall(Sender: TObject; const ACall: ICall);
begin
call:= Acall;
call.Answer;
end;
procedure TForm1.sButton1Click(Sender: TObject);
var
th: TmyThread;
begin
number:=Self.sEdit1.Text;
host:= self.sEdit2.Text;
user:= Self.sEdit3.Text;
password:= self.sEdit4.Text;
th:= TmyThread.Create(True);
th.FreeOnTerminate:=True;
th.start;
end;
procedure TmyThread.Execute;
var
MyClass: TMyClass;
begin
MyClass:= TMyClass.Create;
repeat
sleep(3000);
self.Queue(
procedure
begin
Form1.Memo1.Lines.Add('ничего не делаю, жду пока умру');
end);
until terminated;
end;
procedure TForm1.sButton2Click(Sender: TObject);
var
MyClass: TMyClass absolute Sender;
begin
MyClass.call.EndCall;
MyClass.call:= nil;
end;
end.
В общем сделал для примера что-то в этом роде, в общем поток вообще не умирает и не выполняет, хотя если написать th.execute; то без потока все выходит идеально. Т.е. поток завершается раньше чем событие, а если я его задерживаю, он не умирает в общем