Советы по Delphi

         

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


//{$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] doBeginReadFile(hCommPort[id],ReadBuffer,1,Count,nil);if (Count > 0) thenBeginif ((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]) thenBeginResult:=ERROR_INVALID_FUNCTION;Exit;End;bDoRun[Id]:=False;Dec(PortCount);FlushFileBuffers(hCommPort[Id]);if notPurgeComm(hCommPort[Id],PURGE_TXABORT+PURGE_RXABORT+PURGE_TXCLEAR+PURGE_RXCL
EAR) then
Begin
Result:=GetLastError;Exit;End;if WaitForSingleObject(hThread[Id],10000) = WAIT_TIMEOUT thenif not TerminateThread(hThread[Id],1) thenBeginResult:=GetLastError;Exit;End;
CloseHandle(hThread[Id]);hWndHandle[Id]:=0;hWndCommand[Id]:=0;if not CloseHandle(hCommPort[Id]) thenBeginResult:=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 doBeginif bDoRun[Teller] then Simple_Comm_Close(Teller);End;End;

Function GetFirstFreeId:Integer;StdCall;
Var Teller:Integer;
Begin
For
Teller:=0 to MaxPorts-1 doBeginIf not bDoRun[Teller] thenBeginResult:=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 compoortdcbCommPort:TDCB;Begin
if
(PortCount >= MaxPorts) or (PortCount < 0) thenbeginresult:=error_invalid_function;exit;end;result:=0;previd:=id;id:=getfirstfreeid;if id = -1 thenbeginid:=previd;result:=error_invalid_function;exit;end;hcommport[id]:=createfile(port,generic_read orgeneric_write,0,nil,open_existing,file_attribute_normal,0);
if hcommport[id]= invalid_handle_value thenbeginbdorun[id]:=false;id:=previd;result:=getlasterror;exit;end;//lees specificaties voor het comm bestandctmocommport.readintervaltimeout:=maxdword;ctmocommport.readtotaltimeoutmultiplier:=maxdword;ctmocommport.readtotaltimeoutconstant:=maxdword;ctmocommport.writetotaltimeoutmultiplier:=0;ctmocommport.writetotaltimeoutconstant:=0;//instellen specificaties voor het comm bestandif not setcommtimeouts(hcommport[id],ctmocommport) thenbeginbdorun[id]:=false;closehandle(hcommport[id]);id:=previd;result:=getlasterror;exit;end;//instellen communicatiedcbcommport.dcblength:=sizeof(tdcb);if not getcommstate(hcommport[id],dcbcommport) thenbeginbdorun[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) thenBeginbDoRun[Id]:=FALSE;CloseHandle(hCommPort[Id]);Id:=PrevId;Result:=GetLastError;Exit;End;//Thread voor lezen compoortbDoRun[Id]:=TRUE;
hThread[Id]:=CreateThread(nil,0,@Simple_Comm_Read,Pointer(Id),0,dwThread[Id]
);
if hThread[Id] = 0 thenBeginbDoRun[Id]:=FALSE;CloseHandle(hCommPort[Id]);Id:=PrevId;Result:=GetLastError;Exit;End elseBeginSetThreadPriority(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]) thenBeginResult:=ERROR_INVALID_FUNCTION;Exit;End;if not WriteFile(hCommPort[Id],Buffer,Count,Written,nil) thenBeginResult:=GetLastError();Exit;End;if (Count <> Written) Then Result:=ERROR_WRITE_FAULT ElseResult:=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 gevalEnd.

{$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 andSetCommBuffer(InQueue,OutQueue) andSetCommStatus(Baud) ;end;

function SetCommTiming: Boolean;
var
Timeouts: TCommTimeOuts;
begin
with
TimeOuts dobeginReadIntervalTimeout := 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 dobeginDCBlength:=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.
[000238]



Мне необходим код для работы с последовательными портами.

Если вам нужно что-то РЕАЛЬНОЕ, то попробуйте это. Можете только добавить проверку на ошибки.

<<Книги>> Serial Communications: A C++ Developer's Guide by Mark Nelson, M&T Books.

Правда, по большей части это про DOS, а Windows посвящена только одна глава. Проверьте это.

unit Comm;
interface
uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Forms;type
TCommEvent = procedure(Sender: TObject; Data: Char) of object;TCommErrEvent = procedure(Sender: TObject; Error: Integer) of object;TComm = class(TComponent)privateWnd: HWND;DCB: TDCB;CommID: Integer;Buf: Array[0..2048] of char;NumChars: Integer;FOnCommErr: TCommErrEvent;FOnCommRecvd: TCommEvent;procedure CommWndProc(var Message: TMessage);publicfunction Send(data: Char): Boolean;function Connect: Boolean;constructor Create(AOwner: TComponent); override;Destructor destroy; override;publishedProperty OnCommErr: TCommErrEvent read FOnCommErr write FOnCommErr;Property OnCommRecvd: TCommEvent read FOnCommRecvd write FOnCommRecvd;end;procedure Register;
implementation

constructor
TComm.Create(AOwner: TComponent);
begin
inherited
Create(AOwner);Wnd := AllocateHwnd(CommWndProc);end;

procedure TComm.CommWndProc(var Message: TMessage);
var
Error, count: Integer;Stat: TComStat;begin
if
Message.Msg = WM_COMMNOTIFY thenbeginMessage.Result := 0;GetCommEventMask(CommId, $3fff);NumChars := ReadComm(CommID, @Buf, 2048);Error := GetCommError(CommId, Stat);if Error = 0 thenbeginif Assigned(FOnCommRecvd) thenbeginfor count := 0 to NumChars-1 doFOnCommRecvd(Self, Buf[count]);end;endelsebeginif Assigned(FOnCommErr) thenbeginFOnCommErr(Self, Error);end;end;end;end;

function TComm.Send(data: Char): Boolean;
var
Error: Integer;begin
Error := TransmitCommChar(CommId, data);if Error < 0 thenResult := FalseelseResult := True;end;

function TComm.Connect: Boolean;
var
Config : array[0..20] of Char;begin
CommId := OpenComm('COM2', 2048, 2048);StrCopy(Config, 'com2:96,n,8,1');{Здесь меняем настройки порта}BuildCommDCB(Config, DCB);DCB.ID := CommId;SetCommState(DCB);EnableCommNotification(CommID, Wnd, 1, -1);SetCommEventMask(CommId, ev_RXChar);Result := True;end;

Destructor TComm.destroy;
begin
CloseComm(CommID);DeallocateHwnd(Wnd);Inherited destroy;end;

procedure Register;
begin
RegisterComponents('Samples', [TComm]);end;
end.

[000448]



Содержание раздела