• B правой части каждого сообщения есть стрелки и . Не стесняйтесь оценивать ответы. Чтобы автору вопроса закрыть свой тикет, надо выбрать лучший ответ. Просто нажмите значок в правой части сообщения.

  • Курсы Академии Кодебай, стартующие в мае - июне, от команды The Codeby

    1. Цифровая криминалистика и реагирование на инциденты
    2. ОС Linux (DFIR) Старт: 16 мая
    3. Анализ фишинговых атак Старт: 16 мая Устройства для тестирования на проникновение Старт: 16 мая

    Скидки до 10%

    Полный список ближайших курсов ...

Решение Задачи

  • Автор темы Fransuz
  • Дата начала
F

Fransuz

Нужно создать программу для устройства параллельной печати, которая будет управлять LPT портом. По нажатию кнопки с программы отправляется логическая 1 и дает принтеру команду для печати какого либо символа. Для передачи информации в печатающее устройство служат линии данных РАЗРЯД 1 - РАЗРЯД 7. а также 3 кода управления форматом. Стык между устройством и вычислительной системой обеспечивается 11 усилителями-приемниками и 4 усилителями-передатчиками. Все это осуществляется на Delphi.
Приведу код, который управляет LPT портом

Код:
[i]unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LPTIO,
ExtCtrls, StdCtrls, ToolWin, ComCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
Panel1: TPanel;
ToolBar1: TToolBar;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;

ToolBar4: TToolBar;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button9: TButton;
ComboBox1: TComboBox;
Label1: TLabel;
Button6: TButton;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
Button7: TButton;
Button10: TButton;
Button8: TButton;


procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);

procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button10Click(Sender : TObject);

private
{ Private declarations }
Lpt : TLptPortConnection;
public
{ Public declarations }
function GetCurrentPort : byte;	 // Читает список ComboBox1 и возвращает соответствующий номер порта
//*********************PIN**************************************************
function Pin2 : boolean;
function Pin3 : boolean;
function Pin4 : boolean;
function Pin5 : boolean;
function Pin6 : boolean;
function Pin7 : boolean;
function Pin8 : boolean;

function Pin1 : boolean;
function Pin12 : boolean;


//**************************************************************************

{------------Встроены команды Pin клавиатуры-------------------------------}

procedure ButtonPin2;
procedure ButtonPin3;
procedure ButtonPin4;
procedure ButtonPin5;
procedure ButtonPin6;
procedure ButtonPin7;
procedure ButtonPin8;


procedure ButtonPin1;
procedure ButtonPin12;
//*************************************************************************
end;

var
Form1: TForm1;

implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var msg : AnsiString;
begin
Lpt := TLptPortConnection.Create;
if not Lpt.Ready then
begin { объект не готов -- покажем код ошибки }
msg := 'Ошибка при создании объекта Lpt, драйвер ERROR, код = ' + IntToStr(GetLastError());
Application.MessageBox(PChar(msg),'ERROR',MB_OK);
Application.Terminate; // выход
end;
// Проверим наличие портов и заполним их список в ComboBox-e
if Lpt.IsPortPresent(LPT2) then ComboBox1.Items.Add('$378'); //-ВНИМАНИЕ: $378 здесь назван LPT2!
if 0<>ComboBox1.Items.Count then ComboBox1.ItemIndex := 0;
end;
procedure TForm1.FormDestroy(Sender: TObject); // Обработчик разрушения
begin
Lpt.Destroy;
{ Здесь разместите все таймеры, которые должны быть отключены}
Timer1.Enabled := false;
end;



function TForm1.GetCurrentPort : byte;	 // Читает список ComboBox1 и возвращает соответствующий номер порта
begin
if '$3BC' = ComboBox1.Text then
GetCurrentPort:=LPT1
else
if '$378' = ComboBox1.Text then
GetCurrentPort:=LPT2	 else
GetCurrentPort:=LPT3;
end;



//***********Добавлены функции - PIN - *******************************************


function TForm1.Pin2 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (1 = (1 and Lpt.ReadPort( (GetCurrentPort) ,0)));
Pin2 := d;
end;

function TForm1.Pin3 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (2 = (2 and Lpt.ReadPort(GetCurrentPort,0)));
Pin3 := d;
end;

function TForm1.Pin4 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (4 = (4 and Lpt.ReadPort(GetCurrentPort,0)));
Pin4 := d;
end;

function TForm1.Pin5 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (8 = (8 and Lpt.ReadPort(GetCurrentPort,0)));
Pin5 := d;
end;

function TForm1.Pin6 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (16 = (16 and Lpt.ReadPort(GetCurrentPort,0)));
Pin6 := d;
end;

function TForm1.Pin7 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (32 = (32 and Lpt.ReadPort(GetCurrentPort,0)));
Pin7 := d;
end;

function TForm1.Pin8 : boolean;
Var
d : boolean;
begin
d := true;
d := d and (64 = (64 and Lpt.ReadPort(GetCurrentPort,0)));
Pin8 := d;
end;
//******************Управление*********
function TForm1.Pin1 : boolean;
Var
d : boolean;
begin
d := true;
d := d xor (Strobe = (Strobe and Lpt.ReadPort(GetCurrentPort,2)));
Pin1 := d;
end;
//*************Состояние***************
function TForm1.Pin12 : boolean;
Var
d : boolean;
begin
d := true;
d := d and(PAPEREND = (PAPEREND and Lpt.ReadPort(GetCurrentPort,1)));
Pin12 := d;
end;

//******************************************************************************
{-----------------------Команды Pin клавиатуры---------------------------------}

procedure TForm1.ButtonPin2;
begin
Lpt.WritePort (GetCurrentPort,0,(1 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;

procedure TForm1.ButtonPin3;
begin
Lpt.WritePort (GetCurrentPort,0,(2 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;

procedure TForm1.ButtonPin4;
begin
Lpt.WritePort (GetCurrentPort,0,(4 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;

procedure TForm1.ButtonPin5;
begin
Lpt.WritePort (GetCurrentPort,0,(8 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;

procedure TForm1.ButtonPin6;
begin
Lpt.WritePort (GetCurrentPort,0,(16 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;

procedure TForm1.ButtonPin7;
begin
Lpt.WritePort (GetCurrentPort,0,(32 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;

procedure TForm1.ButtonPin8;
begin
Lpt.WritePort (GetCurrentPort,0,(64 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
end;
{*********************Регистры контроля*********************}

procedure TForm1.ButtonPin1;
begin
Lpt.WritePort(GetCurrentPort,2,(1 xor Lpt.ReadPort((GetCurrentPort),2) ));
end;

procedure TForm1.ButtonPin12;
begin
Lpt.WritePort(GetCurrentPort,1,(1 xor Lpt.ReadPort((GetCurrentPort),1) ));
end;
//*****************************************************************************

{------- драйвер XP: lptwdmio.sys должен быть в текущем каталоге ------------- }
{----------------------------Ваш код-------------------------------------------}


procedure TForm1.Timer1Timer(Sender: TObject);
begin
CheckBox1.Checked := Pin2; //--если Pin2 = true тогда будет галочка
CheckBox2.Checked := Pin3; //----аналогично----
CheckBox3.Checked := Pin4;
CheckBox4.Checked := Pin5;
CheckBox5.Checked := Pin6;
CheckBox6.Checked := Pin7;
CheckBox7.Checked := Pin8;

CheckBox8.Checked := Pin1;
CheckBox9.Checked := Pin12;
end;


{******************--Пишем Pin клавиатуру--***************************}

{ ------------------- регистры данных ------------------------------ }
procedure TForm1.Button1Click(Sender: TObject);
begin
ButtonPin2; //-- ( Pin2)
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ButtonPin3; //-- ( Pin3)
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ButtonPin4; //-- (Аналогично)
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
ButtonPin5;
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
ButtonPin6;
end;


{procedure TForm1.Button9Click(Sender: TObject);
begin
ButtonPin7;
end;}


procedure TForm1.Button7Click(Sender: TObject);
begin
ButtonPin8;
end;
{****************************регистры контроля************}
procedure TForm1.Button6Click(Sender: TObject);
begin
ButtonPin1;
end;
//***************Состояния*************
procedure TForm1.Button10Click(Sender: TObject);
begin
ButtonPin12;
end;
end.[/i][/i]
 
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!