Советы по 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 BeginResult:=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. |
Мне необходим код для работы с последовательными портами.
Если вам нужно что-то РЕАЛЬНОЕ, то попробуйте это. Можете только добавить проверку на ошибки.
<<Книги>> 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]
