/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 880
от 27.07.2007, 13:35

Вопрос № 95.930

доброго времени суток! Передо мной стоит задача: нужна программа, которая управляла бы последовательным портом компьютера, т.е. подавала бы логический ноль (0 вольт)или единицу(+5 вольт) на нужный пин портапомогите кто сможет, пожалуйста.

Отправлен: 22.07.2007, 08:57 Вопрос задал: Deimos25 (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Градов Юрий Михайлович Здравствуйте, Deimos25! Пример компонета для работы с последовательным портом, взята из справочника DelphiWorld. Скопируйте из приложения текст. Создайте Unit и вставьте текст. Сохраните, как Comm.pas, затем зарегистрируйте компонент. Уточнения пишите в минифорум. Приложение: unit Comm; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Forms; type TCommEvent = procedure(Sender: TObject; Data: Char) of object; TCommErrEvent = procedure(Sender: TObject; Error: Integer) of object; TComm = class(TComponent) private Wnd: HWND; DCB: TDCB; CommID: Integer; Buf: array[0..2048] of char; NumChars: Integer; FOnCommErr: TCommErrEvent; FOnCommRecvd: TCommEvent; procedure CommWndProc(var Message: TMessage); public function Send(data: Char): Boolean; function Connect: Boolean; constructor Create(AOwner: TComponent); override; destructor destroy; override; published property OnCommErr: TCommErrEvent read FOnCommErr write FOnCommErr; property OnCommRecvd: TCommEvent read FOnCommRecvd write FOnCommRecvd; end; procedure Register; implementation constructor TComm.Create(AOwner: TComponent); begin inherited Create(AOwner); Wnd := AllocateHwnd(CommWndProc); end; procedure TComm.CommWndProc(var Message: TMessage); var Error, count: Integer; Stat: TComStat; begin if Message.Msg = WM_COMMNOTIFY then begin Message.Result := 0; GetCommEventMask(CommId, $3FFF); NumChars := ReadComm(CommID, @Buf, 2048); Error := GetCommError(CommId, Stat); if Error = 0 then begin if Assigned(FOnCommRecvd) then begin for count := 0 to NumChars - 1 do FOnCommRecvd(Self, Buf[count]); end; end else begin if Assigned(FOnCommErr) then begin FOnCommErr(Self, Error); end; end; end; end; function TComm.Send(data: Char): Boolean; var Error: Integer; begin Error := TransmitCommChar(CommId, data); if Error < 0 then Result := False else Result := True; end; function TComm.Connect: Boolean; var Config: array[0..20] of Char; begin CommId := OpenComm('COM2', 2048, 2048); StrCopy(Config, 'com2:96,n,8,1'); {Здесь меняем настройки порта} BuildCommDCB(Config, DCB); DCB.ID := CommId; SetCommState(DCB); EnableCommNotification(CommID, Wnd, 1, -1); SetCommEventMask(CommId, ev_RXChar); Result := True; end; destructor TComm.destroy; begin CloseComm(CommID); DeallocateHwnd(Wnd); inherited destroy; end; procedure Register; begin RegisterComponents('Samples', [TComm]); end; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Практикант) Ответ отправлен: 22.07.2007, 12:02

Отвечает: Виктор Пырлик Здравствуйте, Deimos25! Работа с аппаратурой под Windows накладывает ограничения, в частности, вы должны использовать функции API для доступа к аппаратной части, или, использовать/писать собственные драйвера для доступа – например, драйвер GiveIO (http://www.void.ru/content/701). Для получения доступа к аппаратуре средствами API используется следующая последовательность шагов: 1. Получить Handler устройства вызовом CreateFile с именем устройства. Более подробно см Windows SDK Help. 2. Для управления устройством вызывать функции API для данного устройства, либо посылать IOCTL(input - otput control) последнее через DeviceIOCtl(подробно см Windows SDK Help). 3. Закрыть устройство CloseHandle(Handler); Последовательный порт Открытие порта: Var FHandle: Thandle; FHandle := CreateFile( PChar(ComString), // тут может быть например COM1 COM2 b и т.д. GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); Параметр 1: Имя порта – ‘COM1’, итд Параметр 2: режим открытия GENERIC_READ – чтение, GENERIC_WRITE – запись Параметр 3: режим разделения ресуртса. Примечание: 0 – неразделяемый (именно так описано открытие последовательного порта в WIN SDK, другие режимы не проверял). Параметр 4: Режим безопасности. Имеет смысл в Windows NT, Windows 9x игнорирует его. Параметр 5: Способ открытия. Для порта - OPEN_EXISTING – открыть, когда устройство реально существует. Параметр6: режим наложения операций - FILE_FLAG_OVERLAPPED – разрешение таких операций. При этом операции чтения – записи, требующие значительного времени, выполняются фоново по отношению к основному потоку программы. Параметр7: шаблон файла, для последовательного порта – всегда 0. В случае нормального открытия порта FHandle – дескриптор порта, при неудаче содержит значение INVALID_HANDLE_VALUE. Закрытие порта: Закрытие порта выполняется вызовом CloseHandle(FHandle). Настройка параметров передачи (скорость, кол-во бит, стоп биты) Структура данных о настройках порта (device control block) DCB содержит информацию о настройках порта. Поля структуры: DWORD DCBlength; // sizeof(DCB) DWORD BaudRate // Скорость передачи (baud rate). Есть стандартный набор // скоростей: все константы скоростей выглядят как CBR_<число>. //Пример CBR_9600, CBR_115200. Flags DWORD fBinary: // режим проверки символа Eof – включение данного режима Windows // не поддерживает ( по крайней мере сейчас). Маска $01 DWORD fParity: //Контроль четности Маска $02 – включение контроля четности DWORD fOutxCtsFlow: // Маска $04 – Включение контроля сигнала CTS при выводе байтов. DWORD fOutxDsrFlow: // Маска $08 – Включение контроля сигнала DSR при выводе байтов. DWORD fDtrControl: // Маска $30 – Тип контроля сигнала DTR: значения DTR_CONTROL_DISABLE деактивация сигнала. DTR_CONTROL_ENABLE конкретное значение сигнала можно задавать через вызов EscapeCommFunction. DTR_CONTROL_HANDSHAKE Автоматическое управление сигналом. DWORD fDsrSensitivity: // Маска $40 - Включение контроля сигнала DSR. DWORD fTXContinueOnXoff:1; // XOFF continues Tx DWORD fOutX: // Маска $100. Включение режима работы по XON XOFF при передаче DWORD fInX: // Маска $200 -//- при приеме DWORD fErrorChar: // Маска $400. Разрешение замещения при ошибочном приеме // (несовпадение четности) принятого байта на член структуры ErrorChar. DWORD fNull: // Маска $800 enable null stripping – пропускать при приеме символы NULL DWORD fRtsControl: // Маска $3000. Тип контроля: RTS_CONTROL_DISABLE RTS_CONTROL_ENABLE RTS_CONTROL_HANDSHAKE Аналогично сигналу DTR RTS_CONTROL_TOGGLE – Высокий уровень пока, есть данные для передачи. DWORD fAbortOnError // Маска $4000. Прекращение операций // чтения – записи при возникновении ошибок DWORD fDummy2:17; // Не используются Другие данные структуры WORD wReserved; // Не используется WORD XonLim; // минимальное число байт в приемном буфере до отправки символа XON WORD XoffLim; // максимальное число байт в приемном буфере до отправки символа XOFF BYTE ByteSize; // количество бит в байте от 4 до 8 BYTE Parity; // 0-4=no,odd,even,mark,space бит паритета, BYTE StopBits; // 0,1,2 = 1, 1.5, 2 – стоп биты, // 1,5 используются только при 5 битах в посылке для мелкосхемы 8250. ONESTOPBIT 1 stop bit ONE5STOPBITS 1.5 stop bits TWOSTOPBITS 2 stop bits char XonChar; // Tx and Rx XON символ char XoffChar; // Tx and Rx XOFF символ char ErrorChar; // Символ, которым заменяется ошибочно принятый байт char EofChar; // end of input character char EvtChar; // received event character WORD wReserved1; // Не используется Delphi имеет оболочку для DCB – TDCB. Получить текущую конфигурацию порта можно функцией GetCommState(Fhandle:Handle; fDCB:TDCB). Установить соответственно SetCommDCB. После установки параметров порта. Читать и писать можно через ReadFile и WriteFile. В приложение приводится модуль работы с ком-портом. Для сокращения кода, убраны некоторые проверки, что в реальной программе необходимо сделать. Приложение: unit WorkRS232; interface uses windows,sysutils; var CommHandle : integer; DCB : TDCB; Ovr : TOverlapped; Stat : TComStat; CommThread : THandle; hEvent : THandle; Flag,StopResive : boolean; KolByte,Kols,Mask,TransMask,Errs : DWord; procedure PortInit; procedure ReadComm; procedure WriteComm(A:byte); procedure KillComm; implementation uses ComPort; procedure KillComm; begin TerminateThread(CommThread,0); CloseHandle(CommHandle); end; procedure WriteComm(A:byte); var Transmit:array [0..255] of char; begin //послать один символ в порт KolByte:=1; Transmit[0]:=chr(A); WriteFile(CommHandle,Transmit,KolByte,KolByte,@Ovr); end; procedure ReadComm; var Resive:array [0..255] of char; begin while true do begin TransMask:=0; WaitCommEvent(CommHandle,TransMask,@Ovr); //ждем if (TransMask and EV_RXFLAG)=EV_RXFLAG then //проверяем нужное событие begin ClearCommError(CommHandle,Errs,@Stat);//сбрасываем флаг Kols := Stat.cbInQue; ReadFile(CommHandle,Resive,Kols,Kols,@Ovr);//читаем {......................... .. необходима проверка - прочтено или нет Обработка данных - Resive .............. ............................................} Form1.Panel1.Caption:=string(Resive); //не очень хороший вариант вывода, но для примера подойдет end;//mask end;//while end; procedure PortInit; var ThreadID:dword; begin //создание и иницализация порта KolByte:=0; //создание порта и получение его хэндла CommHandle := CreateFile('COM1',GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,0); //ставим маску - "по пришествии определенного символа" SetCommMask(CommHandle,EV_RXFLAG); //построение DCB GetCommState(CommHandle,DCB); DCB.BaudRate:=CBR_9600; DCB.Parity:=NOPARITY; DCB.ByteSize:=8; DCB.StopBits:=OneStopBit; DCB.EvtChar:=chr(13);//задание символа для флага //устанавливаем DCB SetCommState(CommHandle,DCB); //создаем паралельный поток //там будет работать процедура приема строки //с порта - ReadComm CommThread := CreateThread(nil,0,@ReadComm,nil,0,ThreadID); end; end. --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 22.07.2007, 13:14

Вопрос № 95.934

Нужно написать прогу. помогите пожайлуста. Есть текстовый документ, в нем написаны ссылки на сайты построчно(см. прил.) нужно чтобы, запустив программу открылась первая ссылка а через 60-70 секунд открывалась следующая ссылка, а затем следующая и так далее. Ссылки меняются в зависимости от содержания текстового документа. Я думаю понятно описал суть проги. Помогите. очень нуна. Спасибо всем кто откликнется. Приложение: http://rusfaq.ru/ http://igromania.ru и т.д.

Отправлен: 22.07.2007, 11:06 Вопрос задал: Колпаков Александр Константинович (статус: 3-ий класс) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Градов Юрий Михайлович Здравствуйте, Колпаков Александр Константинович! Посмотрите, пожалуйста листинг в приложении, на форму помещается Button1, OpenDialog1 и Timer1. Исправлено по просьбе самого эксперта [Denisss] Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ShellAPI; type TForm1 = class(TForm) Button1: TButton; OpenDialog1: TOpenDialog; Timer1: TTimer; procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; F: TextFile; S: string; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin AssignFile(F,OpenDialog1.FileName); Reset(F); Readln(F,S); ShellExecute(Application.Handle, 'open', PChar(S), nil, nil, SW_SHOWNORMAL); Timer1.Interval:=60000; Timer1.Enabled:=True; end; end; procedure TForm1.Timer1Timer(Sender: TObject); begin While Not Eof(F) do begin Readln(F,S); ShellExecute(Application.Handle, 'open', PChar(S), nil, nil, SW_SHOWNORMAL); end; Timer1.Enabled:=False; CloseFile(F); end; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Enabled:=False; end; end. --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Практикант) Ответ отправлен: 22.07.2007, 11:37

Отвечает: DimonSoft Здравствуйте, Колпаков Александр Константинович! Решение задачи достаточно просто. Если нет никаких ограничений на использование, например, VCL, то я бы решил эту проблему так... 1. С помощью объекта TStringList загружаем файл в ОЗУ. Выбрать файл можно OpenDialog'ом или любым другим способом (зависит от Вашей программы). 2. Размещённый на форме TTimer с нужным интервалом. По таймеру открываем очередной адрес (см. ниже), который соответствует первой строке TStringList'а, и удаляем первую строку. 3. Открыть адрес в броузере можно при помощи ShellExecute. Для использования этой функции не забудьте подключить модуль ShellAPI. Описание функции есть в справке по WinAPI, которая идёт вместе с Delphi. Теперь приблизительный код. В объявлении формы добавляем описание AddressList:TStringList; Рекомендую создать TStringList во время создания формы (OnCreate) и удалить при удалении формы (OnDestroy): так Вам удастся избежать разных Access Violation'ов и прочих неприятностей. procedute TYourForm.FormCreate(...); begin ... AddressList:=TStringList.Create; ... end; procedute TYourForm.FormDestroy(...); begin ... AddressList.Free; ... end; Процедура загрузки списка из файла может быть реализована по какому-либо событию. Я приведу просто фрагмент кода, нужный для загрузки с учётом того, что мы создаём AddressList вместе с формой. AddresssList.LoadFromFile(...); //Единственный параметр - строка-имя файла Теперь событие таймера. procedure TYourTimer.TimerTimer(...); begin ... if AddressList.Count>0 then begin //Среди параметров ShellExecute в соответствии со справкой указываем //вместо имени файла нужный адрес. Это записывается так: // //PChar(AddressList[0]) // //PChar - это приведение типов ShellExecute(...); AddressList.Delete(0); //Удаляем первый элемент списка end else begin ... //Здесь можно отключить таймер, т.к. адресов в списке больше не осталось end; ... end; В примере кода использованы имена контролов YourForm и YourTimer. В Вашем случае они, естесственно, будут другими. С уважением, DimonSoft.

Ответ отправил: DimonSoft (статус: 3-ий класс) Ответ отправлен: 22.07.2007, 11:40

Отвечает: Виктор Пырлик Здравствуйте, Колпаков Александр Константинович! В приложении рабочий код. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Controls, Forms ,Dialogs, ExtCtrls, StdCtrls, CheckLst, Classes,ShellAPI; type TForm1 = class(TForm) Panel1: TPanel; Button1: TButton; Panel2: TPanel; CheckListBox1: TCheckListBox; OpenDialog1: TOpenDialog; Button2: TButton; CheckBox1: TCheckBox; Timer1: TTimer; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private num_link:integer; public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} {Кнопка "открыть" - вызывает открытие файла и заносит ссылки в CheckListBox} procedure TForm1.Button1Click(Sender: TObject); var fName:String; begin if(OpenDialog1.Execute)then begin CheckListBox1.Clear; num_link := 0; fName := OpenDialog1.FileName; CheckListBox1.Items.LoadFromFile(fName); //заносим в CheckListBox все ссылки end; end; {кнопка "старт" - стартует окрытие страниц, только тех, у которыых в CheckListBox установлена галочка} procedure TForm1.Button2Click(Sender: TObject); begin Button2.Tag := 1 xor Button2.Tag; // просто меняем флаг у кнопки (реверсия) Timer1.Enabled := Button2.Tag = 1; // стартуем таймер или останавливаем if(Button2.Tag = 1)then Button2.Caption := 'стоп' else Button2.Caption := 'старт'; end; {CheckBox1 - с надписью "пометить все" если галка стоит - помечает все ссылки иначе снимает пометку (вдруг их моного)} procedure TForm1.CheckBox1Click(Sender: TObject); var i:integer; begin for i:=0 to CheckListBox1.Items.Count-1 do CheckListBox1.Checked[i] := CheckBox1.Checked; end; procedure TForm1.Timer1Timer(Sender: TObject); begin repeat if(CheckListBox1.Checked[num_link])then //запускаем только те, которые отмечены begin shellExecute(0,'open',PChar(CheckListBox1.Items[num_link]),nil, nil, SW_SHOWNORMAL); inc(num_link); break; end; inc(num_link); until(num_link = CheckListBox1.Items.Count); if(num_link = CheckListBox1.Items.Count)then Button2.Click; end; end. --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 22.07.2007, 14:23

Отвечает: Vlad Cepesh Здравствуйте, Колпаков Александр Константинович! Попробуйте вот это. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ShellApi; type TForm1 = class(TForm) Timer1: TTimer; procedure FormActivate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} var sait: TextFile; saitname: string; P:PAnsiChar; procedure TForm1.FormActivate(Sender: TObject); begin AssignFile(sait, 'sait.txt'); Reset(sait); if IOResult <> 0 then begin MessageDlg('Îøèáêà äîñòóïà ê ôàéëó', mtError, [mbOk],0); exit; end; while not EOF(sait) do begin readln(sait, saitname); P:=PAnsiChar(saitname); ShellExecute(handle, 'open', P, nil, nil, SW_SHOW); Timer1.Enabled:=True; end; CloseFile(sait); end; end.

Ответ отправил: Vlad Cepesh (статус: 1-ый класс) Ответ отправлен: 23.07.2007, 10:15

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.53 beta от 09.07.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru