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

Имеется два приложения--одно из них серверное(главное), второе - клиентское(не главное). Передача данных т.е. сообщений осуществляется по каналу через протокол 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.

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

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

На делфи нельзя нам писать(((тока на чистом паскале.

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

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

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

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

Это только мне кажется, или у тебя в конце поста "левые" ссылки? Зачем они здесь?

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














make up games, search engine optimization

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

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

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

(тему потом разделю)

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

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