Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 10 декабря!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Работа с последовательными портами


 //{$DEFINE COMM_UNIT}
 
 //Простой пример работы с последовательными портами
 //Код содержит интуитивно понятные комментарии и строки на шведском языке,
 //нецелесообразные для перевода.
 //Compiler maakt Simple_Comm.Dll of Simple_Com.Dcu afhankelijk van 1e Regel
 (COMM_UNIT)
 
 {$IFNDEF COMM_UNIT}
 library Simple_Comm;
 {$ELSE}
 unit Simple_Comm;
 interface
 {$ENDIF}
 
 uses Windows, Messages;
 
 const
   M_BaudRate = 1;
 const
   M_ByteSize = 2;
 const
   M_Parity = 4;
 const
   M_Stopbits = 8;
 
 {$IFNDEF COMM_UNIT}
 {$R Script2.Res} //versie informatie
 {$ENDIF}
 
 {$IFDEF COMM_UNIT}
 function Simple_Comm_Info: PChar; StdCall;
 function
   Simple_Comm_Open(Port: PChar; BaudRate: DWORD; ByteSize, Parity, StopBits:
     Byte; Mas
   k: Integer; WndHandle: HWND; WndCommand: UINT; var Id: Integer): Integer;
     StdCall;
 function Simple_Comm_Close(Id: Integer): Integer; StdCall;
 function
   Simple_Comm_Write(Id: Integer; Buffer: PChar; Count: DWORD): Integer; StdCall;
 function Simple_Comm_PortCount: DWORD; StdCall;
 
 const
   M_None = 0;
 const
   M_All = 15;
 
 implementation
 {$ENDIF}
 
 const
   InfoString = 'Simple_Comm.Dll (c) by E.L. Lagerburg 1997';
 const
   MaxPorts = 5;
 
 const
   bDoRun: array[0..MaxPorts - 1] of boolean
   = (False, False, False, False, False);
 const
   hCommPort: array[0..MaxPorts - 1] of Integer = (0, 0, 0, 0, 0);
 const
   hThread: array[0..MaxPorts - 1] of Integer = (0, 0, 0, 0, 0);
 const
   dwThread: array[0..MaxPorts - 1] of Integer = (0, 0, 0, 0, 0);
 const
   hWndHandle: array[0..MaxPorts - 1] of Hwnd = (0, 0, 0, 0, 0);
 const
   hWndCommand: array[0..MaxPorts - 1] of UINT = (0, 0, 0, 0, 0);
 const
   PortCount: Integer = 0;
 
 function Simple_Comm_Info: PChar; stdcall;
 begin
 
   Result := InfoString;
 end;
 
 //Thread functie voor lezen compoort
 
 function Simple_Comm_Read(Param: Pointer): Longint; stdcall;
 var
   Count: Integer;
 
   id: Integer;
   ReadBuffer: array[0..127] of byte;
 begin
 
   Id := Integer(Param);
   while bDoRun[id] do
   begin
     ReadFile(hCommPort[id], ReadBuffer, 1, Count, nil);
     if (Count > 0) then
     begin
       if ((hWndHandle[id] <> 0) and
         (hWndCommand[id] > WM_USER)) then
 
         SendMessage(hWndHandle[id], hWndCommand[id], Count,
           LPARAM(@ReadBuffer));
 
     end;
   end;
   Result := 0;
 end;
 
 //Export functie voor sluiten compoort
 
 function Simple_Comm_Close(Id: Integer): Integer; stdcall;
 begin
 
   if (ID < 0) or (id > MaxPorts - 1) or (not bDoRun[Id]) then
   begin
     Result := ERROR_INVALID_FUNCTION;
     Exit;
   end;
   bDoRun[Id] := False;
   Dec(PortCount);
   FlushFileBuffers(hCommPort[Id]);
   if not
     PurgeComm(hCommPort[Id], PURGE_TXABORT + PURGE_RXABORT + PURGE_TXCLEAR +
       PURGE_RXCL
     EAR) then
 
   begin
     Result := GetLastError;
     Exit;
   end;
   if WaitForSingleObject(hThread[Id], 10000) = WAIT_TIMEOUT then
     if not TerminateThread(hThread[Id], 1) then
     begin
       Result := GetLastError;
       Exit;
     end;
 
   CloseHandle(hThread[Id]);
   hWndHandle[Id] := 0;
   hWndCommand[Id] := 0;
   if not CloseHandle(hCommPort[Id]) then
   begin
     Result := GetLastError;
     Exit;
   end;
   hCommPort[Id] := 0;
   Result := NO_ERROR;
 end;
 
 procedure Simple_Comm_CloseAll; stdcall;
 var
   Teller: Integer;
 begin
 
   for Teller := 0 to MaxPorts - 1 do
   begin
     if bDoRun[Teller] then
       Simple_Comm_Close(Teller);
   end;
 end;
 
 function GetFirstFreeId: Integer; stdcall;
 var
   Teller: Integer;
 begin
 
   for Teller := 0 to MaxPorts - 1 do
   begin
     if not bDoRun[Teller] then
     begin
       Result := Teller;
       Exit;
     end;
   end;
   Result := -1;
 end;
 
 //Export functie voor openen compoort
 
 function
   Simple_Comm_Open(Port: PChar; BaudRate: DWORD; ByteSize, Parity, StopBits:
     Byte; Mas
   k: Integer; WndHandle: HWND; WndCommand: UINT; var Id: Integer): Integer;
     stdcall;
 
 var
   PrevId: Integer;
   ctmoCommPort: TCOMMTIMEOUTS; //Lees specificaties voor de compoort
   dcbCommPort: TDCB;
 begin
 
   if (PortCount >= MaxPorts) or (PortCount < 0) then
   begin
     result := error_invalid_function;
     exit;
   end;
   result := 0;
   previd := id;
   id := getfirstfreeid;
   if id = -1 then
   begin
     id := previd;
     result := error_invalid_function;
     exit;
   end;
   hcommport[id] := createfile(port, generic_read or
     generic_write, 0, nil, open_existing, file_attribute_normal, 0);
 
   if hcommport[id] = invalid_handle_value then
   begin
     bdorun[id] := false;
     id := previd;
     result := getlasterror;
     exit;
   end;
   //lees specificaties voor het comm bestand
   ctmocommport.readintervaltimeout := maxdword;
   ctmocommport.readtotaltimeoutmultiplier := maxdword;
   ctmocommport.readtotaltimeoutconstant := maxdword;
   ctmocommport.writetotaltimeoutmultiplier := 0;
   ctmocommport.writetotaltimeoutconstant := 0;
   //instellen specificaties voor het comm bestand
   if not setcommtimeouts(hcommport[id], ctmocommport) then
   begin
     bdorun[id] := false;
     closehandle(hcommport[id]);
     id := previd;
     result := getlasterror;
     exit;
   end;
   //instellen communicatie
   dcbcommport.dcblength := sizeof(tdcb);
   if not getcommstate(hcommport[id], dcbcommport) then
   begin
     bdorun[id] := false;
     closehandle(hcommport[id]);
     id := previd;
     result := getlasterror;
     exit;
   end;
   if (mask and m_baudrate <> 0) then
     dcbCommPort.BaudRate := BaudRate;
   if (Mask and M_ByteSize <> 0) then
     dcbCommPort.ByteSize := ByteSize;
   if (Mask and M_Parity <> 0) then
     dcbCommPort.Parity := Parity;
   if (Mask and M_Stopbits <> 0) then
     dcbCommPort.StopBits := StopBits;
   if not SetCommState(hCommPort[Id], dcbCommPort) then
   begin
     bDoRun[Id] := FALSE;
     CloseHandle(hCommPort[Id]);
     Id := PrevId;
     Result := GetLastError;
     Exit;
   end;
   //Thread voor lezen compoort
   bDoRun[Id] := TRUE;
 
   hThread[Id] := CreateThread(nil, 0, @Simple_Comm_Read, Pointer(Id), 0,
     dwThread[Id]
     );
 
   if hThread[Id] = 0 then
   begin
     bDoRun[Id] := FALSE;
     CloseHandle(hCommPort[Id]);
     Id := PrevId;
     Result := GetLastError;
     Exit;
   end
   else
   begin
     SetThreadPriority(hThread[Id], THREAD_PRIORITY_HIGHEST);
     hWndHandle[Id] := WndHandle;
     hWndCommand[Id] := WndCommand;
     Inc(PortCount);
     Result := NO_ERROR;
   end;
 end;
 
 //Export functie voor schrijven naar compoort;
 
 function
   Simple_Comm_Write(Id: Integer; Buffer: PChar; Count: DWORD): Integer; stdcall;
 var
   Written: DWORD;
 begin
 
   if (Id < 0) or (id > Maxports - 1) or (not bDoRun[Id]) then
   begin
     Result := ERROR_INVALID_FUNCTION;
     Exit;
   end;
   if not WriteFile(hCommPort[Id], Buffer, Count, Written, nil) then
   begin
     Result := GetLastError();
     Exit;
   end;
   if (Count <> Written) then
     Result := ERROR_WRITE_FAULT
   else
     Result := NO_ERROR;
 end;
 
 //Aantal geopende poorten voor aanroepende applicatie
 
 function Simple_Comm_PortCount: DWORD; stdcall;
 begin
 
   Result := PortCount;
 end;
 
 {$IFNDEF COMM_UNIT}
 exports
 
   Simple_Comm_Info Index 1,
   Simple_Comm_Open Index 2,
   Simple_Comm_Close Index 3,
   Simple_Comm_Write Index 4,
   Simple_Comm_PortCount index 5;
 
 procedure DLLMain(dwReason: DWORD);
 begin
 
   if dwReason = DLL_PROCESS_DETACH then
     Simple_Comm_CloseAll;
 end;
 
 begin
 
   DLLProc := @DLLMain;
   DLLMain(DLL_PROCESS_ATTACH); //geen nut in dit geval
 end.
 
 {$ELSE}
 initialization
 finalization
 
   Simple_Comm_CloseAll;
 end.
 {$ENDIF}
 
 Другое решение: создание модуля I / O(ввода / вывода)под Windows 95 / NT.Вот он:
   )
 
 (с TDCB в SetCommStatus вы можете управлять DTR и т.д.)
 (Примечание: XonLim и XoffLim не должны быть больше 600, иначе под NT это
   работает неправильно)
 
 unit My_IO;
 
 interface
 
 function OpenComm(InQueue, OutQueue, Baud: LongInt): Boolean;
 function SetCommTiming: Boolean;
 function SetCommBuffer(InQueue, OutQueue: LongInt): Boolean;
 function SetCommStatus(Baud: Integer): Boolean;
 function SendCommStr(S: string): Integer;
 function ReadCommStr(var S: string): Integer;
 procedure CloseComm;
 
 var
 
   ComPort: Word;
 
 implementation
 
 uses Windows, SysUtils;
 
 const
 
   CPort: array[1..4] of string = ('COM1', 'COM2', 'COM3', 'COM4');
 
 var
 
   Com: THandle = 0;
 
 function OpenComm(InQueue, OutQueue, Baud: LongInt): Boolean;
 begin
 
   if Com > 0 then
     CloseComm;
   Com := CreateFile(PChar(CPort[ComPort]),
     GENERIC_READ or GENERIC_WRITE,
     0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   Result := (Com > 0) and SetCommTiming and
     SetCommBuffer(InQueue, OutQueue) and
     SetCommStatus(Baud);
 end;
 
 function SetCommTiming: Boolean;
 var
 
   Timeouts: TCommTimeOuts;
 
 begin
 
   with TimeOuts do
   begin
     ReadIntervalTimeout := 1;
     ReadTotalTimeoutMultiplier := 0;
     ReadTotalTimeoutConstant := 1;
     WriteTotalTimeoutMultiplier := 2;
     WriteTotalTimeoutConstant := 2;
   end;
   Result := SetCommTimeouts(Com, Timeouts);
 end;
 
 function SetCommBuffer(InQueue, OutQueue: LongInt): Boolean;
 begin
 
   Result := SetupComm(Com, InQueue, OutQueue);
 end;
 
 function SetCommStatus(Baud: Integer): Boolean;
 var
 
   DCB: TDCB;
 
 begin
 
   with DCB do
   begin
     DCBlength := SizeOf(Tdcb);
     BaudRate := Baud;
     Flags := 12305;
     wReserved := 0;
     XonLim := 600;
     XoffLim := 150;
     ByteSize := 8;
     Parity := 0;
     StopBits := 0;
     XonChar := #17;
     XoffChar := #19;
     ErrorChar := #0;
     EofChar := #0;
     EvtChar := #0;
     wReserved1 := 65;
   end;
   Result := SetCommState(Com, DCB);
 end;
 
 function SendCommStr(S: string): Integer;
 var
 
   TempArray: array[1..255] of Byte;
   Count, TX_Count: Integer;
 
 begin
 
   for Count := 1 to Length(S) do
     TempArray[Count] := Ord(S[Count]);
   WriteFile(Com, TempArray, Length(S), TX_Count, nil);
   Result := TX_Count;
 end;
 
 function ReadCommStr(var S: string): Integer;
 var
 
   TempArray: array[1..255] of Byte;
   Count, RX_Count: Integer;
 
 begin
 
   S := '';
   ReadFile(Com, TempArray, 255, RX_Count, nil);
   for Count := 1 to RX_Count do
     S := S + Chr(TempArray[Count]);
   Result := RX_Count;
 end;
 
 procedure CloseComm;
 begin
 
   CloseHandle(Com);
   Com := -1;
 end;
 
 end.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS