Delphi 如何从主VCL线程调用TThread对象的方法？

我使用我的代码线程发送短信。 对于发送SMS，我使用

MCoreComponent

类； 首先，重写

Create

函数并创建

objSMS1

对象， 然后在

Execute

函数中调用

objSMS1.connect（）

constructor ReceiveThread.create;
begin
  Inherited Create(True);
  objSMS1 := TSMS.Create(nil);
end;

procedure ReceiveThread.Execute();
begin
  if Not objSMS1.IsError(true, strMyAppName) then
  begin
    objSMS1.Connect();
    if Not objSMS1.IsError(true, strMyAppName) then
       ShowMessage('Connection successful');
  end;

  while not Terminated do
  begin
    CoInitialize(nil);
    DoShowData;//Recieved Message
  end;
end;

这两个功能工作正常，成功连接到模块，每次都检查收件箱

但是我需要发个信息。我的
发送消息
功能是：

procedure ReceiveThread.SendSMS(phoneno, txt: String);
var strSendResult :String;
begin
  objSMS1.Validity := Trim('24') + LeftStr('Hour', 1);//Access    Violation    Error

  strSendResult := objSMS1.SendSMS(phoneno, txt, False);
  if Not objSMS1.IsError(true, strMyAppName) then
    MessageDlg('Message sent!', mtInformation, [mbOK], 0);
end;

当我在点击主窗体的按钮中调用
SendSMS
功能时，应用程序遇到访问冲突错误。如何在线程中调用发送消息

其他设置

  var
    RTh : ReceiveThread;//Global Var

  //Run Tread
  RTh := ReceiveThread.Create();
  RTh.FreeOnTerminate := True;


  //Send Message From Button Click
  RTh.SendSMS(Phoneno,Msg);//Access Violation Error

根据问题，主要的可见问题是
MessageDlg
是从线程的方法内部调用的，没有同步块，但是代码本身有许多其他问题，对问题的注释已经为您指出了正确的方向

调用
DoShowData
可能是另一个麻烦，但问题没有给出更多细节

另一件奇怪的事情是反复调用
CoInitialize
。尽管这并不代表一个大问题，因为后续调用返回
False
，但调用必须通过
coninitialize
进行平衡

引用一条评论：“SendSMS线程安全吗？”你知道


我试着对你的代码进行排序-我希望


线程使用类型的列表并将其视为存储和获取要发送的SMS的方法：通过其方法访问列表以避免并发访问

SMS sent notify作为类型为
TSMSSentEvent
的自定义通知事件实现：如果分配了该事件，则会在两个事件之间触发该事件，以便在主线程（GUI应用程序中的VCL线程）中执行

Sleep（1）
减少队列为空时的CPU费用*在我的电脑上从
50%
减少到
2%


小心对象的创建和处理，因为我放的地方可能不正确；另外，每次发送队列时，您可能必须调用
objSMS1.Connect
，并且
objSMS1.Disconnect
-此方法应该可用-之后立即使用，但您应该知道它

{$DEFINE FAKESMS}
编译器指令允许我测试应用程序，因为我没有任何
MCoreComponent
库：我将其保留为测试目的


SMSSender.pas单位：线程类和好友

unit SMSSender;

{.$DEFINE FAKESMS}

interface

uses
  System.SysUtils,
  System.Classes,
  System.Generics.Collections,
  Winapi.ActiveX;

const
  StrMyAppName = '';

type

  {$IFDEF FAKESMS}
  TSMS = class
    public
      Validity: string;
      function IsError(a: Boolean; b: string): Boolean;
      procedure Connect;
      function SendSMS(phoneNo, text: string; bBool: Boolean): string;
      constructor Create(AObj: TObject);
  end;
  {$ENDIF}

  TSMSInfo = record
    id: Integer;
    phoneNo: string;
    text: string;
  end;

  TSMSSentEvent = procedure (Sender: TObject; AId: Integer; AIsError: Boolean; AResult: string) of object;

  TSMSSender = class(TThread)
    private
      FSMSList: TThreadList<TSMSInfo>;
      FSentCount: Integer;
      function GetQueueCount: Integer;
    protected
      procedure Execute; override;
    public
      OnSMSSent: TSMSSentEvent;
      procedure AddSMS(const ASMSInfo: TSMSInfo);
      constructor Create(CreateSuspended: Boolean = False);
      destructor Destroy; override;
      property QueueCount: Integer read GetQueueCount;
      property SentCount: Integer read FSentCount;
  end;

implementation

{$IFDEF FAKESMS}
{ TSMS }

procedure TSMS.Connect;
begin
end;

constructor TSMS.Create(AObj: TObject);
begin
end;

function TSMS.IsError(a: Boolean; b: string): Boolean;
begin
  Result := False;
end;

function TSMS.SendSMS(phoneNo, text: string; bBool: Boolean): string;
begin
  Result := 'message sent';
  Sleep(300);//simulates the SMS sent
end;
{$ENDIF}

{ TReceiveThread }

constructor TSMSSender.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FSentCount := 0;
  FSMSList := TThreadList<TSMSInfo>.Create;
end;

destructor TSMSSender.Destroy;
begin
  FSMSList.Free;
  inherited;
end;

function TSMSSender.GetQueueCount: Integer;
begin
  Result := FSMSList.LockList.Count;
  FSMSList.UnlockList;
end;

procedure TSMSSender.AddSMS(const ASMSInfo: TSMSInfo);
begin
  FSMSList.Add(ASMSInfo);
end;

procedure TSMSSender.Execute;
var
  objSMS1: TSMS;
  SMSInfo: TSMSInfo;
  strSendResult: string;
  lst: TList<TSMSInfo>;
begin
  CoInitialize(nil);
  try

    objSMS1 := TSMS.Create(nil);
    try
      if objSMS1.IsError(True, StrMyAppName) then
        raise Exception.Create('Error Message 1');
      objSMS1.Connect;
      if objSMS1.IsError(True, StrMyAppName) then
        raise Exception.Create('Error Message 2');

      objSMS1.Validity := '24H';

      while not Terminated do begin

        while GetQueueCount > 0 do begin

          lst := FSMSList.LockList;
          try
            SMSInfo := lst.First;
            lst.Delete(0);
          finally
            FSMSList.UnlockList;
          end;

          //maybe the following has to be synchronized in order to work properly?
          //Synchronize(procedure
          //    begin
                strSendResult := objSMS1.SendSMS(SMSInfo.phoneNo, SMSInfo.text, False);
          //    end);

          Inc(FSentCount);

          if Assigned(OnSMSSent) then
            Synchronize(procedure
                begin
                  OnSMSSent(Self, SMSInfo.id, objSMS1.IsError(true, StrMyAppName), strSendResult);
                end);

          if Terminated then
            Break;
        end;

        Sleep(1);

      end;

    finally
      objSMS1.Free;
    end;

  finally
    CoUninitialize;
  end;
end;

end.

Unit1.dfm
单元

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 277
  ClientWidth = 527
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    527
    277)
  PixelsPerInch = 96
  TextHeight = 13
  object btnAddSMS: TButton
    Left = 440
    Top = 209
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Add SMS'
    Enabled = False
    TabOrder = 0
    OnClick = btnAddSMSClick
  end
  object Memo1: TMemo
    Left = 8
    Top = 8
    Width = 417
    Height = 257
    Anchors = [akLeft, akTop, akRight, akBottom]
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Lucida Console'
    Font.Style = []
    Lines.Strings = (
      'Memo1')
    ParentFont = False
    ScrollBars = ssVertical
    TabOrder = 1
  end
  object btnTerminate: TButton
    Left = 440
    Top = 240
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Terminate'
    Enabled = False
    TabOrder = 2
    OnClick = btnTerminateClick
  end
  object btnStart: TButton
    Left = 440
    Top = 178
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Start'
    TabOrder = 3
    OnClick = btnStartClick
  end
end

*
为什么要调用CoInitialize？你在线程中使用COM吗？如果是这样，那么您的应用程序在哪里？GUI和用户线程不会混合使用。您正在从GUI控件调用SendSMS（）。SendSMS线程安全吗？UI事件和线程在同一对象上运行-无同步，从线程调用
ShowMessage
，无限循环调用
CoInitialize
。。。而
DoShowData
甚至做了什么？这段代码乱七八糟。扔掉它，先花点时间学习你的工具。
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 277
  ClientWidth = 527
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    527
    277)
  PixelsPerInch = 96
  TextHeight = 13
  object btnAddSMS: TButton
    Left = 440
    Top = 209
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Add SMS'
    Enabled = False
    TabOrder = 0
    OnClick = btnAddSMSClick
  end
  object Memo1: TMemo
    Left = 8
    Top = 8
    Width = 417
    Height = 257
    Anchors = [akLeft, akTop, akRight, akBottom]
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Lucida Console'
    Font.Style = []
    Lines.Strings = (
      'Memo1')
    ParentFont = False
    ScrollBars = ssVertical
    TabOrder = 1
  end
  object btnTerminate: TButton
    Left = 440
    Top = 240
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Terminate'
    Enabled = False
    TabOrder = 2
    OnClick = btnTerminateClick
  end
  object btnStart: TButton
    Left = 440
    Top = 178
    Width = 75
    Height = 25
    Anchors = [akRight, akBottom]
    Caption = 'Start'
    TabOrder = 3
    OnClick = btnStartClick
  end
end