www.pudn.com > indyprelim.zip > IdRawFunctions.pas

{ 
  $Project$ 
  $Workfile$ 
  $Revision$ 
  $DateUTC$ 
  $Id$ 
 
  This file is part of the Indy (Internet Direct) project, and is offered 
  under the dual-licensing agreement described on the Indy website. 
  (http://www.indyproject.org/) 
 
  Copyright: 
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. 
} 
{ 
  $Log$ 
} 
{ 
  Rev 1.5    2004.02.03 4:16:50 PM  czhower 
  For unit name changes. 
 
  Rev 1.4    2/1/2004 4:52:30 PM  JPMugaas 
  Removed the rest of the Todo; items. 
 
  Rev 1.3    2/1/2004 4:20:30 PM  JPMugaas 
  Should work in Win32.  TODO: See about DotNET. 
 
  Rev 1.2    2003.10.11 5:49:06 PM  czhower 
  -VCL fixes for servers 
  -Chain suport for servers (Super core) 
  -Scheduler upgrades 
  -Full yarn support 
 
  Rev 1.1    2003.09.30 1:23:00 PM  czhower 
  Stack split for DotNet 
 
  Rev 1.0    11/13/2002 08:45:36 AM  JPMugaas 
} 
 
unit IdRawFunctions; 
 
interface 
{$i IdCompilerDefines.inc} 
 
uses 
   IdGlobal, IdRawHeaders, IdStack; 
 
// ARP 
procedure IdRawBuildArp(const AHwAddressFormat, AProtocolFormat: word; 
  const AHwAddressLen, AProtocolLen: byte; 
  const AnOpType: word; 
  ASenderHw: TIdEtherAddr; 
  ASenderPr: TIdInAddr; 
  ATargetHw: TIdEtherAddr; 
  ATargetPr: TIdInAddr; 
  const APayload : TIdBytes; var VBuffer : TIdBytes); 
// DNS 
procedure IdRawBuildDns(const AnId, AFlags, ANumQuestions, ANumAnswerRecs, ANumAuthRecs, ANumAddRecs: word; 
  const APayload : TIdBytes; 
  var VBuffer : TIdBytes); 
// Ethernet 
procedure IdRawBuildEthernet(ADest, ASource: TIdEtherAddr; AType: word; 
  const APayload : TIdBytes;  var VBuffer : TIdBytes); 
 
 
// ICMP 
procedure IdRawBuildIcmpEcho(AType, ACode: byte; AnId, ASeq: word; 
  const APayload : TIdBytes; var VBuffer : TIdBytes); 
procedure IdRawBuildIcmpMask(AType, ACode: byte; AnId, ASeq: word; AMask: longword; 
  const APayload : TIdBytes; var VBuffer : TIdBytes); 
procedure IdRawBuildIcmpRedirect(const AType, ACode: byte; 
  AGateway: TIdInAddr; 
  const AnOrigLen: word; 
  const AnOrigTos: byte; 
  const AnOrigId, AnOrigFrag: word; 
  const AnOrigTtl, AnOrigProtocol: byte; 
  AnOrigSource, AnOrigDest: TIdInAddr; 
  const AnOrigPayload : TIdBytes; 
  var VBuffer : TIdBytes); 
procedure IdRawBuildIcmpTimeExceed(const AType, ACode: byte; 
  const AnOrigLen: word; 
  const AnOrigTos: byte; 
  const AnOrigId, AnOrigFrag: word; 
  const AnOrigTtl: byte; 
  const AnOrigProtocol: byte; 
  const AnOrigSource, AnOrigDest: TIdInAddr; 
  const AnOrigPayload : TIdBytes; 
  var VBuffer : TIdBytes); 
procedure IdRawBuildIcmpTimestamp(const AType, ACode: byte; 
  const AnId, ASeq: word; 
  const AnOtime, AnRtime, ATtime: TIdNetTime; 
  const APayload : TIdBytes; 
  var VBuffer : TIdBytes); 
procedure IdRawBuildIcmpUnreach(AType, ACode: byte; 
  AnOrigLen: word; 
  AnOrigTos: byte; AnOrigId, AnOrigFrag: word; 
  AnOrigTtl, AnOrigProtocol: byte; 
  AnOrigSource, AnOrigDest: TIdInAddr; 
  const AnOrigPayload, APayloadSize: integer; 
  var VBuffer : TIdBytes); 
 
// IGMP 
procedure IdRawBuildIgmp(AType, ACode: byte; 
  AnIp: TIdInAddr; 
  const APayload : Word; const APayloadSize: integer; 
  var VBuffer : TIdBytes); 
 
// IP 
 
procedure IdRawBuildIp(ALen: word; ATos: byte; AnId, AFrag: word; ATtl, AProtocol: byte; 
  ASource, ADest: TIdInAddr; const APayload : TIdBytes; var VBuffer : TIdBytes; const AIdx : Integer = 0); 
 
// RIP 
procedure IdRawBuildRip(const ACommand, AVersion: byte; 
  const ARoutingDomain, AnAddressFamily, ARoutingTag: word; 
  const AnAddr, AMask, ANextHop, AMetric: longword; 
  const APayload : TIdBytes; 
  var VBuffer : TIdBytes); 
// TCP 
procedure IdRawBuildTcp(const ASourcePort, ADestPort: word; 
  const ASeq, AnAck: longword; 
  const AControl: byte; 
  const AWindowSize, AnUrgent: word; 
  const APayload  : TIdBytes; 
  var VBuffer : TIdBytes); 
 
// UDP 
procedure IdRawBuildUdp(const ASourcePort, ADestPort: word; 
  const APayload :TIdBytes; 
  var VBuffer :TIdBytes); 
 
implementation 
 uses IdSys; 
 
procedure IdRawBuildArp(const AHwAddressFormat, AProtocolFormat: word; 
  const AHwAddressLen, AProtocolLen: byte; 
  const AnOpType: word; 
  ASenderHw: TIdEtherAddr; 
  ASenderPr: TIdInAddr; 
  ATargetHw: TIdEtherAddr; 
  ATargetPr: TIdInAddr; 
  const APayload : TIdBytes; var VBuffer : TIdBytes); 
var 
  HdrArp: TIdArpHdr; 
  LIdx : Integer; 
begin 
  // check input 
 
  LIdx := Id_ARP_HSIZE + Length(VBuffer); 
    if Length(VBuffer) 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer,Id_ICMP_ECHO_HSIZE,Length(APayload)); 
    end; 
 
  // copy header 
    LIdx := 0; 
    HdrArp.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeAndNil(HdrArp); 
  end; 
end; 
 
procedure IdRawBuildDns(const AnId, AFlags, ANumQuestions, ANumAnswerRecs, ANumAuthRecs, ANumAddRecs: word; 
  const APayload : TIdBytes; 
  var VBuffer : TIdBytes); 
var 
  HdrDns: TIdDnsHdr; 
  LIdx : Integer; 
begin 
  // check input 
    LIdx := Length(APayload) +Id_DNS_HSIZE; 
    if Length(VBuffer)0 then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer,Id_DNS_HSIZE,Length(APayload)); 
    end; 
  // copy header 
    LIdx := 0; 
    HdrDns.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeAndNil(HdrDns); 
  end; 
end; 
 
procedure IdRawBuildEthernet(ADest, ASource: TIdEtherAddr; AType: word; 
  const APayload : TIdBytes;  var VBuffer : TIdBytes); 
var 
  HdrEth: TIdEthernetHdr; 
  LIdx : Integer; 
begin 
  // init result 
  HdrEth:= TIdEthernetHdr.create; 
  try 
  // make sure VBuffer will be long enough 
    LIdx := Length(ASource.Data)+ Length(ADest.Data)+2+Length(APayload); 
    if Length(VBuffer)0 then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer,LIdx,Length(APayload)); 
    end; 
  finally 
    Sys.FreeAndNil(HdrEth); 
  end; 
end; 
 
// TODO: check nibbles in IP header 
procedure IdRawBuildIp(ALen: word; ATos: byte; AnId, AFrag: word; ATtl, AProtocol: byte; 
  ASource, ADest: TIdInAddr; const APayload : TIdBytes; var VBuffer : TIdBytes; const AIdx : Integer = 0); 
var 
  HdrIp: TIdIpHdr; 
   LIdx : Integer; 
begin 
  // init result 
  HdrIp :=  TIdIpHdr.create; 
  // check input 
  try 
    LIdx := Id_IP_HSIZE+Length(APayload)+AIdx; 
    if Length(VBuffer)0 then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer,LIdx,Length(APayload)); 
    end; 
  finally 
    Sys.FreeANdNil(HdrIp); 
  end; 
end; 
 
procedure IdRawBuildIcmpEcho(AType, ACode: byte; AnId, ASeq: word; 
  const APayload : TIdBytes; var VBuffer : TIdBytes); 
var 
  HdrIcmp: TIdIcmpHdr; 
   LIdx : Integer; 
begin 
 
  // check input 
  if Length(VBuffer) 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer,Id_ICMP_ECHO_HSIZE,Length(APayload)); 
    end; 
 
    // copy header 
    LIdx := 0; 
    HdrIcmp.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeAndNil(HdrIcmp); 
  end; 
end; 
 
procedure IdRawBuildIcmpMask(AType, ACode: byte; AnId, ASeq: word; AMask: longword; 
  const APayload : TIdBytes; var VBuffer : TIdBytes); 
var 
  HdrIcmp: TIdIcmpHdr; 
  LIdx : Integer; 
begin 
  // check input 
  if Length(VBuffer) 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer, Id_ICMP_MASK_HSIZE,Length(APayload)); 
    end; 
    // copy header 
    LIdx := 0; 
    HdrIcmp.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeANdNil(HdrIcmp); 
  end; 
end; 
 
procedure IdRawBuildIcmpUnreach(AType, ACode: byte; 
  AnOrigLen: word; 
  AnOrigTos: byte; 
  AnOrigId, AnOrigFrag: word; 
  AnOrigTtl, AnOrigProtocol: byte; 
  AnOrigSource, AnOrigDest: TIdInAddr; 
  const AnOrigPayload, APayloadSize: integer; 
  var VBuffer : TIdBytes); 
var 
  HdrIcmp: TIdIcmpHdr; 
  LIdx : Integer; 
begin 
 
 
  // check input 
 if Length(VBuffer) 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer, Id_ICMP_TS_HSIZE,Length(APayload)); 
    end; 
 
    // copy header 
    LIdx := 0; 
    HdrIcmp.WriteStruct(VBuffer,LIdx); 
 
  finally 
    Sys.FreeAndNil(HdrIcmp); 
  end; 
end; 
 
procedure IdRawBuildIcmpRedirect(const AType, ACode: byte; 
  AGateway: TIdInAddr; 
  const AnOrigLen: word; 
  const AnOrigTos: byte; 
  const AnOrigId, AnOrigFrag: word; 
  const AnOrigTtl, AnOrigProtocol: byte; 
  AnOrigSource, AnOrigDest: TIdInAddr; 
  const AnOrigPayload : TIdBytes; 
  var VBuffer : TIdBytes); 
var 
  HdrIcmp: TIdIcmpHdr; 
  LIdx : Integer; 
begin 
  // check input 
  LIdx := Id_ICMP_REDIRECT_HSIZE+Length(AnOrigPayload)+Id_IP_HSIZE; 
   if Length(VBuffer) 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer, Id_RIP_HSIZE,Length(APayload)); 
    end; 
 
    // copy header 
    LIdx := 0; 
    HdrRip.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeAndNil(HdrRip); 
  end; 
end; 
 
// TODO: check nibbles in TCP header 
procedure IdRawBuildTcp(const ASourcePort, ADestPort: word; 
  const ASeq, AnAck: longword; 
  const AControl: byte; 
  const AWindowSize, AnUrgent: word; 
  const APayload  : TIdBytes; 
  var VBuffer : TIdBytes); 
var 
  HdrTcp: TIdTcpHdr; 
  LIdx : Integer; 
begin 
  // check input 
  LIdx := Id_TCP_HSIZE + Length(VBuffer); 
  if Length(VBuffer) 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer, Id_TCP_HSIZE,Length(APayload)); 
    end; 
 
  // copy header 
    LIdx := 0; 
    HdrTcp.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeAndNil(HdrTcp); 
  end; 
end; 
 
procedure IdRawBuildUdp(const ASourcePort, ADestPort: word; 
  const APayload :TIdBytes; 
  var VBuffer :TIdBytes); 
var 
  HdrUdp: TIdUdpHdr; 
  LIdx : Integer; 
begin 
  // check input 
  LIdx := Id_UDP_HSIZE + Length(APayload); 
  if Length(VBuffer)< Lidx then 
  begin 
    SetLength(VBuffer,LIdx); 
  end; 
 
  // construct header 
  HdrUdp:= TIdUdpHdr.create; 
  try 
    HdrUdp.udp_dport    := GStack.HostToNetwork(ASourcePort); 
    HdrUdp.udp_dport    := GStack.HostToNetwork(ADestPort); 
    //LIdx should be okay here since we set that to the packet length earlier 
    HdrUdp.udp_ulen     := GStack.HostToNetwork(LIdx); 
    HdrUdp.udp_sum      := 0; 
 
  // copy payload 
    if (Length(APayload) > 0) then 
    begin 
      CopyTIdBytes(APayload,0,VBuffer, Id_UDP_HSIZE,Length(APayload)); 
    end; 
 
    // copy header 
    LIdx := 0; 
    HdrUdp.WriteStruct(VBuffer,LIdx); 
  finally 
    Sys.FreeAndNil(HdrUdp); 
  end; 
end; 
 
 
end.