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

> Внимание!

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

> Передача сообщения, Создание канала передачи данных
dron4ik
сообщение 11.03.2011 21:38
Сообщение #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 
 К началу страницы 
+ Ответить 
 
  Ответить  Открыть новую тему 
Ответов(1 - 9)
-TarasBer-
сообщение 11.03.2011 22:59
Сообщение #2


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

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


Бывалый
****

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

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

На делфи нельзя нам писать(((тока на чистом паскале.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
dron4ik
сообщение 13.03.2011 10:39
Сообщение #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 
 К началу страницы 
+ Ответить 
dron4ik
сообщение 13.03.2011 17:18
Сообщение #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 
 К началу страницы 
+ Ответить 
volvo
сообщение 13.03.2011 17:34
Сообщение #6


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


Бывалый
****

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

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



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














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


mea culpa
*****

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

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

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

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


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


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

(тему потом разделю)
 К началу страницы 
+ Ответить 
dron4ik
сообщение 13.03.2011 20:10
Сообщение #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

 

Режим отображения: Переключить на: Стандартный · Линейный · Переключить на: Древовидный

Подписка на тему · Сообщить другу · Версия для печати · Подписка на этот форум

- Текстовая версия 18.06.2025 14:51
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"