IPB
ЛогинПароль:

> Внимание!

1. Пользуйтесь тегами кода. - [code] ... [/code]
2. Точно указывайте язык, название и версию компилятора (интерпретатора).
3. Название темы должно быть информативным.
В описании темы указываем язык!!!

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> Передача сообщения, Создание канала передачи данных
сообщение
Сообщение #1


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


Всем привет..Задача:

Имеется два приложения--одно из них серверное(главное), второе - клиентское(не главное). Передача данных т.е. сообщений осуществляется по каналу через протокол NetBios (передача данных вернее сообщений работает хорошо)..Но нужно модернизировать программу т.е. вывести информацию о канале и информацию о сетевом адаптере - пользователю. Как это осуществить?


серверное прил:

program netbios;
uses crt, dos;
type
ncb = record
Cmd: byte;
CCode: byte;
LocalSessionNumber: byte;
NetworkNameNumber: byte;
BufOfs: word;
BufSeg: word;
Size: word;
CallName: array[1..16] of char;
OurName: array[1..16] of char;
ReceiveTimeout: byte;
SendTimeout: byte;
PostRoutineOfs: word;
PostRoutineSeg: word;
AdapterNumber: byte;
FinalCCode: byte;
Reserved: array[1..14] of char;
end;
var
ncbrec: ncb;

procedure Dobavit;
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
FillChar(ncbrec.OurName, 16, 's');
ncbrec.Cmd := $30;
ncbrec.AdapterNumber := 0;
Intr($5c, regs);
end;

procedure Udalit;
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.Cmd := $31;
intr($5c, regs);
end;

procedure Call; {procedura sozdanija kanala}
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.cmd := $10; {v 'Cmd' zanosim kod komandi 'CallW'}
FillChar(ncbrec.CallName, 16, 'r'); {v 'Call' zanosim imya s kem budet sozdan kanal}
intr($5c,regs); {prerivanije}
end;

procedure HangUp; {procedura razriva kanala}
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.cmd := $12;
intr($5c, regs);
end;

procedure Send; {procedura otpravki dannih v kanal}
var
regs:registers;
str: string;
begin
write('Vvedite soobsch: ');
readln(str); {schitivaem vvedennije polzovatelem dannije dlya otpravki}
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.Cmd := $14; {v 'Cmd' zanosim kod komandi 'SendW'}
ncbrec.Size := length(str) + 1; {razmer dannih dlya otpravki}
ncbrec.BufOfs := ofs(str); {ukazivaem smeschenije bufera kotoriy soderzhit dannije dlya otpravki}
ncbrec.BufSeg := seg(str); {ukazivaem segment bufera}
intr($5c, regs); {vizov prerivanija}
end;

begin
with ncbrec do
begin
Cmd := 0;
CCode := 0;
LocalSessionNumber := 0;
NetworkNameNumber := 0;
BufOfs := 0;
BufSeg := 0;
Size := 0;
ReceiveTimeout := 0;
SendTimeout := 0;
PostRoutineOfs := 0;
PostRoutineSeg := 0;
AdapterNumber := 0;
FinalCCode := 0;
end;
clrscr;
Dobavit; {dobavlyaem imya v tablicu imen}
writeln('Dobavleno imya: ', ncbrec.FinalCCode);
writeln('Adapter Number: ', ncbrec.AdapterNumber);
writeln;
if ncbrec.FinalCCode = 0 then begin {esli oshibok net to ->}
Call; {organizuem kanal}
writeln('Call: ',ncbrec.FinalCCode);
writeln;
Send; {otpravlyam dannije v kanal}
writeln;
writeln('Soobsch otpravleno: ',ncbrec.FinalCCode);
writeln;
HangUp; {razriv kanal}
writeln('Hang up: ',ncbrec.FinalCCode);
writeln;
end;
Udalit; {udalyaem imya iz tablici imen}
writeln('Udaleno: ',ncbrec.FinalCCode);
readln;
end.


клиенсткое прил:


program netbios;
uses crt, dos;
type
ncb = record {objavlenije setevogo upravlayuschego bloka i ego peremennih}
Cmd: byte;
CCode: byte;
LocalSessionNumber: byte;
NetworkNameNumber: byte;
BufOfs: word;
BufSeg: word;
Size: word;
CallName: array[1..16] of char;
OurName: array[1..16] of char;
ReceiveTimeout: byte;
SendTimeout: byte;
PostRoutineOfs: word;
PostRoutineSeg: word;
AdapterNumber: byte;
FinalCCode: byte;
Reserved: array[1..14] of char;
end;
var
ncbrec: ncb;

procedure Dobavit; {procedura doabavlenija imeni iz peremennoy 'OurName' v tablicu imen}

var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
FillChar(ncbrec.OurName, 16, 'r');
ncbrec.Cmd := $30;
ncbrec.AdapterNumber := 0;
Intr($5c, regs);
end;

procedure Udalit; {procedura udalenija imeni iz tablici imen}
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.Cmd := $31;
intr($5c,regs);
end;

procedure Listen; {procedora dlya organizacii kanala,ona budet nahoditsya
v ozhidanii poka server ne pozhelaet sozdat kanal}
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.cmd := $11; {v 'Cmd' zanosim kod komandi 'ListenW'}
FillChar(ncbrec.CallName, 16, 's'); {v 'CallName' zanosim imya 'servera' s kotorim budet organizovan kanal}
intr($5c, regs); {vizivaem prerivanije}
end;

procedure HangUp; {procedura razriva kanala}
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.cmd := $12; { v 'Cmd' zanosim kod komandi 'HangUpW'}
intr($5c, regs); {prerivanije}
end;

procedure Polu4it; {procedura priema dannih iz kanala}
var
regs:registers;
str: string;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.Cmd := $15; { v 'Cmd' zanosim kod komandi 'ReceiveW'}
ncbrec.Size := 32;
ncbrec.BufOfs := ofs(str); {ukazivaem smeschenije bufera,dlya priema soobschenij}
ncbrec.BufSeg := seg(str); {ukazivaem segment bufera}
intr($5c, regs); {prerivanije}
writeln('Soobsch: ', str); {vivod poluchennih dannih}
end;

begin
with ncbrec do
begin
Cmd := 0;
CCode := 0;
LocalSessionNumber := 0;
NetworkNameNumber := 0;
BufOfs := 0;
BufSeg := 0;
Size := 0;
ReceiveTimeout := 0;
SendTimeout := 0;
PostRoutineOfs := 0;
PostRoutineSeg := 0;
AdapterNumber := 0;
FinalCCode := 0;
end;
clrscr;
Dobavit; {dobavlyaem imya v tablicu imen}
writeln('Dobavleno imya: ', ncbrec.FinalCCode);
writeln('Adapter Number: ', ncbrec.AdapterNumber);
writeln;
if ncbrec.FinalCCode = 0 then begin {esli pri dobavlenii imeni ne vozniklo oshibok to ->}
Listen; {vizov proceduri ozhidanija servera dalya sozdanija kanala}
writeln('Listen: ',ncbrec.FinalCCode);
writeln;
writeln('Nazhmite "Enter" pri gotovnosti priema...');
readln;
Polu4it; {procedura schitavanija dannih iz kanala}
writeln;
writeln('Polu4eno: ',ncbrec.FinalCCode);
writeln;
HangUp; {razriv kanala}
writeln('Hang up: ',ncbrec.FinalCCode);
writeln;
end;
Udalit; {udalenije imeni iz tablici imen}
writeln('Udaleno imya: ',ncbrec.FinalCCode);
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






> Но нужно модернизировать программу

Перепиши на Дельфи через сокеты.
Потом мне покажешь, что вышло, мне тоже позарез надо эту тему изучить.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


На делфи нельзя нам писать(((тока на чистом паскале.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


нашел один код который выводит инфу о сетевом адаптере и и нфу о канале но проблема в том что этот код написан в Делфи...как можно его преобразовать в паскаль?








procedure TForm1.Button5Click(Sender: TObject);
var
i: integer;
Ends1,Ends2: byte;
NameType,NameStatus: String;
begin
Memo2.Clear();
Memo2.Lines.Add('Текущее состояние сети:');
FillChar(AStat, SizeOf(AStat), #0);
ncb1.ncb_buffer := @AStat;
FillChar(ncb1.ncb_callname,NCBNAMSZ,' ');
ncb1.ncb_callname[0]:='*';
ncb1.ncb_length := SizeOf(TNetBiosInfo);
RunCommand(NCBASTAT,true);
Memo2.Lines.Add('МАС адрес сетевой платы: '+AdapterToString(AStat.AdapterStatus));
Memo2.Lines.Add('Количество имён в таблице: '+IntToStr(AStat.AdapterStatus.name_count));
Memo2.Lines.Add('Имена в таблице: ');
for i := 0 to AStat.AdapterStatus.name_count - 1 do
begin
Ends1 := Byte(AStat.NameBuffer[i].name[NCBNAMSZ - 1]);
Ends2:= Byte(AStat.NameBuffer[i].name_flags) and NAME_FLAGS_MASK and $F0;
case Ends2 of
UNIQUE_NAME: NameType:='Уникальное';
GROUP_NAME: NameType:='Групповое';
end;
Ends2:= Byte(AStat.NameBuffer[i].name_flags) and NAME_FLAGS_MASK;
case Ends2 of
REGISTERING: NameStatus:='Регистрация';
REGISTERED: NameStatus:='Зарегистрированное';
DEREGISTERED: NameStatus:='Завершение_регистрации';
DUPLICATE: NameStatus:='Дублирование';
DUPLICATE_DEREG: NameStatus:='Дублирование_с_ожиданием';
end;
Memo2.Lines.Add(Format('%s <%s> %s %s',[String(AStat.NameBuffer[i].name),IntToHex(Ends1, 2),NameType,NameStatus]));
end;
Memo2.Lines.Add('Версия NetBios: '+IntToStr(Ord(AStat.AdapterStatus.rev_major))+'.'+IntToStr(Ord(AStat.AdapterStatus.rev_minor)));
Memo2.Lines.Add('Количество свободных блоков NCB: '+IntToStr(AStat.AdapterStatus.free_ncbs));
Memo2.Lines.Add('Максимальное количество каналов: '+IntToStr(AStat.AdapterStatus.max_sess));
Memo2.Lines.Add('Максимальный размер датаграммы: '+IntToStr(AStat.AdapterStatus.max_dgram_size));
Memo2.Lines.Add('Количество ожидающих каналов: '+IntToStr(AStat.AdapterStatus.pending_sess));
Memo2.Lines.Add('Тип адаптера (FF для Символического адаптера Кольца или FE для адаптера Ethernet): '+IntToHex(Ord(AStat.AdapterStatus.adapter_type),2));
end




















games online, search engine optimization
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


Вот попытался сделать но результы выодит не важные(не верные)





program netbios;
uses crt, dos;
type
ncb = record
Cmd: byte;
CCode: byte;
LocalSessionNumber: byte;
NetworkNameNumber: byte;
BufOfs: word;
BufSeg: word;
Size: word;
CallName: array[1..16] of char;
OurName: array[1..16] of char;
ReceiveTimeout: byte;
SendTimeout: byte;
PostRoutineOfs: word;
PostRoutineSeg: word;
AdapterNumber: byte;
FinalCCode: byte;
Reserved: array[1..14] of char;
end;

type
adpstat=record
Cmd: byte;
AdpId: array[1..6] of byte;
AdpJmp: byte;
AdpTst: byte;
SftMjr: byte;
SftMnr: byte;
TmInt: word;
Crc: word;
AlgErr: word;
ColErr: word;
AbtErr: word;
TrsCnt: array[1..2] of word;
RcvCnt: array[1..2] of word;

ReTrsm: word;
XResCnt: word;
end;

var
ncbrec: ncb;

adpstatrec:adpstat;

procedure Dobavit;
var
regs: registers;
i: integer;
begin
i := 0;
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
FillChar(ncbrec.OurName, 16, 's');
ncbrec.Cmd := $30;
repeat
ncbrec.AdapterNumber := i;
inc(i);
Intr($5c, regs);
until (ncbrec.FinalCCode <> 35 ) or (i > 15);
end;

procedure Udalit;
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.Cmd := $31;
intr($5c, regs);
end;

procedure Call;
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.cmd := $10;
FillChar(ncbrec.CallName, 16, 'r');
intr($5c,regs);
end;

procedure Status;
var
regs: registers;
i: integer;
begin
i:=0;
regs.ES := seg(adpstatrec);
regs.BX := ofs(adpstatrec);
adpstatrec.Cmd := $33;


intr($5c,regs);
end;








procedure HangUp;
var
regs: registers;
begin
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.cmd := $12;
intr($5c, regs);
end;

procedure Send;
var
regs:registers;
str: string;
begin
write('Vvedite soobsch: ');
readln(str);
regs.ES := seg(ncbrec);
regs.BX := ofs(ncbrec);
ncbrec.Cmd := $14;
ncbrec.Size := length(str) + 1;
ncbrec.BufOfs := ofs(str);
ncbrec.BufSeg := seg(str);
intr($5c, regs);
end;

begin
with ncbrec do
begin
Cmd := 0;
CCode := 0;
LocalSessionNumber := 0;
NetworkNameNumber := 0;
BufOfs := 0;
BufSeg := 0;
Size := 0;
ReceiveTimeout := 0;
SendTimeout := 0;
PostRoutineOfs := 0;
PostRoutineSeg := 0;
AdapterNumber := 0;
FinalCCode := 0;
end;

clrscr;
begin
with adpstatrec do
begin
Cmd := 0;

AdpJmp:=0;
AdpTst:=0;
SftMjr:=0;
SftMnr:=0;
end;


Dobavit;
Status;
writeln('Dobavleno imya: ', ncbrec.FinalCCode);
writeln('Adapter Number: ', ncbrec.AdapterNumber);
writeln ('Adapter Status: ', adpstatrec.AdpJmp);
writeln ('Rezultat samotesta adaptera: ', adpstatrec.AdpTst);
writeln ('Version PO: ', adpstatrec.SftMjr);
Writeln;
if ncbrec.FinalCCode = 0 then begin
Call;
writeln('Call: ',ncbrec.FinalCCode);
writeln;
Send;
writeln;
writeln('Soobsch otpravleno: ',ncbrec.FinalCCode);
writeln;
HangUp;
writeln('Hang up: ',ncbrec.FinalCCode);
writeln;
end;
Udalit;
writeln('Udaleno: ',ncbrec.FinalCCode);
readln;
end;
end.





















hidden object games, search engine optimization
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Это только мне кажется, или у тебя в конце поста "левые" ссылки? Зачем они здесь?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +




да..есть ссылки какие то, они сами приписываются..не знаю как избавиться(














make up games, search engine optimization
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


mea culpa
*****

Группа: Пользователи
Сообщений: 1 372
Пол: Мужской
Реальное имя: Николай

Репутация: -  24  +


Оффигеть.. ну я слышал про подмену выдачи, но это верх спамерской мысли.. сеошники хреновы..

Кажется, тебе нужно переустановить браузер, или систему проверить, видимо какая-то штука прилепилась.


--------------------
"Знаешь, стыдно - когда не видно, что услышал всё, что слушал.."
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Цитата
они сами приписываются..не знаю как избавиться(
А зайди-ка вот сюда: http://whatsmyuseragent.com/, и покажи тот юзерагент (IP-шник не надо smile.gif ), который тебе выдаст сайт. Может, к тебе какая-нибудь гадость вроде AdCentriaIM прилепилась?

(тему потом разделю)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Бывалый
****

Группа: Пользователи
Сообщений: 318
Пол: Мужской

Репутация: -  0  +


мдаа...умы) вот что

Your User Agent: Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1; Trident/4.0; MRSPUTNIK 2, 2, 0, 94; MRA 5.6 (build 03278); GTB6.6; SLCC2; .NET CLR 2.0.50727; .NET CLR 3.5.30729; .NET CLR 3.0.30729; OfficeLiveConnector.1.3; OfficeLivePatch.0.0; InfoPath.1)



















seo packages, search engine optimization

Добавлено через 1 мин.
помогите пожалуйста по теме))


















dress up games, search engine optimization
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 3.12.2020 13:29
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name