Читать и писать в последовательный порт

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

function OpenCOMPort: Boolean;

var

DeviceName: array[0..80] of Char;

ComFile: THandle;

begin

{ First step is to open the communications device for read/write.

This is achieved using the Win32 ‘CreateFile’ function.

If it fails, the function returns false.

Wir versuchen, COM1 zu offnen.

Sollte dies fehlschlagen, gibt die Funktion false zuruck.

}

StrPCopy(DeviceName, ‘COM1:’);

ComFile := CreateFile(DeviceName,

GENERIC_READ or GENERIC_WRITE,

0,

nil,

OPEN_EXISTING,

FILE_ATTRIBUTE_NORMAL,

0);

if ComFile = INVALID_HANDLE_VALUE then

Result := False

else

Result := True;

end;

function SetupCOMPort: Boolean;

const

RxBufferSize = 256;

TxBufferSize = 256;

var

DCB: TDCB;

Config: string;

CommTimeouts: TCommTimeouts;

begin

{ We assume that the setup to configure the setup works fine.

Otherwise the function returns false.

wir gehen davon aus das das Einstellen des COM Ports funktioniert.

sollte dies fehlschlagen wird der Ruckgabewert auf «FALSE» gesetzt.

}

Result := True;

if not SetupComm(ComFile, RxBufferSize, TxBufferSize) then

Result := False;

if not GetCommState(ComFile, DCB) then

Result := False;

// define the baudrate, parity,…

// hier die Baudrate, Paritat usw. konfigurieren

Config := ‘baud=9600 parity=n data=8 stop=1’;

if not BuildCommDCB(@Config[1], DCB) then

Result := False;

if not SetCommState(ComFile, DCB) then

Result := False;

with CommTimeouts do

begin

ReadIntervalTimeout := 0;

ReadTotalTimeoutMultiplier := 0;

ReadTotalTimeoutConstant := 1000;

WriteTotalTimeoutMultiplier := 0;

WriteTotalTimeoutConstant := 1000;

end;

if not SetCommTimeouts(ComFile, CommTimeouts) then

Result := False;

end;

{

The following is an example of using the ‘WriteFile’ function

to write data to the serial port.

Folgendes Beispiel verwendet die ‘WriteFile’ Funktion, um Daten

auf den seriellen Port zu schreiben.

}

procedure SendText(s: string);

var

BytesWritten: DWORD;

begin

{

Add a word-wrap (#13 #10) to the string

An den ubergebenen String einen Zeilenumbruch (#13 #10) hangen

}

s := s #13 #10;

WriteFile(ComFile, s[1], Length(s), BytesWritten, nil);

end;

{

The following is an example of using the ‘ReadFile’ function to read

data from the serial port.

Folgendes Beispiel verwendet die ‘ReadFile’ Funktion, um Daten

vom seriellen Port zu lesen.

}

procedure ReadText: string;

var

d: array[1..80] of Char;

s: string;

BytesRead, i: Integer;

begin

Result := »;

if not ReadFile(ComFile, d, SizeOf(d), BytesRead, nil) then

begin

{ Raise an exception }

end;

s := »;

for i := 1 to BytesRead do s := s d[I];

Result := s;

end;

procedure CloseCOMPort;

begin

// finally close the COM Port!

// nicht vergessen den COM Port wieder zu schliessen!

CloseHandle(ComFile);

end;

{/codecitation}

Установить флаг DTR и RTS в активное состояние для определённого COM-порта

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Slava V

После открытия com-порта через CreateFile() необходимо с помощью GetCommState() и SetCommState() установить параметры порта (в частности убрать автоуправление RTS и DTR). Затем для установки соответствующих сигналов используется функция EscapeCommFunction().

Procedure ControlRTS;

Var

S: String;

lDCB: TDCB;

fHandle: THandle;

Begin

S:=’COM1′;

// open port

fHandle:=CreateFile( Pchar(S), GENERIC_READ Or GENERIC_WRITE, 0,

Nil, OPEN_EXISTING, 0, 0);

If fHandle=INVALID_HANDLE_VALUE Then

Begin

// can’t open….

Exit;

End;

// read settings

If Not GetCommState( fHandle, lDCB) Then

Begin

// can’t read

Exit;

End;

// Fill dcb

lDCB.BaudRate:=CBR_2400;

lDCB.ByteSize:=8;

lDCB.Parity:=NOPARITY;

lDCB.StopBits:=ONESTOPBIT;

// !!! we will manage RTS ourself !!!

ldcb.Flags:=(ldcb.Flags And $FFFFC0FF) Or $00000100;

// set comm state

SetCommState( fHandle, ldcb);

// Here we can manage

// Reset RTS

EscapeCommFunction( fHandle, CLRRTS);

// Set RTS

EscapeCommFunction( fHandle, SETRTS);

// Close port

CloseHandle(fHandle);

fHandle:=0;

End;

P.S. Надо заметить, что все выходы com-порта являются инверсными. А это значит, что активным сосотоянием порта является 0, а неактивным 1.

{/codecitation}

Троянские порты

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Номер портаПротоколНазвание трояна

21TCP Blade Runner, Doly Trojan, Fore, Invisible FTP, WebEx, WinCrash

23TCP Tiny Telnet Server

25TCP Antigen, Email Password Sender, Haebu Coceda, Shtrilitz Stealth, Terminator, WinPC, WinSpy, Kuang2 0.17A-0.30

31TCP Hackers Paradise

80TCP Executor

456 TCP Hackers Paradise

555 TCP Ini-Killer, Phase Zero, Stealth Spy

666 TCP Satanz Backdoor

1001 TCP Silencer, WebEx

1011 TCP Doly Trojan

1095, 1097, 1098, 1099 TCP Rat

1170 TCP Psyber Stream Server, Voice

1234 TCP Ultors Trojan

1243, 6711, 6776TCP Sub 7

1245 TCP VooDoo Doll

1349 UDP Back Ofrice DLL

1492 TCP FTP99CMP

1600 TCP Shivka-Burka

1807 TCP SpySender

1981 TCP Shockrave

1999 TCP BackDoor 1.00-1.03

2001 TCP Trojan Cow

2023 TCP Ripper

2115 TCP BUGS

2140, 3150, 6670, 6771 TCP/UDP Deep Throat

2140, 3150 TCP The Invasor

2801 TCP Phineas Phucker

3024, 5742 TCP WinCrash

3129 TCP Masters Paradise

3700, 9872, 9873, 9874, 9875, 10067, 10167 TCP al of Doom

4092 TCP WinCrash

4567 TCP File Nail 1

4590 TCP ICQTrojan

5000TCP Bubbel

5000, 5001 TCP Sockets de Troie

5321 TCP Firehotcker

5400, 5401, 5402 TCP Blade Runner 0.80 Alpha

5569 TCP Robo-Hack

6969 TCP GateCrasher, Priority

7000 TCP Remote Grab

7300, 7301, 7306, 7307, 7308 TCP NetMonitor

7789 TCP ICQ Killer

9989 TCP iNi-Killer

10607TCP Coma 1.0.9

11000TCP Senna Spy

11223 TCP Progenic trojan

12223 TCP Hack’99 KeyLogger

12345, 12346 TCP NetBus 1.20-1.70, GabanBus

12361 ,12362 TCP Whack-a-mole

16969 TCP Priority

20001 TCP Millennium

20034 TCP NetBus 2.0 Beta-NetBus 2.01

21544 TCP GirlFriend 1.0 Beta-1.35

22222 TCP Prosiak

23456TCP Evil FTP, Ugly FTP

26274, 47262 TCP Delta

30100, 30101, 30102 TCP NetSphere 1.27a

30100, 30101, 30102 , 30103, 30103, 30103 TCP/UDP NetSphere 1.31

31337 UDP BackOfrice 1.20

31338 UDP DeepBO

31339 TCP NetSpy DK

31666 UDP BOWhack

31785, 31787, 31789, 31791, 31789, 31791 TCP/UDPHack Attack

33333 TCP Prosiak

34324 TCP BigGluck, TN

40412 TCP The Spy

40421, 40422, 40423, 40426 TCP Masters Paradise

50505 TCP Sockets de Troie

50766 TCP Fore

53001 TCP Remote Windows Shutdown

54321 TCP SchoolBus .69-1.11

61466 TCP Telecommando

65000 TCP Devil 1.3

69123 TCP ShitHeep

3003TCPСмерть Ламера

{/codecitation}

Структура DCB

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Структура DCB определяет установку управления для последовательного порта ввода-вывода (нам она понадобится для разбора примера с программой управления весами ПетрВес)

Примечание : В местах где нельзя дать точный перевод будет дано определение на английском из MSDK и приблизительный его перевод

Описание в эквиваленте C

typedef struct _DCB { // dcb

DWORD DCBlength; // Размер DCB

DWORD BaudRate; // Скорость пересылки данных в бодах;

// текущая скорость в бодах

DWORD fBinary: 1; // binary mode, no EOF check

// двоичный режим , не проверять конец

// данных (по умолчанию значение = 1)

DWORD fParity: 1; // Включить проверку четность (по умолчанию

// значение = 1)

DWORD fOutxCtsFlow:1; // CTS управление потоком выхода

DWORD fOutxDsrFlow:1; // DSR управление потоком выхода

DWORD fDtrControl:2; // DTR Тип управления потоком скорости

// передачи данных

DWORD fDsrSensitivity:1; // DSR sensitivity (чувствительность)

DWORD fTXContinueOnXoff:1; // XOFF continues Tx (стоп-сигнал

// продалжает выполнение)

DWORD fOutX: 1; // XON/XOFF out flow control (СТАРТ-

// СИГНАЛ / СТОП-СИГНАЛ для управления

// выходящим потоком (по умолчанию

// значение = 1)

DWORD fInX: 1; // XON/XOFF in flow control (СТАРТ-

// СИГНАЛ / СТОП-СИГНАЛ для управления

// входящим потоком (по умолчанию

// значение = 1)

DWORD fErrorChar: 1; // enable error replacement (включить

// проверку погрешностей по умолчанию=1)

DWORD fNull: 1; // enable null stripping (отвергать

// пустой поток данных (по умолчанию=1))

DWORD fRtsControl:2; // RTS управление потоком данных

DWORD fAbortOnError:1; // abort reads/writes on error

// (проверять операции чтения/записи

// по умолчанию=1)

DWORD fDummy2:17; // reserved ЗАРЕЗЕРВИРОВАНО

WORD wReserved; // not currently used НЕ ДЛЯ

// ИСПОЛЬЗОВАНИЯ

WORD XonLim; // transmit XON threshold (порог

// чувствительности старт-сигнала)

WORD XoffLim; // transmit XOFF threshold (порог

// чувствительности стоп-сигнала)

BYTE ByteSize; // Бит в байте (обычно 8)

BYTE Parity; // 0-4=no,odd,even,mark,space

// (четность байта)

BYTE StopBits; // 0,1,2 = 1, 1.5, 2 (стоповые биты)

char XonChar; // Tx and Rx XON character (вид

// старт сигнал в потоке)

char XoffChar; // Tx and Rx XOFF character (вид

// стоп сигнал в потоке)

char ErrorChar; // error replacement character (какой

// сигнал погрешности,его вид)

char EofChar; // end of input character (сигнал

// окончания потока)

char EvtChar; // received event character РЕЗЕРВ

WORD wReserved1; // reserved; do not use НЕ ДЛЯ

// ИСПОЛЬЗОВАНИЯ

} DCB;

Пример :

with Mode do

begin

BaudRate := 9600;

ByteSize := 8;

Parity := NOPARITY;

StopBits := ONESTOPBIT; // одиночный стоп-бит

Flags := EV_RXCHAR EV_EVENT2;

end;

Параметры :

DCBlength

Размер DCB структуры.

BaudRate

Определяет скорость в бодах, в которых порт оперирует. Этот параметр может принимать фактическое значение скорости в бодах, или один из следующих стандартных индексов скорости в бодах:

CBR_110 CBR_19200

CBR_300 CBR_38400

CBR_600 CBR_56000

CBR_1200 CBR_57600

CBR_2400 CBR_115200

CBR_4800 CBR_128000

CBR_9600 CBR_256000

CBR_14400

fBinary

Определяет, допускается ли двоичный (бинарный) способ передачи данных. Win32 API не поддерживает недвоичные (небинарные) способы передачи данных в потоке порта, так что этот параметр должен быть всегда ИСТИНЕН. Попытка использовать ЛОЖЬ в этом параметре не будет работать.

Примечание:

Под Windows 3.1 небинарный способ передачи допускается,но для работы данного способа необходимо заполнит параметр EofChar который будет восприниматься конец данных.

fParity

Определяет, допускается ли проверка четности. Если этот параметр ИСТИНЕН, проверка четности допускается

fOutxCtsFlow

CTS (clear-to-send) управление потоком выхода

fOutxDsrFlow

DSR (data-set-ready) управление потоком выхода

fDtrControl

DTR (data-terminal-ready) управление потоком выхода

Принимает следующие значения :

DTR_CONTROL_DISABLE

Отключает линию передачи дынных

DTR_CONTROL_ENABLE

Включает линию передачи дынных

DTR_CONTROL_HANDSHAKE

Enables DTR handshaking. If handshaking is enabled, it is an error for the application to adjust the line by using the EscapeCommFunction function.

Допускает подтверждению связи передачи данных Если подтверждение связи допускается, это — погрешность для того чтобы регулировать(корректировать) линию связи, используя функцию EscapeCommFunction.

fDsrSensitivity

Specifies whether the communications driver is sensitive to the state of the DSR signal. If this member is TRUE, the driver ignores any bytes received, unless the DSR modem input line is high.

Определяет возможна ли по порту двухсторонняя передача в ту и в другую сторону сигнала.

fTXContinueOnXoff

Определяет, останавливается ли передача потока , когда входной буфер становится полный, и драйвер передает сигнал XoffChar. Если этот параметр ИСТИНЕН, передача продолжается после того, как входной буфер становится в пределах XoffLim байтов, и драйвер передает сигнал XoffChar, чтобы прекратить прием байтов из потока . Если этот параметр ЛОЖНЫЙ, передача не продолжается до тех пор , пока входной буфер не в пределах XonLim байтов, и пока не получен сигнал XonChar, для возобновления приема .

fOutX

Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА в течение передачи потока порту. Если этот параметр ИСТИНЕН, передача останавливается, когда получен сигнал XoffChar и начинается снова, когда получен сигнал XonChar.

fInX

Specifies whether XON/XOFF flow control is used during reception. If this member is TRUE, the XoffChar character is sent when the input buffer comes within XoffLim bytes of being full, and the XonChar character is sent when the input buffer comes within XonLim bytes of being empty. Определяет, используется ли управление потоком СТАРТ-СИГНАЛА / СТОП-СИГНАЛА в течение приема потока портом. Если этот параметр ИСТИНЕН,сигнал XoffChar посылается , когда входной буфер находится в пределах XoffLim байтов, а сигнал XonChar посылается тогда когда входной буфер находится в пределах XonLim байтов или является пустым

fErrorChar

Определяет, заменены ли байты, полученные с ошибками четности особенностью, указанной параметром ErrorChar Если этот параметр ИСТИНЕН, и fParity ИСТИНЕН, замена происходит.

fNull

Определяет, отвергнуты ли нулевые(пустые) байты. Если этот параметр ИСТИНЕН, нулевые(пустые) байты, будут отвергнуты при получении их.

fRtsControl

RTS управление потоком » запрос пересылки «. Если это значение нулевое, то по умолчанию устанавливается RTS_CONTROL_HANDSHAKE. Принимает одно из следующих значений:

RTS_CONTROL_DISABLE

Отключает строку RTS, когда устройство открыто

RTS_CONTROL_ENABLE

Включает строку RTS

RTS_CONTROL_HANDSHAKE

Enables RTS handshaking. The driver raises the RTS line when the «type-ahead» (input) buffer is less than one-half full and lowers the RTS line when the buffer is more than three-quarters full. If handshaking is enabled, it is an error for the application to adjust the line by using the EscapeCommFunction function.

Допускает RTS подтверждение связи. Драйвер управляет потоком пересылки.RTS выравнивается , когда входной буфер — меньше чем половина полного и понижается, когда буфер — больше 2/3 полного .Если подтверждение связи допускается, это используется для регулирования передачи данных EscapeCommFunction.

RTS_CONTROL_TOGGLE

Specifies that the RTS line will be high if bytes are available for transmission. After all buffered bytes have been sent, the RTS line will be low. Определяет, что буфер будет высокий при подготовке данных для передачи. После того, как все байты отосланы, буфер RTS будет низок.

FAbortOnError

Определяет, закончена ли операции чтения/записи, если происходит погрешность.

Если этот параметр ИСТИНЕН, драйвер закрывает все операции чтения/записи с состоянием погрешности при возникновении оной.

Драйвер не будет принимать никакие дальнейшие действия, пока не дождется подтверждения погрешности в передоваемых (принимаемых) данных, вызывая функцию ClearCommError.

fDummy2

ЗАРЕЗЕРВИРОВАНО Microsoft

wReserved

ЗАРЕЗЕРВИРОВАНО Microsoft

XonLim

Определяет минимальное число байтов, находящихся во входном буфере прежде, чем будет генерирована подача СТАРТ-СИГНАЛА

XoffLim

Определяет максимальное число байтов, находящихся во входном буфере прежде, чем будет генерирована подача СТОП-СИГНАЛА. Максимальное число байтов, позволенных во входном буфере вычитается из размеров, в байтах, самого входного буфера.

ByteSize

Определяет число битов в байтах, переданных и полученных.

Parity

Определяет схему четности, которую нужно использовать. Этот параметр может быть одним из следующих значений:

EVENPARITY

MARKPARITY

NOPARITY

ODDPARITY

StopBits

Определяет число стоповых битов, которые нужно использовать.

Этот параметр может быть одним из следующих значений:

ONESTOPBIT 1 stop bit

ONE5STOPBITS 1.5 stop bits

TWOSTOPBITS 2 stop bits

XonChar

Определяет значение СТАРТ-СИГНАЛА для передачи и приема.

XoffChar

Определяет значение СТОП-СИГНАЛА для передачи и приема.

ErrorChar

Определяет значение СИГНАЛА ОШИБКИ (генерируемого при ошибке четности) для передачи и приема.

EofChar

Определяет значение сигнала конца данных.

EvtChar

Определяет значение сигнала события.

wReserved1

ЗАРЕЗЕРВИРОВАНО Microsoft

Дополнение:

Когда структура DCB использует «ручной» выбор конфигурации , следующие ограничения используются для ByteSize и StopBits параметров :

Число информационных разрядов должно быть от 5 до 8 битов.

Использование 5 информационных разрядов с 2 стоповыми битами — недопустимая комбинация, как — 6, 7, или 8 информационных разрядов с 1.5 стоповыми битами.

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

Serial Communications: A C Developer’s Guide by Mark Nelson, M

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

{/codecitation}

Работа с портами под Win95, обзор и теория

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Вступление

Предполагалось, что данный материал будет небольшой лекцией, посвящающей вас в технологию работы с последовательными портами под различными платформами. Но это не так, поскольку материала для этой лекции хватит на десятка два советов. Поэтому коротенько так, кратенько, небольшое вступление…

Проблема

Под MS-DOS приложение управляет всем компьютером. Это развязывало программисту руки. Достижение максимальной скорости работы осуществлялось непосредственным доступом к аппаратным средствам.

Под Windows 3.x эта свобода отчасти была ограничена. К примеру вы уже не имели полный доступ к экрану. Проблема объясняется легко: с тех пор, как пользователь мог запускать любое количество приложений, не было никакой гарантии, что приложения не получали одновременно те же самые аппаратные средства.

Другая проблема — вы уже должны были считаться с параллельно запущенными задачами, а не требовать у компьютера в свое распоряжение все ресурсы. Win 3.x осуществляет кооперацию параллельных задач, означая, что каждое приложение должно исходить из концепции совместного существования и не монополизировать ресурсы, а пользоваться услугами специализированного диспетчера. Захват CPU на длительное время здесь не приветствуется.

Но тем не менее монополизированный доступ к аппаратным средствам также возможен, но вся ответственность за работу других приложений ложится на программиста. Получается борьба вашего приложения с системой: если вы захватываете все рабочее время CPU, контроль над портами или работу с памятью, то система милостиво ждет, пока вы не отдадите бразды правления в ее руки, при этом другие приложения (если они не успели это сделать до вас) могут ругаться, выплевывать на экран грязные ругательства и пугать не в чем не повинного пользователя.

Факт, но тенденция отбивания рук от прямого доступа к железу победила на платформе Win32 (Windows NT и Windows 95). Это операционные системы с истинной многозадачностью. Каждый поток (выполняемый модуль) получает определенный квант процессорного времени. Когда лимит процессорного времени исчерпан, или появляется поток с более высоким приоритетом, система прекращает обслуживать первый поток, даже в случае, если он не завершен. Это переключение между потоками может произойти между двумя ассемблерными инструкциями, нет никакой гарантии, что поток сможет завершить определенное количество инструкций, прежде чем у него отнимут процессорное время, к тому же неизвестно как долго ждать следующей порции процессорного времени.

Это приводит к проблеме с прямым доступом к аппаратным средствам. Например, типичное чтение из порта формируется из нескольких ассемблерных инструкций:

mov dx, AddressPort

mov al, Address

out dx, al

jmp Wait

Wait:

mov dx, DataPort

in al, dx

Состояние всех регистров при переключении потоков сохраняется, состояние I/O портов (последовательные порты, порты ввода/вывода) — нет. Так, велика вероятность что другие приложения производят другие операции с I/O портом, в то время как вы «застряли» между инструкциями ‘out’ и ‘in’.

Документированный путь

Для решения этой проблемы мы должны как-то сообщить всем другим приложениям, что «К настоящему времени MyProg использует порт 546, и всем оставаться на своих местах до моего особого распоряжения.» В этом случае подешел бы мьютекс. К сожалению, для использования созданного мьютекса все приложения должны знать его имя. Но даже если бы это было возможно, вы легко можете наткнуться на другие заковыристые проблемы. Рассмотрим два приложения — App1 и App2. Оба пытаются выполнить вышеприведенный код. К несчастью, они созданы разными программистами с разным взглядом на технологию доступа, поэтому App1 сначала требует AddressPortMutex, в то время как App2 требует DataPortMutex. И, по печальному совпадению, когда App1 получает AddressPortMutex, система переключается на App2, которое захватывает DataPortMutex и получается праздник смертельного объятия. App2 не может получить адрес порта, т.к. его захватило App1. App1 не может получить данные порта, т.к. это захватило App2. И все чего-то ждут…

Правильное решение — создание драйвера устройства, которой единолично владеет портами/памятью. Доступ к аппаратным средствам осуществляется посредством API. Вот типичный вызов:

GetIOPortData(AddressPort, DataPort : word) : Byte;

GetIOPortData сначала создает мьютекс, который защищает от вторжения (возможно все) порты, затем дает доступ к портам и, наконец, уничтожает его перед возвратом в вызвавшему функцию оператору. В случае, когда функцию пытаются вызвать несколько потоков, управление получает только один, остальные в это время ждут.

Создание драйвера устройства дело нелегкое. Он должен быть создать с помощью ассемблера или C и невероятно труден в отладке. Более того, из-за соображений безопасности драйверы устройств для Windows 95 (VxD) не совместимы с драйверами для Windows NT (VDD, virtual device driver — виртуальный драйвер устройства). Говорят, что в будущих версиях они будут совместимы, и Windows NT 6.0 и Windows 2000 будут использовать одни и те же драйвера, но пока разработчики вынуждены заниматься созданием двух различных версий.

Для получения более подробной информации рекомендую обратиться к следующим ресурсам:

Microsoft Windows 95 Device Driver Kit

Microsoft Windows NT Device Driver Kit

Microsoft Press «Systems Programming for Windows 95» автора Walter Oney

Также вы можете ознакомиться с библиотекой Vireo VtoolsD на предмет написания VxD в C, расположенной по адресу http://www.vireo.com.

Недокументированный путь

Вышеуказанная проблема не слишком реальна. Приложение, которое имеет непосредственный доступ к аппаратным средствам, обычно использует некоторые специализированные аппаратные средства. Конфигурация типа той, которая стремиться запустить только одно приложение имеет единственную цель — получить монопольный доступ к этим аппаратным средствам. В этом случае создание драйверов устройств очень нерентабельно. В конце концов, причина хотя бы в том, что это работает под Windows, что можно получить свободно (почти) классный GUI, а не в том, чтобы 10 приложений работало одновременно.

К счастью, в Windows 95 заложена совместимость с Windows 3.x. Это означает, что директивное использование I/O портов также возможно, поскольку до сих пор находятся в эксплуатации множество 16-битных программ, которые просто не могут работать по другому. Просто в этом случае при кодировании вам придется спуститься до уровня ассемблера. Автор следующего кода Arthur Hoornweg:

function getport(p:word):byte; stdcall;

begin

asm

push edx

push eax

mov dx,p

in al,dx

mov @result,al

pop eax

pop edx

end;

end;

Procedure Setport(p:word;b:byte);Stdcall;

begin

asm

push edx

push eax

mov dx,p

mov al,b

out dx,al

pop eax

pop edx

end;

end;

Francois Piette также предлагает свое решение прямого доступа к портам I/O на страничке http://rtfm.netline.be/fpiette/portiofr.htm

Как насчет NT?

Но все вышесказанное под Windows NT работать не будет. NT более «прочная» операционная система, поэтому если она позволит в любое время кому попало обращаться к любым аппаратным средствам, она не была бы такой устойчивой. Кроме того, NT является кроссплатформенной системой, поэтому доступ к I/O портам может кардинально различаться при работе на различных процессорах.

Но тем не менее даже под NT можно добраться непосредственно до I/O портов, правда только на x86 процессорах. Это не является документированной особенностью, и, вероятно, исчезнет в будущих версиях этой операционной системы.

Я не обладаю достаточно полной информацией по этому вопросу, но интересующая нас статья D. Roberts в майском номере журнала Dr. Dobb’s Journal за 1996 год так и называется «Direct Port I/O and Windows NT.» К сожалению, я так и не нашел времени проверить приведенный там код. Статью и посвященный ей флейм вы можете почитать по адресу http://www.ddj.com.

Также рекомендую ознакомиться с опубликованной в Windows Developer Journal статьей «Port I/O under Windows.» Опубликована Karen Hazzah в июне 1996 года. Статью и посвященный ей флейм вы можете найти по адресу http://www.wdj.com.

Ресурсы

(Примечание, я не очень много знаю об этих ресурсах, проверьте их пожалуйста сами.)

Существуют новостные группы, посвященные написанию VxD и VDD:

comp.os.ms-windows.programmer.nt.kernel-mode (VDD)

comp.os.ms-windows.programmer.vxd (VxD)

Dejanews (http://www.dejanews.com) выдает достаточно много результатов, если для поиска задать фразу ‘device driver direct I/O access 95’.

Компания BlueWater Systems разработала OCX, осуществляющее прямой доступ к I/O портам, памяти и прерываниям, работающее под всеми Win32 платформами. Они также, кажется, предлагают изготовление драйверов устройств под заказ. Посмотрите их сервер по адресу http://www.bluewatersystems.com.

Я сляшал, что какая-то другая компания также рекламировала свои услуги в области разработчики VxD, но я не нашел их адреса.

{/codecitation}

Порты

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Здесь приводится список номеров портов и показывается за каким портом какая служба закреплена

7 echo

9 discard

11 systat

13 daytime

15 netstat

17 qotd

19 chargen

20 ftp-data

21 ftp

23 telnet

25 smtp

37 time

39 rlp

42 name

43 whois

53 domain

57 mtp

67 bootp

69 tftp

77 rje

79 finger

87 link

95 supdup

101 hostnames

102 iso-tsap

103 dictionary

104 x400-snd

105 csnet-ns

109 pop

110 pop3

111 portmap

113 auth

115 sftp

117 path

119 nntp

123 ntp

137 nbname

138 nbdatagram

139 nbsession

144 News

153 sgmp

158 tcprepo

161 snmp

162 snmp-trap

170 print-srv

175 vmnet

315 load

400 vmnet

500 sytek

512 biff

513 login

514 shell

515 printer

517 talk

518 ntalk

520 efs

525 timed

526 tempo

530 courier

531 conference

532 netnews

533 netwall

540 uucp

543 klogin

544 kshell

550 new-rwho

556 remotefs

560 rmonitor

561 monitor

600 garcon

601 maitrd

602 busboy

700 acctmaster

701 acctslave

702 acct

703 acctlogin

704 acctprinter

705 acctinfo

706 acctslave2

707 acctdisk

750 kerberos

751 kerberos_master

752 passwd_server

753 userreg_server

754 krb_prop

888 erlogin

{/codecitation}

Получить имена свободных com портов

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Для начала подключите модуль Registry в области uses. Затем на форму нужно будет вынести кнопку и многострочное текстовое поле класса TMemo. Ну и по нажатию на кнопку написать следующий код:

procedure TForm1.Button1Click(Sender: TObject);

var

reg: TRegistry;

st: TStrings;

i: integer;

begin

reg := TRegistry.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.OpenKey(‘hardware\devicemap\serialcomm’, false);

st := TStringList.Create;

reg.GetValueNames(st);

for i := 0 to st.Count — 1 do

Memo1.Lines.Add(reg.ReadString(st.Strings[i]));

st.Free;

reg.CloseKey;

reg.free;

end;

{/codecitation}

Печать Dos-файла в порт напрямую

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: http://blackman.wp-club.net

При печати Dos-файла в порт напрямую можно это сделать.

Например, напечатать за 2 прохода:

ESC @ — инициализация принтера

ESC G — включение режима печати за 2 прохода

ESC H — выключение режима печати за 2 прохода

var

FileOut: TextFile;

filename: string[128];

….

Filename := ‘PRN’;

AssignFile(Fileout, Filename);

Write(FileOut, Chr(27) ‘@’);

Str1 := AnToAs(chr(27) ‘G’ ‘Double’ chr(27) ‘H’);

Writeln(FileOut, Str1);

{преобразование Ansi to Ascii}

function AnToAs(s: string): string;

var

i, kod: Integer;

begin

Result := s;

for i := 1 to length(s) do

begin

kod := Ord(s[i]);

if kod 13 then

Result[i] := ‘ ‘;

if (kod >= 192) and (kod = 239) then

Result[i] := Chr(kod — 64);

if (kod >= 240) and (kod = 255) then

Result[i] := Chr(kod — 16);

if kod = 168 then

Result[i] := Chr(240);

if kod = 184 then

Result[i] := Chr(241);

end;

end;

{/codecitation}