Thema: Delphi Wake on Lan mit Indy

Einzelnen Beitrag anzeigen

Benutzerbild von Phoenix
Phoenix
(Moderator)

Registriert seit: 25. Jun 2002
Ort: Hausach
7.613 Beiträge
 
#1

Wake on Lan mit Indy

  Alt 30. Jan 2004, 15:09
Nach einer veröffentlichten Source von SysWorkSoft:

Delphi-Quellcode:
uses
  WinTypes, Messages, SysUtils, Classes, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPClient;


Function HexToInt(S:String): LongInt;
const
  DecDigits: Set Of '0'..'9' = ['0'..'9'];
  HexVals: Array [0..$F] Of Integer = (0, 1, 2, 3, 4, 5, 6, 7,
     8, 9, $A, $B, $C, $D, $E, $F);
  UpCaseHexLetters: Set Of 'A'..'F' = ['A'..'F'];
  LowCaseHexLetters: Set Of 'a'..'f' = ['a'..'f'];
var
  v: LongInt;
  i: integer;
  LookUpIndex: integer;
begin
  if length(S) <= 8 then
  begin
    v := 0;
    for i := 1 to length(S) do
    begin
      {$R-}
        v := v Shl 4;
      {$R+}
      if S[i] in DecDigits then
      begin
          LookUpIndex := Ord(S[i]) - Ord('0');
      end else
      begin
        if S[i] in UpCaseHexLetters then
        begin
          LookUpIndex := Ord(S[i]) - Ord('A') + $A;
        end else
        begin
          if S[i] in LowCaseHexLetters then
          begin
            LookUpIndex := Ord(S[i]) - Ord('a') + $A;
          end else
          begin
            LookUpIndex := 0;
          end;
        end;
      end;
      v := v Or HexVals[LookUpIndex];
    end;
    result := v;
  end else
  begin
    result := 0;
  end;
end;

procedure WakeUPComputer(aMacAddress: string);
var
  i, j: Byte;
  lBuffer: array[1..116] of Byte;
  lUDPClient: TIDUDPClient;
begin
  try
    for i := 1 to 6 do
    begin
      lBuffer[i] := HexToInt(aMacAddress[(i * 2) - 1] + aMacAddress[i * 2]);
    end;
    lBuffer[7] := $00;
    lBuffer[8] := $74;
    lBuffer[9] := $FF;
    lBuffer[10] := $FF;
    lBuffer[11] := $FF;
    lBuffer[12] := $FF;
    lBuffer[13] := $FF;
    lBuffer[14] := $FF;
    for j := 1 to 16 do
    begin
      for i := 1 to 6 do
      begin
        lBuffer[15 + (j - 1) * 6 + (i - 1)] := lBuffer[i];
      end;
    end;
    lBuffer[116] := $00;
    lBuffer[115] := $40;
    lBuffer[114] := $90;
    lBuffer[113] := $90;
    lBuffer[112] := $00;
    lBuffer[111] := $40;
    try
      lUDPClient := TIdUDPClient.Create(nil);
      lUDPClient.BroadcastEnabled := true;
      lUDPClient.Host := '255.255.255.255';
      lUDPClient.Port := 2050;
      lUDPClient.SendBuffer(lBuffer, 116);
      writeln('Trying to wake-up remote host: ' + aMacAddress);
    finally
      lUDPClient.Free;
    end;
  except
   on E: Exception do writeln('There was an error');
  end;
end;
[edit=Matze]Code formatiert. Mfg, Matze[/edit]
Sebastian Gingter
Phoenix - 不死鳥, Microsoft MVP, Rettungshundeführer
Über mich: Sebastian Gingter @ Thinktecture Mein Blog: https://gingter.org

Geändert von Daniel (22. Apr 2011 um 16:45 Uhr)
  Mit Zitat antworten Zitat