BorlandTalk.com

some one · Guest

Hi there,

is there anyone who could help me? I wrote a serialport component and it
works fine. Except that it increases Non-paged pool memory until the
software crashes! I know that it is the receiver thrad that increase the
memory usage, about 1k / sec.

Here is te receiver thread:
unit Receiver;

interface

uses
Classes, Com_types, Windows, Sysutils, Dialogs;

type
TReceiverThread = class(TThread)
private
{ Private declarations }
FComHandle : THandle;
FCloseEvent : THandle;
FMsg : String;
FIncomingData : pDataBuffer;
FOverLappedRead : TOverlapped;
FDataLength : Cardinal;
FOnDataAvailable : TOnDataAvailable;
FOnMsg : TOnComMsg;
procedure DoDataAvailable;
procedure DoMsg;
public
property ComHandle : THandle read FComHandle write FComHandle;
property CloseEvent : THandle read FCloseEvent write FCloseEvent;
property IncomingData : pDataBuffer read FIncomingData write
FIncomingData;
property OnMsg : TOnComMsg read FOnMsg write FOnMsg;
property OnDataAvailable : TOnDataAvailable read FOnDataAvailable write
FOnDataAvailable;
protected
procedure Execute; override;
end;

implementation

procedure TReceiverThread.Execute;
var ObjectsToWait : array [0..1] of THandle;
can_exit : Boolean;
hSignaled,
errcode : Word;

begin
FreeOnTerminate := TRUE;
can_exit := FALSE;
try
FillChar(FOverlappedRead,SizeOf(TOverLapped),0);
FOverlappedRead.hEvent := CreateEvent(nil,TRUE,FALSE,nil);
ObjectsToWait[0] := FCloseEvent;
ObjectsToWait[1] := FOverlappedRead.hEvent;
GetMem(FIncomingData,512);
repeat
FillMemory(FIncomingData,512,0);
ReadFile(FComHandle,FIncomingData^,512, FDataLength,
@FOverlappedRead);
hSignaled := WaitForMultipleObjects(2,@ObjectsToWait,FALSE,1000);
case hSignaled of
WAIT_OBJECT_0 : begin
can_exit := TRUE;
end;
WAIT_OBJECT_0+1 : begin
if
GetOverlappedresult(FComHandle,FOverlappedRead,FDatalength,False) then
begin
Synchronize(DoDataAvailable);
end
else
begin
errcode := GetLastError;
FMsg := 'GetOverlappedResult error in
readthread. Error code='+IntToStr(errcode);
Synchronize (DoMsg);
end;
ResetEvent(FOverlappedRead.hEvent);
end;
WAIT_TIMEOUT : begin
//FMsg := 'Read timeout ';
//Synchronize (DoMsg);
end;
end;
if Terminated then
can_exit := TRUE;

until can_exit;
CloseHandle(FOverlappedRead.hEvent);
Freemem(FIncomingData,512);
except
FMsg := 'Fatal error in readthread!';
Synchronize (DoMsg);
end;
end;

procedure TReceiverThread.DoDataAvailable;
var i : Integer;
s : String;
begin
for i := 0 to FDataLength - 1 do
begin
s := s + ' '+Chr(FIncomingData^[i])+'='+ IntToHex
(FIncomingData^[i],2)
end;
if Assigned(FOnDataAvailable) then
FOnDataAvailable(self, FDataLength, FIncomingData);
end;

procedure TReceiverThread.DoMsg;
begin
if Assigned(FOnMsg) then
FOnMsg(self, FMsg);
end;
end.

*************************************************************
Here is a monitor thread
*************************************************************
unit Monitor;

interface

uses
Classes,Com_types, Windows, Sysutils;

type
TMonitorThread = class(TThread)
private
{ Private declarations }
FComHandle : THandle;
FCloseEvent : THandle;
FOverLapped : TOverlapped;
FOnError : TNotifyEvent;
FOnBreak : TNotifyEvent;
FOnRing : TNotifyEvent;
FOnTXEmpty : TNotifyEvent;
FOnCTSChange : TNotifyEvent;
FOnDSRChange : TNotifyEvent;
FOnCDChange : TNotifyEvent;
protected
procedure Execute; override;
procedure DoBreak;
procedure DoError;
procedure DoRing;
procedure DoTXEmpty;
procedure DoCTSChange;
procedure DoDSRChange;
procedure DoCDChange;
public
property ComHandle : THandle read FComHandle write FComHandle;
property CloseEvent : THandle read FCloseEvent write FCloseEvent;
property OnError : TNotifyEvent read FOnError write FOnError;
property OnBreak : TNotifyEvent read FOnBreak write FOnBreak;
property OnRing : TNotifyEvent read FOnRing write FOnRing;
property OnTXEmpty : TNotifyEvent read FOnTXEmpty write FOnTXEmpty;
property OnCTSChange : TNotifyEvent read FOnCTSChange write
FOnCTSChange;
property OnDSRChange : TNotifyEvent read FOnDSRChange write
FOnDSRChange;
property OnCDChange : TNotifyEvent read FOnCDChange write FOnCDChange;
end;

implementation

procedure TMonitorThread.Execute;
var ObjectsToWait : array [0..1] of THandle;
can_exit : Boolean;
lpEvtMask : Cardinal;
hSignaled : Word;

begin
FreeOnTerminate := TRUE;
can_exit := FALSE;
try
FillChar(FOverlapped,SizeOf(TOverLapped),0);
FOverlapped.hEvent := CreateEvent(nil,TRUE,FALSE,nil);
ObjectsToWait[0] := FCloseEvent;
ObjectsToWait[1] := FOverlapped.hEvent;
SetCommMask(FComHandle,EV_BREAK or EV_CTS or EV_DSR or EV_ERR or
EV_RING or EV_RLSD or EV_TXEMPTY);
repeat
WaitCommEvent(FComHandle,lpEvtMask,@FOverlapped);
hSignaled := WaitForMultipleObjects(2,@ObjectsToWait,FALSE,10);
case hSignaled of
WAIT_OBJECT_0 : begin
can_exit := TRUE;
end;
WAIT_OBJECT_0+1 : begin
if
GetOverlappedresult(FComHandle,FOverlapped,lpEvtMask,False) then
begin
if (EV_ERR and lpEvtMask) > 0 then
Synchronize(DoError);
if (EV_BREAK and lpEvtMask) > 0 then
Synchronize(DoBreak);
if (EV_CTS and lpEvtMask) > 0 then
Synchronize(DoCTSChange);
if (EV_DSR and lpEvtMask) > 0 then
Synchronize(DoDSRChange);
if (EV_RLSD and lpEvtMask) > 0 then
Synchronize(DoCDChange);
if (EV_RING and lpEvtMask) > 0 then
Synchronize(DoRing);
if (EV_TXEMPTY and lpEvtMask) > 0 then
Synchronize(DoTXEmpty);
end;
ResetEvent(FOverlapped.hEvent);
end;
WAIT_TIMEOUT : begin
end;
end;
if Terminated then
can_exit := TRUE;
until can_exit;
finally
CloseHandle(FOverlapped.hEvent);
end;
end;

*************************************************************
And this is how I open the port
*************************************************************
function TComPort.Open : Boolean;
var PortName : String;
lpCommTimeOuts : TCommTimeOuts;
DCB : TDCB;
begin
try
result := FALSE;
if (FComPort > 0) and not FPortOpen then
begin
GetMem(FIncomingData,FRXBufSize);
FillMemory(FIncomingdata,FRXBufSize,0);
FCloseEvent := CreateEvent(nil,TRUE,FALSE,nil);
PortName := 'COM'+IntToStr(FComPort);
FComHandle := CreateFile(PChar(PortName), // address of name of the
file
GENERIC_READ or GENERIC_WRITE, // access
(read-write) mode
0, // share mode
nil, // address of security
descriptor
OPEN_EXISTING, // how to create
FILE_FLAG_OVERLAPPED, // file attributes
0); // handle of file with
attributes to copy

if FComHandle <> INVALID_HANDLE_VALUE then
begin
FPortOpen := TRUE;
SetupComm(FComHandle,FRXBufSize,FTXBufSize);
PurgeComm(FComHandle,PURGE_TXCLEAR+PURGE_RXCLEAR);
GetCommTimeOuts(FComHandle,lpCommTimeOuts);
with lpCommTimeouts do
begin
ReadIntervalTimeout := 20;
ReadTotalTimeoutMultiplier := 0;
ReadTotalTimeoutConstant := 0;
WriteTotalTimeoutMultiplier := 0;
WriteTotalTimeoutConstant := 0;
end;
SetCommTimeOuts(FComHandle,lpCommTimeouts);
SetDataBits(FDataBits);
SetBaudRate(FBaudrate);
SetParityBits(FParityBits);
SetStopBits(FStopBits);
SetHandShakeMode(FHandShakeMode);
GetCommState(FComHandle,DCB);
DCB.Flags := FDCBFlags;
DCB.XOffChar := #19;
DCB.XOnChar := #17;
DCB.XOffLim := Round(80*FRXBufSize/100);
DCB.XOnLim := Round(10*FRXBufSize/100);
SetCommState(FComHandle,DCB);
StartMonitorThread;
StartReceiverThread;
FDTR := TRUE;
result := TRUE;
end;
end;
except
DoMsg(self,'Open CRASH!');
end;
end;

Michael Brown · Guest

some one wrote:

ryryryryr · Guest

Michael,

THANK YOU!!!!

Hmmm... seems that you are in New Zealand. I've have had a dream for a long
time that I could visit there someday. The bad thing is that you are just at
the opposite side of this planet...

Anyway, thank you so much!!!!

"Michael Brown" <see (AT) signature (DOT) below> wrote

AlanGLLoyd · Guest

In article <41e85b1b$1 (AT) clarion (DOT) carno.net.au>, "Michael Brown"
<see (AT) signature (DOT) below> writes:

Martin Harvey (Demon acco · Guest

On Thu, 13 Jan 2005 16:43:14 GMT, "some one" <a@b.c> wrote: