About API read/write COM

Question

About API read/write COM code

Answer 1

function InitCom(comName:string;access:integer):Thandle;
var
dcb:tdcb;
tmpHandle:thandle;
timeouts:commtimeouts;
begin
tmphandle:=0;
timeouts.ReadIntervalTimeout:=maxword;
timeouts.ReadTotalTimeoutMultiplier:=0;
timeouts.ReadTotalTimeoutConstant:=0;
timeouts.WriteTotalTimeoutMultiplier:=50;
timeouts.WriteTotalTimeoutConstant:=1000;
case access of
0:tmpHandle:=createfile(pchar(comName),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL ,0);
//1:tmpHandle:=createfile(pchar(comName),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
//2:tmpHandle:=createfile(pchar(comName),GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);
end;
if tmpHandle=invalid_handle_value then
  begin
  raise exception.Create('Can not OPEN '+comName);
  closehandle(tmphandle);
  exit;
  end
else
    if not getcommstate(tmpHandle,dcb) then
      begin
        raise exception.Create('Can not Get '+comname+' Status');
        closehandle(tmphandle);
        exit;
        end
    else
      begin
        dcb.BaudRate:=9600;
        dcb.ByteSize:=8;
        dcb.StopBits:=twostopbits;
        dcb.Parity:=noparity;
        if not setcommstate(tmphandle,dcb) then
           begin
           raise exception.Create('Can not SET '+comname+' Status');
           closehandle(tmphandle);
           exit;
           end
         else
             if not setupcomm(tmphandle,4096,4096) then
               begin
               raise exception.Create('Can not SET the BUFFER of '+comname);
               closehandle(tmphandle);
               exit;
               end
             else
               if not setcommtimeouts(tmphandle,timeouts) then
                 begin
                 raise exception.Create('Can not SET the TIMEOUT of '+comname);
                 closehandle(tmphandle);
                 exit;
                 end;
      end;
result:=tmphandle;
end;procedure Senddata(comname:string;memo:tmemo);
var
i:integer;
buf:pointer;
n{//,lperror}:longword;
//commstatus:tcomstat;
begin   
n:=0;
for i:=0 to memo.Lines.Count-1 do
  begin
    handle_write:=initcom(comname,0);
    buf:=pointer(memo.lines.strings[i]);
    //clearcommerror(handle_write,lperror,@commstatus);
    writefile(handle_write,buf^,length(memo.lines.strings[i]),n,nil);
    //writethread:=twritethread.create(handle_write,buf,length(memo.lines.strings[i]));
    closehandle(handle_write);
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
memo2.Lines.Clear;
senddata('COM1',memo1);
readthread:=treadthread.create;
end;{ tReadThread }constructor tReadThread.create;
begin
  FreeOnTerminate:=true;
  inherited create(false);
end;procedure tReadThread.execute;
begin
  inherited;
  synchronize(readcom);
end;procedure tReadThread.readcom;
var
buf:array [0..maxword] of char;
commstatus:tcomstat;
n:longword;
dwError:LongWORD ;
messageRec:string;
begin
n:=0;
clearcommerror(handle_read,dwerror,@commstatus);
try
readfile(handle_read,buf,commstatus.cbInQue,n,nil)
except
exit;
end;
messagerec:=copy(buf,1,commstatus.cbInQue);
form1.memo2.Lines.Add(messagerec);
end;