Please help me!我写了一个对串行口写数据的函数,可是一个字符也写不进去,一直在while循环中等待的
(在线等待)
function Write(var OutBuf:Pchar; NumberOfBytesToWrite:DWord):Byte;
var
WriteOverlap:Toverlapped;
WhereToStartWriting,NumberOfBytesWritten:DWord;
begin
if (NumberOfBytesToWrite=0) then
begin
{Output buffer is empty}
result:=6;
exit;
end;
WhereToStartWriting:=0;
NumberOfBytesWritten:=0;
FillChar(WriteOverlap,Sizeof(WriteOverlap),0);
WriteOverlap.hEvent:=CreateEvent(NIL,FALSE,FALSE,NIL);
if WriteOverlap.hEvent=null then
begin
{CreatEvent error}
result:=7;
exit;
end;
SetCommMask(CommHandle,EV_TXEMPTY);
While (NumberOfBytesToWrite>0) do
begin
if not WriteFile(CommHandle,OutBuf [WhereToStartWriting],NumberOfBytesToWrite,NumberOfBytesWritten,@WriteOverlap) then
begin
if (GetLastError=ERROR_IO_PENDING) then
begin
WaitForSingleObject(WriteOverlap.hEvent,INFINITE);
GetOverlappedResult(CommHandle,WriteOverlap,NumberOfBytesWritten,False);
end
else begin
{Write error}
CloseHandle(WriteOverLap.hEvent);
result:=8;
exit;
end;
end
else begin
Dec(NumberOfBytesToWrite,NumberOfBytesWritten);
Inc(WhereToStartWriting,NumberOfBytesWritten);
end;
end;//EndWhile
CloseHandle(WriteOverLap.hEvent);
result:=0;
end;
(在线等待)
function Write(var OutBuf:Pchar; NumberOfBytesToWrite:DWord):Byte;
var
WriteOverlap:Toverlapped;
WhereToStartWriting,NumberOfBytesWritten:DWord;
begin
if (NumberOfBytesToWrite=0) then
begin
{Output buffer is empty}
result:=6;
exit;
end;
WhereToStartWriting:=0;
NumberOfBytesWritten:=0;
FillChar(WriteOverlap,Sizeof(WriteOverlap),0);
WriteOverlap.hEvent:=CreateEvent(NIL,FALSE,FALSE,NIL);
if WriteOverlap.hEvent=null then
begin
{CreatEvent error}
result:=7;
exit;
end;
SetCommMask(CommHandle,EV_TXEMPTY);
While (NumberOfBytesToWrite>0) do
begin
if not WriteFile(CommHandle,OutBuf [WhereToStartWriting],NumberOfBytesToWrite,NumberOfBytesWritten,@WriteOverlap) then
begin
if (GetLastError=ERROR_IO_PENDING) then
begin
WaitForSingleObject(WriteOverlap.hEvent,INFINITE);
GetOverlappedResult(CommHandle,WriteOverlap,NumberOfBytesWritten,False);
end
else begin
{Write error}
CloseHandle(WriteOverLap.hEvent);
result:=8;
exit;
end;
end
else begin
Dec(NumberOfBytesToWrite,NumberOfBytesWritten);
Inc(WhereToStartWriting,NumberOfBytesWritten);
end;
end;//EndWhile
CloseHandle(WriteOverLap.hEvent);
result:=0;
end;
解决方案 »
- 我的Common Controls 莫名其妙的没了 怎么办啊
- webservice全局接口问题
- 请问怎么获取客户端‘我的文档’目录?
- 【版务】关于非技术贴的一些规定:欢迎原创,请不要过多地转贴其它网站的小说!
- 如何判断MDI窗体的某个子窗体是否被create?
- 在多用户模式下,怎么样处理多个用户同时编辑或者处理同一笔记录?
- 用过UNION的朋友看过来,谁能解决类型不匹配的问题?在线等待!解决后马上结帖!
- 问一个关于DBGrid1的问题
- 有人知道报表的制作吗?up也给分。。。。。。。。。。。
- 在delphi中如何用ado连接sybase sqlanywhere 8,不想通过odbc
- 我們的程序要對sql語句分析,得出這個語句要對數據庫進行哪些動,作然後在一個表中保存這些分析結果。請大家給些思路怎樣做會考慮全面點!!!
- 有关选中dbgrid某一行的问题,急!!!!
VAR
hcm:Thandle;
hdcb:TDCB;
num:DWORD;
p:pchar;
i:integer;
s:string;
m_length:integer;
begin
getmem(p,25);
s:=edit2.Text;
m_length:=length(s);
strcopy(p,pchar(s));
hcm := CreateFile('com1',GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,0,0);
if hcm<>0 then
begin
try
zeromemory(@hdcb,sizeof(TDCB));
hdcb.DCBlength := sizeof(TDCB);
hdcb.BaudRate := 19200;
hdcb.ByteSize := 8;
hdcb.Parity := NOParity;
hdcb.StopBits := ONESTOPBIT;
if (SetCommState(hcm,hdcb)) then
begin
FOR I:=0 TO M_LENGTH-1 DO
begin
sleep(1);
WriteFile(hcm,p[I],1,num,nil);
end;
end;
finally
CloseHandle(hcm);
end;
freemem(p,25);
end;
if not WriteFile(CommHandle,OutBuf [WhereToStartWriting],NumberOfBytesToWrite,NumberOfBytesWritten,@WriteOverlap) then
begin
if (GetLastError=ERROR_IO_PENDING) then
begin
WaitForSingleObject(WriteOverlap.hEvent,INFINITE);
GetOverlappedResult(CommHandle,WriteOverlap,NumberOfBytesWritten,False);
end
else begin
{Write error}
CloseHandle(WriteOverLap.hEvent);
result:=8;
exit;
end;
end;
Dec(NumberOfBytesToWrite,NumberOfBytesWritten);
Inc(WhereToStartWriting,NumberOfBytesWritten);