10-08-2020, Saat: 15:28
Merhaba ustalarım. Port kapatma sorununu bir türlü çözüme kavuşturamadım. Closehandle ile kapatıyorum gene bazen asılı kalıyor. Purgecomm yapıyorum gene olmuyor. Cihaz bazen zamansız bağlantı koparıyor yada cihaz tarafından port kapatılıyor close handle yaptığım halde genede port kapanmıyor tekrar open yapıyorum açılmıyor. Çözümünü bir türlü bulamadım. Öneriniz nedir nerede hata yapıyorum yardımcı olursanız çok sevinirim.
Port açarken şu şekilde açıyorum.
Port okurken şu şekilde.
Port yazarken şu şekilde.
Kapatırkende şu şekilde kapatıyorum.
Port açarken şu şekilde açıyorum.
function TComport.Open(DevicePath: String): Boolean; var Task: ITask; begin Result := FALSE; Task := TTASK.Create( procedure var I: Integer; aSuccess: Boolean; begin I := 0; repeat if MainForm.Durdur then exit; Inc(i); if Pos(UpperCase('com'), UpperCase(DevicePath)) > 0 then DevicePath := '\\.\' + DevicePath; UsbHandle := CreateFile(PChar(DevicePath), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); aSuccess := (UsbHandle <> INVALID_HANDLE_VALUE); if not aSuccess then Sleep(i * 100); until aSuccess or (i >= 60); end); Task.Start(); while Task.STATUS <> TTASKSTATUS.COMPLETED do begin if MainForm.Durdur then exit; IF(Task.STATUS = TTASKSTATUS.EXCEPTION) THEN exit; Sleep(10); Application.ProcessMessages; end; Result := UsbHandle <> INVALID_HANDLE_VALUE; end;
Port okurken şu şekilde.
function TComport.Read(var Buffer; Count: Integer; Const TimeOut: Integer = 10): Integer; var lOverlapped: OVERLAPPED; lLastError, BytesTrans: Cardinal; lEvent: TEvent; Task: ITask; TmpBuf: array of Byte; CanWrite: Boolean; begin if UsbHandle = INVALID_HANDLE_VALUE then exit(-1); SetLength(TmpBuf, Count); lEvent := TEvent.Create(nil, True, FALSE, ''); try FillChar(lOverlapped, SizeOf(lOverlapped), 0); lOverlapped.hEvent := lEvent.Handle; CanWrite := ReadFile(UsbHandle, TmpBuf[0], Count, BytesTrans, @lOverlapped); Task := TTASK.Create( procedure begin if CanWrite then exit(); lLastError := GetLastError; if (lLastError <> ERROR_IO_PENDING) and (lLastError <> ERROR_SUCCESS) then exit; case lEvent.WaitFor(TimeOut) of wrSignaled: if not GetOverlappedResult(UsbHandle, lOverlapped, BytesTrans, FALSE) then exit; wrError: begin lLastError := lEvent.LastError; if CancelIo(UsbHandle) then lEvent.WaitFor(TimeOut); exit; end; end; CanWrite := True; end); Task.Start(); while Task.STATUS <> TTASKSTATUS.COMPLETED do begin if MainForm.Durdur then begin CancelIo(UsbHandle); CancelIoEx(UsbHandle, @lOverlapped); exit; end; IF(Task.STATUS = TTASKSTATUS.EXCEPTION) THEN exit(-1); Sleep(10); Application.ProcessMessages; end; if not CanWrite then exit(-1); Result := BytesTrans; SetLength(TmpBuf, BytesTrans); MoveMemory(@Buffer, @TmpBuf[0], Length(TmpBuf)); finally FreeAndNil(lEvent); end; end;
Port yazarken şu şekilde.
function TComport.Write(var Buffer; Count: Integer; Const TimeOut: Integer = 10): Integer; var lOverlapped: OVERLAPPED; lLastError, BytesTrans: Cardinal; lEvent: TEvent; Task: ITask; TmpBuf: array of Byte; CanWrite: Boolean; begin if UsbHandle = INVALID_HANDLE_VALUE then exit(-1); SetLength(TmpBuf, Count); MoveMemory(@TmpBuf[0], @Buffer, Length(TmpBuf)); lEvent := TEvent.Create(nil, True, FALSE, ''); try Task := TTASK.Create( procedure begin FillChar(lOverlapped, SizeOf(lOverlapped), 0); lOverlapped.hEvent := lEvent.Handle; CanWrite := WriteFile(UsbHandle, TmpBuf[0], Count, BytesTrans, @lOverlapped); if CanWrite then exit(); lLastError := GetLastError; if (lLastError <> ERROR_IO_PENDING) and (lLastError <> ERROR_SUCCESS) then exit; case lEvent.WaitFor(TimeOut) of wrSignaled: if not GetOverlappedResult(UsbHandle, lOverlapped, BytesTrans, FALSE) then exit; wrError: begin lLastError := lEvent.LastError; if CancelIo(UsbHandle) then lEvent.WaitFor(TimeOut); exit; end; end; CanWrite := True; end); Task.Start(); while Task.STATUS <> TTASKSTATUS.COMPLETED do begin if MainForm.Durdur then begin CancelIo(UsbHandle); CancelIoEx(UsbHandle, @lOverlapped); exit; end; IF(Task.STATUS = TTASKSTATUS.EXCEPTION) THEN exit(-1); Sleep(10); Application.ProcessMessages; end; if not CanWrite then exit(-1); Result := BytesTrans; finally FreeAndNil(lEvent); end; end;
Kapatırkende şu şekilde kapatıyorum.
function TComport.Close(): Boolean; var Task: ITask; begin Result := FALSE; if UsbHandle <> INVALID_HANDLE_VALUE then begin PurgeComm(UsbHandle, PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR); if CloseHandle(UsbHandle) then UsbHandle := INVALID_HANDLE_VALUE; end; Result := UsbHandle = INVALID_HANDLE_VALUE; end;