Giriş Yap

**seci20** · 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.

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;

**delphiman** · 11-07-2023, Saat: 12:56

(10-08-2020, Saat: 15:28)seci20 Adlı Kullanıcıdan Alıntı: 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.

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;

Oluşan sorunların nedeni, COM portu fonksiyonlarınızın doğru şekilde kapatılmamasından kaynaklanabilir. Aşağıdaki öneriler yardımcı olabilir:

1. PurgeComm() fonksiyonu ile tam olarak kapatmadığınız tüm işlemleri iptal edin.

2. Kom portu açtığınız koddan, uygun şekilde kapattığınızdan emin olun. Örneğin, port açıldığında, UsbHandle değişkenine INVALID_HANDLE_VALUE olarak başlayın; port kapatıldığında ve Handle değişkeni artık geçerli değilken, UsbHandle değişkenine yine INVALID_HANDLE_VALUE atayın.

3. WaitCommEvent() fonksiyonunu kullanarak bekleyen tüm olayları iptal edin.

4. CloseHandle() fonksiyonu ile kapatılması gereken tüm işlemleri sonlandırın.

5. Bir istisna oluştuğunda, her fonksiyon ardından GetLastError() fonksiyonunu çağırarak, hata kodlarını takip edebilirsiniz. Böylece, sorunun kaynağını daha doğru bir şekilde belirleyebilirsiniz.

6. Kom portunda sürekli olarak çalışan bir iş parçacığı (thread) kullanıyorsanız, bu iş parçacığının sonlandırıldığından emin olun. Ayrıca, belirli bir zaman aşımı (timeout) eşliğinde işlemleri sonlandırmak için CancelIo() ve CancelIoEx() fonksiyonlarını kullanabilirsiniz.

7. Com portu iletişiminde hangi parametrelerin kullanıldığına da dikkat edilmelidir. Baudrate, Parity, Data bits, Stop bits parametreleri doğru şekilde ayarlanmalıdır.

Bu önerileri deneyerek sorunu çözebilirsiniz. Ancak, hala sorunla karşılaşıyorsanız, daha ayrıntılı bir hatanın kaynağını belirlemek için loglama yapabilirsiniz. Bu sayede, hangi adımda ve hangi hata koduyla karşılaştığınızı belirleyebilirsiniz.

**enigma** · 11-07-2023, Saat: 19:53

D 10.4 ve sonrasında hazır olarak kullanılabilir bir ComPort Komponenti var. Ben uzun zamandır kullanıyorum. Çok kullanışlı. Tavsiye ederim.
Getit Package Manager'den indirip kurabilirsiniz.

Giriş Yap
Kullanıcı Adı:
Şifreniz:	Şifremi Unuttum?
	Beni Hatırla

Konu ile Alakalı Benzer Konular
Konular		Yazar	Yorumlar	Okunma	Son Yorum
	Button Renk sorunu	CesuR	3	642	21-05-2026, Saat: 04:29 Son Yorum: emailx45
	Win 11 ve Delphi 7 Minimize sorunu.	enigma	7	1.086	11-02-2026, Saat: 10:27 Son Yorum: RAD Coder
	Delphi SLL kullanım sorunu	Bay_Y	12	2.194	22-12-2025, Saat: 18:11 Son Yorum: Bay_Y
	CxGrid Türkçe karakter sorunu	mur93	1	533	12-11-2025, Saat: 09:22 Son Yorum: cinarbil
	Ftp gönderilen dosyada tr karakter sorunu	forumcuali	7	3.822	01-05-2025, Saat: 02:26 Son Yorum: m_ekici