Rambler's Top100
"Knowledge itself is power"
F.Bacon
Поиск | Карта сайта | Помощь | О проекте | ТТХ  
 Подземелье Магов
  
 

Фильтр по датам

 
 К н и г и
 
Книжная полка
 
 
Библиотека
 
  
  
 


Поиск
 
Поиск по КС
Поиск в статьях
Яndex© + Google©
Поиск книг

 
  
Тематический каталог
Все манускрипты

 
  
Карта VCL
ОШИБКИ
Сообщения системы

 
Форумы
 
Круглый стол
Новые вопросы

 
  
Базарная площадь
Городская площадь

 
   
С Л С

 
Летопись
 
Королевские Хроники
Рыцарский Зал
Глас народа!

 
  
ТТХ
Конкурсы
Королевская клюква

 
Разделы
 
Hello, World!
Лицей

Квинтана

 
  
Сокровищница
Подземелье Магов
Подводные камни
Свитки

 
  
Школа ОБЕРОНА

 
  
Арсенальная башня
Фолианты
Полигон

 
  
Книга Песка
Дальние земли

 
  
АРХИВЫ

 
 

Сейчас на сайте присутствуют:
 
  
 
Во Флориде и в Королевстве сейчас  08:26[Войти] | [Зарегистрироваться]

Работа с портами ввода-вывода в DELPHI . Часть III

Дмитрий Кузан
дата публикации 23-04-2001 00:00

Работа с портами ввода-вывода в DELPHI . Часть III

«Главное не знание ,
а умение его правильно применить»

В обход своей статьи по желанию трудящихся масс представляю вашему вниманию еще пример для работы с портами теперь уже с портом LPT реализующий чистый вывод потока на принтер (данный пример взят мной из FAQ собранный Акжаном Абдулиным,за что ему огромное спасибо)

Итак…

Ниже пример открытия принтера и записи чистого потока данных в принтер.
Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP",чтобы функция сработала успешно. Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться.
=== Cut ===
uses WinSpool;

procedure WriteRawStringToPrinter(PrinterName:String; S:String);
var
  Handle: THandle;
  N: DWORD;
  DocInfo1: TDocInfo1;
begin
  if not OpenPrinter(PChar(PrinterName), Handle, nil) then
  begin
    ShowMessage('error ' + IntToStr(GetLastError));
    Exit;
  end;
  with DocInfo1 do begin
    pDocName := PChar('test doc');
    pOutputFile := nil;
    pDataType := 'RAW';
  end;
  StartDocPrinter(Handle, 1, @DocInfo1);
  StartPagePrinter(Handle);
  WritePrinter(Handle, PChar(S), Length(S), N);
  EndPagePrinter(Handle);
  EndDocPrinter(Handle);
  ClosePrinter(Handle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  WriteRawStringToPrinter('HP', 'Test This');
end;
=== Cut ===

unit TextPrinter;

interface

uses
  Windows, Controls, Forms, Dialogs;

type
  TTextPrinter = class(TObject)
    FNumberOfBytesWritten: Integer;
    FHandle: THandle;
    FPrinterOpen: Boolean;
    FErrorString: PChar;
    procedure SetErrorString;
  public
    constructor Create;
    procedure Write(const Str: string);
    procedure WriteLn(const Str: string);
    destructor Destroy; override;
  published
    property NumberOfBytesWritten: Integer read FNumberOfBytesWritten;
  end;

implementation

{TTextPrinter}

constructor TTextPrinter.Create;
begin
  FHandle := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ
or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if FHandle = INVALID_HANDLE_VALUE then
  begin
    SetErrorString;
    raise Exception.Create(FErrorString);
  end
  else
    FPrinterOpen := True;
end;

procedure TTextPrinter.SetErrorString;
begin
  if FErrorString <> nil then
    LocalFree(Integer(FErrorString));
  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
                nil,
                GetLastError(),
                LANG_USER_DEFAULT,
                @FErrorString,
                0,
                nil);
end;

procedure TTextPrinter.Write(const Str: string);
var
  OEMStr: PChar;
  NumberOfBytesToWrite: Integer;
begin
  if not FPrinterOpen then
    Exit;
  NumberOfBytesToWrite := Length(Str);
  OEMStr := PChar(LocalAlloc(LMEM_FIXED, NumberOfBytesToWrite + 1));
  try
    CharToOem(PChar(Str), OEMStr);
    if not WriteFile(FHandle, OEMStr^, NumberOfBytesToWrite,
FNumberOfBytesWritten, nil) then
    begin
      SetErrorString;
      raise Exception.Create(FErrorString);
    end;
  finally
    LocalFree(Integer(OEMStr));
  end;
end;

procedure TTextPrinter.WriteLn(const Str: string);
begin
  Self.Write(Str);
  Self.Write(#10);
end;

destructor TTextPrinter.Destroy;
begin
  CloseHandle(FHandle);
  if FErrorString <> nil then
    LocalFree(Integer(FErrorString));
end;

end.

=== Cut ===
P.S. В принципе, вместо LPT1 может стоять что угодно, даже сетевой сервер печати (\\server\prn) - все равно печатает. Можно и параметр в конструктор вставить и т.д.

Ну на примерах остановились идем далее по теме статьи и продолжаем разбирать работу программы «ПетрВес» в которой я хотел бы остановится на следующем : В своей программе по работе с весами ПетрВес (далее во всех продолжениях цикла -«ПетрВес») ее автор реализовал следующий код -
<Вырезано>
  
  with Mode do
  Begin
    BaudRate := 9600;
    ByteSize := 8;
    Parity := NOPARITY;
    StopBits := ONESTOPBIT;
    Flags := EV_RXCHAR + EV_EVENT2;
  End;
  SetCommState ( hComm, Mode );
  // Устанавливаем таймауты
  with TimeOuts do
  Begin
    ReadIntervalTimeout := MAXDWORD;
    ReadTotalTimeoutMultiplier := 0;
    ReadTotalTimeoutConstant := 0;
  End;
  SetCommTimeOuts(hComm,TimeOuts); 

<Вырезано>
я предложил бы для более надежной работы программы остановится на таком коде
<Вырезано>
  
  // Первоначальное считывание,приминяется для того что-бы установить 
  // все параметры структур по умолчанию
  if not Windows.GetCommState(hComm, Mode) or 
     not Windows.GetCommTimeouts(hComm,TimeOuts) 
  then 
     exit
  Else // у нас все хорошо все считалось нормально ,идем далее..
  begin
     with Mode do
     Begin
      BaudRate := 9600;
      ByteSize := 8;
      Parity := NOPARITY;
      StopBits := ONESTOPBIT;
      Flags := EV_RXCHAR + EV_EVENT2;
     End;
 
     // Устанавливаем таймауты
     with TimeOuts do
     Begin
      ReadIntervalTimeout := MAXDWORD;
      ReadTotalTimeoutMultiplier := 0;
      ReadTotalTimeoutConstant := 0;
     End;

     IF Not SetCommState ( hComm, Mode ) OR
        Not SetCommTimeOuts(hComm,TimeOuts); 
     Then
        ShowMessage("Ошибка");  // тут предпринимаем всякие действия 
                                // по обработке ошибки
   End;


<Вырезано>
Итак посмотрим что делает данный код:

GetCommState
функция находится в файле kernel32.dll
The GetCommState function fills in a device-control block (a DCB structure) with the current control settings for a specified communications device.
Функция GetCommState считывает структуру DCB с указанного порта (данную функцию можно использовать как проверку доступности порта).

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

BOOL GetCommState(

    HANDLE hFile,	// Дескриптор указывающий на порт (этот дескриптор 
                  // может быть создан с помощью CreateFile, OpenFile)
    LPDCB  lpDCB  // Структура управления устройством DCB (портом в 
                  // нашем случае)
   );	

Параметры :

HFile
Дескриптор указывающий на порт (этот дескриптор может быть создан с помощью CreateFile, OpenFile)
lpDCB
Структура управления устройством DCB (портом в нашем случае)

Возвращаемое значение :

Если функция выполняется успешно, возвращаемое значение - TRUE иначе возвращаемое значение - FALSE . При возникновении ошибки код ошибки можно получить используя GetLastErro

SetCommState
функция находится в файле kernel32.dll
The SetCommState function configures a communications device according to the specifications in a device-control block (a DCB structure). The function reinitializes all hardware and control settings, but it does not empty output or input queues.
Функция SetCommState конфигурирует настройки порта согласно техническим требованиям указанным в блоке управления устройством (структура DCB). Функция повторно инициализирует все аппаратные средства и установки управления, но не затрагивает очеpеди пеpедачи и пpиема потоков данных.

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

BOOL SetCommState(

    HANDLE hFile,	// Дескриптор указывающий на порт (этот дескриптор 
                  // может быть создан с помощью CreateFile,OpenFile)
    LPDCB  lpDCB  // Структура управления устройством DCB (портом в 
                  // нашем случае)
   );	

Коротко

Инициализиpует устpойство связи, указанное в поле HFILE блока DCB, в состояние, заданное DCB. Очеpеди пеpедачи и пpиема не затpагиваются.

Параметры :

HFile
Дескриптор указывающий на порт (этот дескриптор может быть создан с помощью CreateFile, OpenFile)
lpDCB
Структура управления устройством DCB (портом в нашем случае)

Возвращаемое значение :

Если функция выполняется успешно, возвращаемое значение - TRUE иначе возвращаемое значение - FALSE . При возникновении ошибки код ошибки можно получить используя GetLastError.

Дополнительные сведения:

The SetCommState function uses a DCB structure to specify the desired configuration. The GetCommState function returns the current configuration. To set only a few members of the DCB structure, you should modify a DCB structure that has been filled in by a call to GetCommState. This ensures that the other members of the DCB structure have appropriate values. The SetCommState function fails if the XonChar member of the DCB structure is equal to the XoffChar member.
Функция SetCommState использует структуру DCB, чтобы переинициализировать конфигурацию по умолчанию. Чтобы перенастроить только несколько членов структуры DCB, Вы должны изменить структуру DCB, которая была получена с помощью GetCommState. Это будет гарантировать, что другие члены структуры DCB будут иметь соответствующие значения по умолчанию.

Важно

Функция SetCommState потерпит неудачу, если параметр XonChar структуры DCB будет равен параметру XoffChar.
Для функции SetCommState используются следующие ограничения параметров ByteSize и StopBits структуры DCB:
  • Число информационных разрядов должно быть от 5 до 8 битов.
  • Использование 5 информационных разрядов с 2 стоповыми битами - недопустимая комбинация, как - 6, 7, или 8 информационных разрядов с 1.5 стоповыми битами.

Продолжнение следует...

Дмитрий Кузан
23 апреля 2001 г.
Специально для Королевства Delphi




Смотрите также материалы по темам:
[TObject] [TPrinter] [TForm] [Exception] [Работа с портами ввода/вывода]

 Обсуждение материала [ 05-12-2002 23:14 ] 3 сообщения
  
Время на сайте: GMT минус 5 часов

Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter.
Функция может не работать в некоторых версиях броузеров.

Web hosting for this web site provided by DotNetPark (ASP.NET, SharePoint, MS SQL hosting)  
Software for IIS, Hyper-V, MS SQL. Tools for Windows server administrators. Server migration utilities  

 
© При использовании любых материалов «Королевства Delphi» необходимо указывать источник информации. Перепечатка авторских статей возможна только при согласии всех авторов и администрации сайта.
Все используемые на сайте торговые марки являются собственностью их производителей.

Яндекс цитирования