多线程中,Terminate掉线程时,出现内存读取错误
源代码:
unit DrawShipTrack;
interface
uses
Classes,MapXLib_TLB,Variants,Activex,MapCommfunc,SysUtils,Dialogs, ShowTrack;
type
pTrackInfo=^TTrackInfo;
TTrackInfo=Record
TerminalNo: string;
ShipName: string;
Speed: Double;
Direct: Double;
MapX: Double;
Mapy: Double;
sDateTime: String;
end;
TDrawShipTrack = class(TThread)
private
{ Private declarations }
fArrayTrackInfo: Array of pTrackInfo;
fMap: TMap;
fArrayCount: integer;
CurrentList: integer;
m_PolygonID: integer;
m_PointID: integer;
destructor Destroy;
protected
procedure Execute; override;
procedure WriteLog(msg: string);
public
fCommand: String;
procedure setMainForm;
constructor Create(Map: TMap; Command: string; ArrayTrackInfo: pointer; ArrayCount: integer);
procedure DrawLine(TerminalNo: String; ShipName: String; Speed: Double; Direct: Double; Lang: Double; Lat: Double; sDateTime: string);
procedure DelPoint(TerminalNo: String; ShipName: String; Speed: Double; Direct: Double; Lang: Double; Lat: Double; sDateTime: string);
end;
implementation
uses Main;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TDrawShipTrack.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread ';
end; }
{ TDrawShipTrack }
constructor TDrawShipTrack.Create(Map: TMap; Command: string; ArrayTrackInfo:pointer; ArrayCount: integer) ;
begin
fCommand:=Command;
fMap:=Map;
fArrayCount:=ArrayCount;
SetLength(fArrayTrackInfo,fArrayCount);
fArrayTrackInfo:=ArrayTrackInfo;
inherited Create(False);
end;
procedure TDrawShipTrack.Execute;
var
i: integer;
TerminalNo: String;
ShipName: string;
Speed: Double;
Direct: Double;
Lang: Double;
Lat: Double;
sDateTime: String;
begin
{ Place thread code here }
FreeOnTerminate:=True;
CurrentList:=0;
while not Terminated do
begin
try
if fCommand= 'PLAY ' then
begin
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DrawLine(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
CurrentList:=CurrentList + 1;
Synchronize(setMainForm);
end;
if fCommand= 'GO ' then
begin
if CurrentList <fArrayCount then
begin
CurrentList:=CurrentList + 1;
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DrawLine(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
Synchronize(setMainForm);
Suspend;
end;
end;
if fCommand= 'BACK ' then
begin
if CurrentList> 1 then
begin
CurrentList:=CurrentList - 1;
TerminalNo:=fArrayTrackInfo[CurrentList]^.TerminalNo ;
ShipName:=fArrayTrackInfo[CurrentList]^.ShipName ;
Speed:=fArrayTrackInfo[CurrentList]^.Speed;
Direct:=fArrayTrackInfo[CurrentList]^.Direct;
Lang:=fArrayTrackInfo[CurrentList]^.MapX;
Lat:=fArrayTrackInfo[CurrentList]^.Mapy;
sDateTime:=fArrayTrackInfo[CurrentList]^.sDateTime;
DelPoint(TerminalNo,ShipName,Speed,Direct,Lang,Lat,sDateTime);
Synchronize(setMainForm);
Suspend;
end;
end;
sleep(1000);
if CurrentList=fArrayCount then
begin
Synchronize(setMainForm);
Terminate;
end;
if Terminated then exit;
except on e:exception do
writelog( 'Excute 中错误 ' + e.Message);
//showmessage( '程序运行时发生错误: ' + e.Message);
end;
end;
end;
procedure TDrawShipTrack.setMainForm ;
begin
frmMain.TrackBar.Position:=trunc((CurrentList*10/fArrayCount) + 0.5);
if CurrentList=fArrayCount then
begin
frmMain.btnPlay.Enabled :=True;
frmMain.btnPause.Enabled :=False;
frmMain.btnContiue.Enabled :=False;
frmMain.btnGO.Enabled :=False;
frmMain.btnBack.Enabled :=False;
frmMain.btnStop.Enabled :=False;
end;
frmMain.ShipTrackList.Items[CurrentList-1].Selected :=True;
frmMain.ShipTrackList.Items[CurrentList-1].MakeVisible(True);
end;
procedure TDrawShipTrack.DrawLine(TerminalNo: String; ShipName: String; Speed: Double; Direct: Double; Lang: Double; Lat: Double; sDateTime: string);
var
m_points: CMapxPoints;
m_Point: CMapxPoint;
m_Polygon: Variant;
m_Layer: CMapxLayer;
m_PointStyle: CMapxStyle;
m_LineStyle: CMapxStyle;
m_NewSymbol: Variant;
m_NewLine: Variant;
m_LineFeature: Variant;
m_PointFeature: Variant;
unusedVt: OleVariant;
begin
try
....
except on e:exception do
writelog( 'DrawLine 中错误 ' + e.Message);
//showmessage( '程序运行时发生错误: ' + e.Message );
end;
end;
procedure TDrawShipTrack.DelPoint(TerminalNo: String; ShipName: String; Speed: Double; Direct: Double; Lang: Double; Lat: Double; sDateTime: string);
var
m_pointFeature: Variant;
m_LineFeature: Variant;
m_LineStyle: CMapxStyle;
begin
try
......
except on e:exception do
writelog( 'DelPoint 中错误 ' + e.Message);
//showmessage( '程序运行时发生错误: ' + e.Message);
end;
end;
destructor TDrawShipTrack.Destroy;
begin
try
CoUninitialize();
fMap:=nil;
fArrayTrackInfo:=nil;
inherited destroy;
except on e:exception do
writelog( 'Destroy 中错误 ' + e.Message);
end;
end;
procedure TDrawShipTrack.WriteLog(msg: string);
var
sFile: textFile;
begin
Assignfile(sfile, 'login.txt ');
Append(sFile);
writeln(sfile,msg);
closefile(sFile);
end;
end.
此线程执行完成后,主程序退出时,发生内存读取错误.如果主程序不启动此线程,则退出主程序时不会发生内存读取错误.
麻烦各位高手帮我看看,出出主意.
[解决办法]
线程还没有释放的吧
[解决办法]
应该是frmMain已经释放，但线程还没退出，访问frmMain时内存出错。
在Terminate线程后，防止再访问frmMain，直到完全退出线程的Execute
[解决办法]
代码太长了，跟踪一下找到具体是哪里出现的av，估计可能是CoUninitialize()这里有问题，couninitialize与coinitialize是成对出现的，这些东西一般都由TApplication自动维护的，你这里显式调用couninitialize可能在程序退出时发生av，应为TApplication的析构过程还会调用couninitialize
[解决办法]
内存没释放干净，退出时候用下面这段代码就不回报错了
var
Wnd: HWND;
begin
Wnd := OpenProcess(PROCESS_ALL_ACCESS, true, GetCurrentProcessId);
TerminateProcess(Wnd, 0);
end;
