Delphi串列埠通訊的監聽

inte***ce

uses

windows, messages, sysutils, classes, graphics, controls, forms, dialogs,

stdctrls, comctrls,geoutils,geogps;

const maxblock = 160;

type

tcomm = record

idcomdev : thandle;

fconnected : boolean;

end;

tcommform = class(tform)

combobox1: tcombobox;

button1: tbutton;

statusbar1: tstatusbar;

button2: tbutton;

combobox2: tcombobox;

procedure button1click(sender: tobject);

procedure button2click(sender: tobject);

procedure formclose(sender: tobject; var action: tcloseaction);

private

public

end;

tcommthread = class(tthread)

protected

procedure execute;override;

public

constructor create;

end;

var

commform: tcommform;

commhandle : thandle;

connected : boolean;

commthread : tcommthread;

implementation

uses

frmmain,frmmdimapview;

procedure tcommthread.execute;

var

dwerrorflags,dwlength : dword;

comstat : pcomstat;

freadstat : boolean;

inchar : char;

abin : string;

begin

while connected do begin

getmem(comstat,sizeof(tcomstat));

clearcommerror(commhandle, dwerrorflags, comstat);

if (dwerrorflags > 0) then begin

purgecomm(commhandle,(purge_rxabort and purge_rxclear));

// return 0;

end;

dwlength := comstat.cbinque;

if (dwlength>0) then begin

freadstat := readfile(commhandle, inchar, 1,dwlength, nil);

if (freadstat) then begin

if (inchar <> chr(13)) and (length(abin) < maxblock+5 ) then abin := abin + inchar

else begin

...

end;//if (freadstat>0)

end;

constructor tcommthread.create;

begin

freeonterminate := true;

inherited create(false); file://createsuspended = false

end;

// procedure tcommform.button1click(sender: tobject);

var

commtimeout : tcommtimeouts;

dcb : tdcb;

fretval : boolean;

begin

commhandle := createfile(pchar(combobox1.text),generic_read,0,nil,open_existing,file_attribute_normal

, 0);

if commhandle = invalid_handle_value then begin

exit;

end;

commtimeout.readintervaltimeout := maxdword;

commtimeout.readtotaltimeoutmultiplier := 0;

commtimeout.readtotaltimeoutconstant := 0;

setcommtimeouts(commhandle, commtimeout);

getcommstate(commhandle,dcb);

dcb.baudrate := 9600;

dcb.bytesize := 8;

dcb.parity := noparity;

dcb.stopbits := onestopbit;

fretval := setcommstate(commhandle, dcb);

if (fretval) then begin

connected := true;

try

commthread := tcommthread.create;

except

connected := false;

closehandle(commhandle);

fretval := false;

exit;

end;

end

else begin

connected := false;

closehandle(commhandle);

end;

end;

procedure tcommform.button2click(sender: tobject);

begin

connected := false;

closehandle(commhandle);

commthread.terminate;

end;

procedure tcommform.formclose(sender: tobject; var action: tcloseaction);

begin

connected := false;

closehandle(commhandle);

end;