Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Система";
Текущий архив: 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.034 c
7-1079075427
smu
2004-03-12 10:10
2004.05.02
Как очистить кэш дисковода?


14-1081187034
тихий вовочка
2004-04-05 21:43
2004.05.02
Поучите меня


11-1066723048
Ал
2003-10-21 11:57
2004.05.02
Еще раз про "приклеивание" окна к рабочему столу


8-1075293011
АСМиД
2004-01-28 15:30
2004.05.02
Как найти DirectX


8-1075559104
iudjen
2004-01-31 17:25
2004.05.02
mediaplayer





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский