[Midmal]

Создаю широковещательно сетевое приложение, рассылающее магический пакет на сетевые карты всех компьютеров в локальной сети. Цель как уже понятно пробудить клиентские машины сразу же после включения серверной. Задумка проста и хороша, ещё один шаг к автоматизации управления и абсолютной ленивости. Но не всё так здорово и классно как хотелось бы, как обычно возникают подводные камни. Для начала приведу свой код, смотрим ниже...

Код:

procedure WakeUpComputer(MacAddress: string);
var
  FirstByte, SecondByte, ThirdByte: Byte;
  Package: array of Byte;
  UDPClientSocket: TIdUDPClient;
begin
  Windows.Beep(10000, 100);
  try
    SetLength(Package, 102);
    for FirstByte := 0 to 5 do
    begin
      Package[FirstByte] := $FF;
    end;
    for FirstByte := 1 to 16 do
    begin
      SecondByte := FirstByte * 6;
      for ThirdByte := 0 to 5 do
      begin
        Package[SecondByte + ThirdByte] := HexToInt(MacAddress[ThirdByte * 2
        + 1] + MacAddress[ThirdByte * 2 + 2]);
      end;
    end;
    UDPClientSocket := TIdUDPClient.Create(nil);
    try
      UDPClientSocket.BroadcastEnabled := True;
      UDPClientSocket.Host := '255.255.255.255';
      UDPClientSocket.Port := 2050;
      UDPClientSocket.SendBuffer(Pointer(Package)^, 103);
    except
      on Problem: Exception do
      begin
        if MessageBox(0, 'Произошла ошибка при открытии соединения',
        'Wake On LAN: Пробуждение сети', MB_ICONSTOP) = 1 then
        begin
          ExitProcess(0);
        end;
      end;
    end;
    UDPClientSocket.Free;
    SetLength(Package, 0);
    ExitProcess(0);
  except
    on Problem: Exception do
    begin
      if MessageBox(0, 'Произошла ошибка при генерации пакета',
      'Wake On LAN: Пробуждение сети', MB_ICONSTOP) = 1 then
      begin
        ExitProcess(0);
      end;
    end;
  end;
end;

Как видно из выше представленного куска кода - это знакомая многим до боли процедура посылающая магический пакет (WOL). Собственно в чём проблема, проблема в том что при вызове процедуры выскакивает последнее исключение: Произошла ошибка при генерации пакета.
Хм... Что же не так, то есть в чём мой косяк?

[NIch]

Как-то до боли похоже на
http://ru.wikipedia.org/wiki/Wake-on-LAN

[Midmal]

Сообщение от NIch

Как-то до боли похоже на
http://ru.wikipedia.org/wiki/Wake-on-LAN

Я не спрашиваю на что это похоже, я спрашиваю что препятствует правильному выполнению процедуры!

[PhoeniX]

Подозреваю, что вот тут ты накосячил:

Код:

UDPClientSocket.SendBuffer(Pointer(Package)^, 103);

А вообще, дебаг наше всё

[Lucky192]

В принципе нормально у вас все написано - у меня пакеты отправляются, ошибок нет. Но есть нюансы:
1. Зачем лишний байт отправляете (103 вместо 102) - опечатка?
2. Лучше вместо SendBuffer(pointer(Package)^, 102) все-таки написать SendBuffer(Package[0], length(Package)), хотя результат тот же останется.
3. Если у вас сервер, у него возможно несколько подсетей/сетевых интерфейсов. Так вот и Windows XP и Windows 7 некорректно работают с широковещательными пакетами в таких случаях. Компонент Indy эту ошибку не исправляет. Нужно вручную перечислить доступные интерфейсы, узнать широковещательный адрес для каждого в отдельности и слать несколько широковещательных пакетов, указывая конкретный широковещательный адрес для подсети. В противном случае все широковещательные пакеты уйдут только в одну подсеть.

P.S. Лучше уберите блоки exception вообще - из-за них не видно кода ошибки, а без него все разговоры - гадание на кофейной гуще. Ваши сообщения "...при генерации...", "...при открытии..." ясности не добавляют, скорее наоборот. И блок finally на удаление клиента не вижу...

[Lucky192]

Код:

type
  TMACAddress = packed record
    case integer of
    0: (s1,s2,s3,s4,s5,s6 : byte; );
    1: (cmp1:word; cmp2:integer;);
  end;

  TWakeupMagicPacket = packed record
    FillFF : array [0..5] of byte;
    Mac  : array [0..15] of TMACAddress;
  end;

function TryStrToMac(str:string; var mac:TMACAddress):boolean;
var a,b:integer;
const ToHex = '0123456789ABCDEF';
begin
  Result:=false;
  str:=AnsiUpperCase(trim(str));
  if length(str)<17 then begin
    mac.cmp1:=0;
    mac.cmp2:=0;
    exit;
  end;
  a:=pos(str[1],ToHex)-1; b:=pos(str[2],ToHex)-1;
  if((a>=0)and(b>=0)and(str[3]='-')) then mac.s1:=a*16+b else exit;
  a:=pos(str[4],ToHex)-1; b:=pos(str[5],ToHex)-1;
  if((a>=0)and(b>=0)and(str[6]='-')) then mac.s2:=a*16+b else exit;
  a:=pos(str[7],ToHex)-1; b:=pos(str[8],ToHex)-1;
  if((a>=0)and(b>=0)and(str[9]='-')) then mac.s3:=a*16+b else exit;
  a:=pos(str[10],ToHex)-1; b:=pos(str[11],ToHex)-1;
  if((a>=0)and(b>=0)and(str[12]='-')) then mac.s4:=a*16+b else exit;
  a:=pos(str[13],ToHex)-1; b:=pos(str[14],ToHex)-1;
  if((a>=0)and(b>=0)and(str[15]='-')) then mac.s5:=a*16+b else exit;
  a:=pos(str[16],ToHex)-1; b:=pos(str[17],ToHex)-1;
  if((a>=0)and(b>=0)) then mac.s6:=a*16+b else exit;
  Result:=true;
end;

function TryWakeUpComputer(const MacAddress: string):boolean;
var i      : integer;
    mac    : TMACAddress;
    pkt    : TWakeupMagicPacket;
begin
  Result := false;
  if not TryStrToMac(MacAddress,mac) then exit;
  FillChar(pkt.FillFF[0],SizeOf(pkt.FillFF),$FF);
  for i:=0 to High(pkt.Mac) do pkt.Mac[i]:=mac;
  with TIdUDPClient.Create(nil) do try
    BroadcastEnabled := True;
    Host := '255.255.255.255';
    Port := 2050;
    SendBuffer(pkt,sizeof(pkt));
    Result := true;
  finally
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not TryWakeUpComputer('01-02-03-04-05-06') then         
  begin
    // Do something...
    ExitProcess(0);
  end;
end;