| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Com-порт против NT Server [D7, Win2k]

Роман ©   (2004-03-08 18:36:00) 

Проблема: ниже указанная программа работает под Win NT 2000 Pro, но не работает под Win NT 2000 Server.(Не выполняются корректно GetCommState и SetCommState).

Далее участок кода:


var
 Form1: TForm1;
 DCB: TDCB;
 Over: OVERLAPPED;
 CommHandle: HFILE;
 arRData: array [0..4] of Byte;
 Success, Logic: boolean;
 OFStruct1: OFSTRUCT;
 vLastError: Cardinal;
 FI: BY_HANDLE_FILE_INFORMATION;

procedure ErrorCheck(var vLastError: Cardinal; var Success, Logic: boolean;
                    pcComment: PChar);

implementation

{$R *.dfm}

// Функция анализа ошибки, получаемой от GetLastError,
// и логического значения функции, присваиваемого переменной Success,
// если она таковое возвращает.
procedure ErrorCheck(var vLastError: Cardinal; var Success, Logic: boolean;
                    pcComment: PChar);
var
 lpMsgBuf: PChar;
begin
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER + FORMAT_MESSAGE_FROM_SYSTEM,
nil, vLastError, LANG_SYSTEM_DEFAULT, @lpMsgBuf, 100, nil);
if vLastError=0 then MessageDlg('Нормальное завершение №'+IntToStr(vLastError)
 +' после '+pcComment+': '+lpMsgBuf, mtInformation, [mbOK], 0)
 else MessageDlg('Ошибка №'+IntToStr(vLastError)+' после '+pcComment+': '
 +lpMsgBuf, mtError, [mbOK], 0);
vLastError:=0;
SetLastError(0);
if Logic then
 begin
 if Success then MessageDlg( 'Функция '+pcComment+' равна "ИСТИНА".', mtInformation, [mbOK], 0)
   else MessageDlg( 'Функция '+pcComment+' равна "ЛОЖЬ".', mtError, [mbOK], 0);
 Success:=true;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Success:=true;
SetLastError(0);
CommHandle:=CreateFile('com1', GENERIC_READ or GENERIC_WRITE, 0, nil,
 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
vLastError:=GetLastError;
Logic:=false;
ErrorCheck(vLastError, Success, Logic,'CreateFile');
Edit1.Text:=IntToStr(CommHandle);
if CommHandle=INVALID_HANDLE_VALUE then
 Edit2.Text:='Ошибка назначения ссылки на файл: INVALID_HANDLE_VALUE';
end;

procedure TForm1.btInitClick(Sender: TObject);
begin
Logic:=true;
ShowMessage('Активация начата!');
DCB.DCBlength:=sizeof(TDCB);
Success:=GetCommState(CommHandle, DCB);
vLastError:=GetLastError;
ErrorCheck(vLastError, Success, Logic, 'GetCommState');
ShowMessage('Начата модификация DCB.');
DCB.BaudRate:=CBR_4800;
DCB.Parity:=NOPARITY;
DCB.ByteSize:=8;
DCB.StopBits:=ONESTOPBIT;
DCB.EvtChar:=Char($80);
ShowMessage('Модификация DCB окончена.');
Success:=SetCommMask(CommHandle, EV_BREAK);
vLastError:=GetLastError;
ErrorCheck(vLastError, Success, Logic, 'SetCommMask');
Success:=SetCommState(CommHandle, DCB);
vLastError:=GetLastError;
ErrorCheck(vLastError, Success, Logic, 'SetCommState');
ShowMessage('Активация окончена!');
end;

procedure TForm1.btQueryClick(Sender: TObject);
var
qbytes: Integer;
wbytes: DWORD;
WString: PChar;
begin
qbytes:=3;
WString:='T1N';
SetLastError(0);
vLastError:=GetLastError;
Logic:=false;
ErrorCheck(vLastError, Success, Logic, ' перед: WriteFile');
Success:=WriteFile(CommHandle, WString, qBytes, wbytes, nil {@Over});
vLastError:=GetLastError;
Logic:=true;
ErrorCheck(vLastError, Success, Logic, 'WriteFile');
Edit3.Text:=IntToStr(wbytes);
end;


P.S. Для "Idiliya". Для исключения ошибок с GetLastError, я ввёл переменную vLastError и выполняю GetLastError сразу полсле CreateFile или другой функции. И всё это оформленно в одну функцию ErrorCheck.
P.S. Спасибо "Idiliya" и "Talla2K" за советы относительно "OPEN_EXISTING" - ошибки под Win2000Pro пректратились, однако под Win 2000 Server не выполняються корректно GetCommState и SetCommState, самое интересное, что CreateFile  и WriteFile выполняются :-(    .
Просьба: найдите возможность проверить код на Win 2000 Server, а не Win 2000 Pro. Если надо, могу выслать исходник.

---

Роман.   (2004-03-09 19:08:00) [1]

Всем спасибо за помощь!
Проблема была в системе!
После установки Service Pack 4 for Windows 2000 программа заработала, ранее стояла Service Pack 3.
:-)

---

Роман.   (2004-03-09 16:50:00) [2]

Кому: Idiliya.

Origin: (в XP Prof ошибок нет)
В WinXP мной ошибок и не ожидалось,
они возникают только под Server версиями.

---

Роман.   (2004-03-09 16:48:00) [3]

Кому: Idiliya.
Нет, на Com1 - ничего нет, а есть на Com2 - нуль-модем для прямого доступа в интернет, но это всё-таки Com2, а не Com1.
Я пробовал запретить устанавливать драйвера мыши на Com1, хотя мышь на PS установлена - не помогло.(Параметр: /NoSerialMice:COM1 в файле boot.ini)

---

idiliya   (2004-03-09 15:32:00) [4]

в код пока особо не вчитывался (в XP Prof ошибок нет)

зы: дурацкий вопрос - у вас там модема на com1 нет? (на системе где не работает)

---

Наверх