Работа с последовательными портами 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;
BeginId:=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_RXCLEAR) 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;
Beginif (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. |
[000238]