Форум: "Система";
Текущий архив: 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.037 c