Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Работа с последовательными портами 


//{$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.

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.