Question

我在代码中使用Thread发送短信。发送短信我使用MCoreComponent类; 首先，覆盖Create函数并创建一个objSMS1对象，然后在objSMS1.connect()函数

中调用Execute

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;

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

但我需要发送消息。我的Send Message功能是：

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

Answer 1

根据这个问题，主要的可见问题是在没有同步块的情况下从线程的方法内部调用MessageDlg但是代码本身还有许多其他问题，并且对你的问题的评论已经指向了你朝着正确的方向前进。

对DoShowData的调用可能是另一个问题，但问题并没有提供更多细节。

另一个奇怪的事情是对CoInitialize的反复拨打电话。即使这不是一个大问题，因为后续调用返回False，调用必须由CoUninitialize平衡。

引用评论：“ SendSMS是否是线程安全的？”你知道。

我试图在您的代码中添加一些订单 - 我希望......

该主题使用TThreadList<TSMSInfo>类型的列表，并将其视为queue来存储并获取要发送的SMS：通过其Locklist方法访问该列表为了避免并发访问。
SMS发送通知实现为类型TSMSSentEvent的自定义通知事件：如果已分配，则事件在synchronized block之间触发，以便在主线程中执行（ GUI应用程序中的VCL线程。
Sleep(1)会在队列为空时减少CPU费用* - 从我的PC上的50%到2%。

谨防objSMS1对象的创建及其处置，因为我所说的可能不是正确的地方;也许你每次发送队列时都需要调用objSMS1.Connect并objSMS1.Disconnect - 这个方法应该可用 - 就在那之后，你应该知道它。

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

SMSSender.pas unit：线程类和朋友

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.pas 单位：表格单位

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.UITypes,
  SMSSender;

    type
      TForm1 = class(TForm)
        btnAddSMS: TButton;
        Memo1: TMemo;
        btnTerminate: TButton;
        btnStart: TButton;
        procedure btnAddSMSClick(Sender: TObject);
        procedure btnTerminateClick(Sender: TObject);
        procedure btnStartClick(Sender: TObject);
      private
        { Private declarations }
        FReceiver: TSMSSender;
        procedure ReceiverSMSSent(Sender: TObject; AId: Integer; AIsError: Boolean; AResult: string);
        procedure ReceiverTerminate(Sender: TObject);
      public
        { Public declarations }
      end;

var
  Form1: TForm1;

implementation

uses
  System.Math;

{$R *.dfm}

    procedure TForm1.btnAddSMSClick(Sender: TObject);
    var
      sms: TSMSInfo;
    begin
      with sms do begin
        id := Random(65535);
        phoneNo := '+39' + IntToStr(RandomRange(111111111, 999999999));
        text := 'You won nothing at all, as usual';
      end;
      FReceiver.AddSMS(sms);
    end;

    procedure TForm1.btnStartClick(Sender: TObject);
    begin
      Memo1.Lines.Clear;

      FReceiver := TSMSSender.Create(True);
      FReceiver.FreeOnTerminate := True;
      FReceiver.OnSMSSent := ReceiverSMSSent;
      FReceiver.OnTerminate := ReceiverTerminate;
      FReceiver.Start;

      btnStart.Enabled := False;
      btnAddSMS.Enabled := True;
      btnTerminate.Enabled := True;
    end;

    procedure TForm1.btnTerminateClick(Sender: TObject);
    begin
      FReceiver.Terminate;
    end;

    procedure TForm1.ReceiverSMSSent(Sender: TObject; AId: Integer; AIsError: Boolean;
      AResult: string);
    begin
      Memo1.Lines.Add(Format('id = %d'#9'isError = %s'#9'result = %s', [AId, BoolToStr(AIsError), AResult]));
    end;

    procedure TForm1.ReceiverTerminate(Sender: TObject);
    var
      receiver: TSMSSender;
      ex: Exception;
    begin
      btnStart.Enabled := True;
      btnAddSMS.Enabled := False;
      btnTerminate.Enabled := False;

      receiver := TSMSSender(Sender);
      ex := Exception(receiver.FatalException);
      if Assigned(ex) then begin
        MessageDlg(ex.Message, mtError, [mbOK], 0);
        Exit;
      end;

      MessageDlg(Format('Thread %d has finished, %d SMS sent, queue count is %d.', [receiver.ThreadID, receiver.SentCount, receiver.QueueCount]), mtInformation, [mbOK], 0);
    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

* _{Why Sleep(1) is better than Sleep(0)}

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

1 个答案: