求救:请高手帮帮忙看看代码,万分感激(200分)

W

wjhql

Unregistered / Unconfirmed
GUEST, unregistred user!
下面是一个完整的pas文件,该程序运行于服务器,服务器连有一个Modem,调用组件不
停的扫描Modem,若接收到短消息则将这条短消息回复原号码,同时不断侦听客户端是否
有数据传递,若有,则将数据拆分成手机号码和短消息内容,调用这个Modem发送出去。
由于Modem同一时间只能用来做一件事,因此,在客户端有数据传来的时候需要让扫描
Modem的线程先挂起,等发送完毕再重新启动。但下面的程序在运行时,过一段时间会自
动关闭,不知道是否是线程写的有问题,导致程序不能稳定运行,但操作系统仍正常,
也不报任何错误,麻烦各位好心的高手帮忙看看,下面的程序是否的确存在隐患可能导
致这种情况发生,谢谢。
unit Thread;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, OleServer, SMSCOMLib_TLB, Db, ADODB, ScktComp;
type
TForm1 = class(TForm)
Button1: TButton;
MySMSManage1: TSMSManage;
Button2: TButton;
ServerSocket1: TServerSocket;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button2Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

TMyThread=class(TThread)
count: integer;
mysmsmanage: tsmsmanage;

procedure DealMsg;virtual;abstract;
constructor create
(mysmsmanage1:tsmsmanage;ADOTblInfo1,ADOTblMark1,ADOTblOperation1,
end;

TMyThread1=class(TMyThread)
procedure DealMsg;override;
procedure execute;override;
end;

var
Form1: TForm1;
MyThread1: TMyThread1;
sendstr1: String;
index1: integer;
Succeed1: Boolean;
com1busy: boolean;
CellNumber1: String;
Content1: String;
ClientMessage: String;
ClientNumber,ClientMsg: String;
AutoFlag: integer; //标志是否客户端是否有消息传来
implementation
{$R *.DFM}
constructor tmythread.create(mysmsmanage1:tsmsmanage);
begin
inherited create(false);
mysmsmanage:=mysmsmanage1;

freeonterminate:=true;
end;

procedure tmythread1.DealMsg;
var
addnew, illegal, recordtype:integer;
RecordDesc,MarkDesc: string;
MarkCode: integer;
modelstr: String;
times: integer;
mysms:isms;
begin

try
mysms:=mysmsmanage.SMSGet(index1);
except
mysmsmanage.Initialize ('COM1');
end;

CellNumber1:=mysms.CellNumber;
Content1:=mysms.Content;

times:=0;
repeat
try
sleep(5000);
{调用组件,将接收到的消息回复原手机号码;若发送失败,
组件会抛出异常,用try捕获异常并继续调用,连续5次,
若最终仍然失败则放弃,这里应该不会有问题}
mysmsmanage.SMSSend (CellNumber1,Content1);
Succeed1:=true;
except
Succeed1:=false;
times:=times+1;
sleep(5000);

{每次发送失败之后重新初始化组件}
mysmsmanage.Initialize ('COM1');
end;
until Succeed1 or (times>5);
end;

procedure tmythread1.execute;
var
count,i: integer;
begin
while 1=1do
//不断扫描端口看是否有短消息接收
begin
if AutoFlag=0 then
//表明没有收到客户端的数据
begin
try
count := 0;
repeat
Sleep( 500 );
count := mysmsmanage.QueryReceivedSMSCount ; //获取短消息
条数
until count >= 1;
if count<>0 then
begin
for i:=0 to count-1do
//逐条回复短消息
begin
index1:=i;
Synchronize(DealMsg);
end;
end;
finally
sleep(1000);
end;
end
else
begin
sleep(100);
end;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
AutoFlag:=0;
mysmsmanage1.Initialize ('COM1'); //初始化组件
MyThread1:=tmythread1.create (mysmsmanage1);
//创建线程
mythread1.Resume; //开始线程
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientMessage:='';
end;

procedure TForm1.ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
temp: String;
Succeed: Boolean;
times: integer;
begin
AutoFlag:=1; //接收到客户端传来的数据
ClientMessage:=socket.ReceiveText;
//分解客户端传来的数据,得到手机号码和要发送的短消息内容
ClientNumber:=copy(ClientMessage,1,11); //手机号码
ClientMsg:=copy(ClientMessage,12,length(ClientMessage)-11); //短消息内容
begin
times:=0;
Succeed:=False;
repeat
try
sleep(5000);
MySMSManage1.SMSSend (ClientNumber,ClientMsg); //发送短消息
,直至成功或完成6次
Succeed:=True;
except
times:=times+1;
Succeed:=False;
sleep(10000);
MySMSManage1.Initialize('COM1');
end;
until Succeed or (times>5);
AutoFlag:=0; //发送完毕后置AutoFlag为0,以便上面线程继续运行
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ADOQuryOperation1.Close;
ADOQuryScoreAward1.Close ;
if mythread1<>nil then
begin
mythread1.Terminate;
mythread1.FreeInstance;
mythread1:=nil;
end;

mysmsmanage1.Destroy;
mysmsmanage1:=nil;
serversocket1.Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
serversocket1.Active:=true; //开始侦听客户端消息
end;

end.
 
呵呵,友人在重复我N年前的操作手机短信,给你一点建议:
1、线程是否已经退出。
2、可使用线程的OnTerminate事件重新Create线程。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
928
import
I
顶部