Форум: "Система";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Вниз

Com-порт против NT Server   Найти похожие ветки 

← →
Роман   (2004-03-08 18:36) [0]

Проблема: ниже указанная программа работает под 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. Если надо, могу выслать исходник.

---

← →
idiliya   (2004-03-09 15:32) [1]

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

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

---

← →
Роман.   (2004-03-09 16:48) [2]

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

---

← →
Роман.   (2004-03-09 16:50) [3]

Кому: Idiliya.

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

---

← →
Роман.   (2004-03-09 19:08) [4]

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

---

Страницы: 1 вся ветка

Форум: "Система";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.035 c