1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:

//Dust Signs IP address class
// ds_ip.pas
// (c) by Dust Signs Andreas Unterweger 2005

unit ds_ip;

interface

const
  MAX_OCTETS = 4;

type
  TOctetNumber = 1..MAX_OCTETS;

  TBitNumber = 1..8;
  TBitNumberEx = 0..MAX_OCTETS * High(TBitNumber);

  TIPv4AddressClass = (acA, acB, acC, acD, acE, acNone);
  TUseableIPv4AddressClass = (uacA, uacB, uacC, uacNone);

const
  acMulticast = acD;
  acExperimental = acE;

type
  TCustomIPv4Address = class
    protected
      FOctets: Array[TOctetNumber] of Byte;
      FBits: Array[TOctetNumber, 1..High(TBitNumber)] of Boolean;
      function GetOctet(OctetNr: TOctetNumber): Byte;
      procedure SetOctet(OctetNr: TOctetNumber; AValue: Byte);
      function GetIP: Cardinal;
      procedure SetIP(AValue: Cardinal); virtual;
      function GetBit(OctetNr: TOctetNumber; BitNr: TBitNumber): Boolean; overload;
      function GetBit(BitNr: TBitNumberEx): Boolean; overload;
    public
      property IP: Cardinal read GetIP write SetIP;
      property Octets[OctectNr: TOctetNumber]: Byte read GetOctet write SetOctet;
      function ToString: String;
      function ToBinaryString: String;
    end;

  TIPv4Address = class(TCustomIPv4Address)
    public
      constructor Create;
      function GetClass: TIPv4AddressClass;
      function IsPrivate: Boolean;
      function IsLoopback: Boolean;
    end;

  TIPv4SubnetMask = class(TCustomIPv4Address)
    protected
      FAddressClass: TUseableIPv4AddressClass;
      FBorrowedBits: TBitNumberEx;
      procedure SetAddressClass(AValue: TUseableIPv4AddressClass);
      procedure SetIP(AValue: Cardinal); override;
      procedure SetBorrowedBits(AValue: TBitNumberEx);
//      function GetHostCount: Integer;
//      function GetSubnetCount: Integer;
    public
      constructor Create;
      property AddressClass: TUseableIPv4AddressClass read FAddressClass write SetAddressClass;
      function IsValid(var ZeroStart: TBitNumberEx): Boolean; overload;
      function IsValid: Boolean; overload;
      property BitsBorrowed: TBitNumberEx read FBorrowedBits write SetBorrowedBits;
    end;

  TIPv4SubnetHelper = class
    private
      FSubnetMask: TIPv4SubnetMask;
    public
      constructor Create;
      destructor Destroy; override;
      property SubnetMask: TIPv4SubnetMask read FSubnetMask write FSubnetMask;
      function GetNetworkPortion(AnAddress: Cardinal): Cardinal; overload;
      function GetNetworkPortion(AnAddress: TIPv4Address): TIPv4Address; overload;
      function GetHostPortion(AnAddress: Cardinal): Cardinal; overload;
      function GetHostPortion(AnAddress: TIPv4Address): TIPv4Address; overload;
    end;

implementation

function TCustomIPv4Address.GetOctet(OctetNr: TOctetNumber): Byte;
begin
  Result := FOctets[OctetNr];
end;

procedure TCustomIPv4Address.SetOctet(OctetNr: TOctetNumber; AValue: Byte);
var
  i: TBitNumber;
  pos: Byte;
begin
  FOctets[OctetNr] := AValue;
  pos := High(TBitNumber);
  for i := pos downto 1 do begin
    FBits[OctetNr, i] := ((AValue mod 2) = 1);
    AValue := AValue shr 1;
    if AValue = 0 then begin
      pos := i - 1;
      break;
      end;
    end;
  for i := 1 to pos do
    FBits[OctetNr, i] := false;
end;

function TCustomIPv4Address.GetIP: Cardinal;
begin
  Result := (FOctets[1] shl 24) or (FOctets[2] shl 16) or (FOctets[3] shl 8) or FOctets[4];
end;

procedure TCustomIPv4Address.SetIP(AValue: Cardinal);
begin
  SetOctet(1, AValue shr 24);
  SetOctet(2, ((AValue and $00FF0000) shr 16));
  SetOctet(3, ((AValue and $0000FF00) shr 8));
  SetOctet(4, AValue);
end;

function TCustomIPv4Address.ToString: String;
var
  i: TOctetNumber;
  temp: String;
begin
  Result := '';
  for i := 1 to MAX_OCTETS do begin
    Str(FOctets[i], temp);
    Result := Result + temp + '.';
    end;
  SetLength(Result, Length(Result) - 1);
end;

function TCustomIPv4Address.ToBinaryString: String;
var
  i: TBitNumberEx;
begin
  Result := '';
  for i := 1 to High(TBitNumberEx) do begin
    if GetBit(i) then
      Result := Result + '1'
    else
      Result := Result + '0';
    if (i mod High(TBitNumber) = 0) and not (i = High(TBitNumberEx)) then
      Result := Result + '.';
    end;
end;

function TCustomIPv4Address.GetBit(OctetNr: TOctetNumber; BitNr: TBitNumber): Boolean;
begin
  Result := FBits[OctetNr, BitNr];
end;

function TCustomIPv4Address.GetBit(BitNr: TBitNumberEx): Boolean;
begin
  Result := GetBit(BitNr div High(TBitNumber) + 1, BitNr mod High(TBitNumber));
end;

constructor TIPv4Address.Create;
begin
  SetOctet(1, 192);
  SetOctet(2, 168);
  SetOctet(3, 0);
  SetOctet(4, 1);
end;

function TIPv4Address.GetClass: TIPv4AddressClass;
begin
  case FOctets[1] of
    1..127: Result := acA;
    128..191: Result := acB;
    192..223: Result := acC;
    224..239: Result := acD;
    240..255: Result := acE;
    else
      Result := acNone;
    end;
end;

function TIPv4Address.IsPrivate: Boolean;
begin
  Result := false;
  if (FOctets[1] = 10) then
    Result := true;
  if (FOctets[1] = 172) and ((FOctets[2] >= 16) and (FOctets[2] <= 31)) then
    Result := true;
  if (FOctets[1] = 192) and (FOctets[2] = 168) then
    Result := true;
end;

function TIPv4Address.IsLoopback: Boolean;
begin
  Result := (FOctets[1] = 127);
end;

constructor TIPv4SubnetMask.Create;
begin
  inherited;
  SetOctet(1, 255);
  SetOctet(2, 255);
  SetOctet(3, 255);
  SetOctet(4, 0);
  FBorrowedBits := 0;
end;

procedure TIPv4SubnetMask.SetAddressClass(AValue: TUseableIPv4AddressClass);
var
  i, SubnetOctetIndex: TOctetNumber;
begin
  FAddressClass := AValue;
  if AValue <> uacNone then begin
    SubnetOctetIndex := Ord(AValue) + 1;
    for i := 1 to SubnetOctetIndex do
      SetOctet(i, 255);
    for i := SubnetOctetIndex + 1 to MAX_OCTETS do
      SetOctet(i, 0);
    end;
  FBorrowedBits := 0;
end;

procedure TIPv4SubnetMask.SetIP(AValue: Cardinal);
var
  helper: TIPv4SubnetMask;
  zerostart: TBitNumberEx;

  procedure SaveIP;
  var
    i: TOctetNumber;
  begin
    for i := 1 to MAX_OCTETS do
      helper.SetOctet(i, FOctets[i]);
  end;

  procedure RestoreIP;
  var
    i: TOctetNumber;
  begin
    for i := 1 to MAX_OCTETS do
      SetOctet(i, helper.GetOctet(i));
  end;

begin
  helper := TIPv4SubnetMask.Create;
  SaveIP;
  inherited;
  if not IsValid(zerostart) then begin
    RestoreIP;
    helper.Free;
    exit;
    end;
  helper.Free;
  SetAddressClass(uacNone);
end;

function TIPv4SubnetMask.IsValid(var ZeroStart: TBitNumberEx): Boolean;
var
  i: TBitNumberEx;
begin
  Result := false;
  ZeroStart := High(TBitNumberEx);
  if not GetBit(1) then
    exit;
  for i := Low(TBitNumberEx) to High(TBitNumberEx) do begin
    if not GetBit(i) then begin
      ZeroStart := i + 1;
      break;
      end;
    end;
  if ZeroStart = (High(TBitNumberEx) + 1) then
    exit;
  for i := ZeroStart to High(TBitNumberEx) do begin
    if GetBit(i) then
      exit;
    end;
  Result := true;
end;

function TIPv4SubnetMask.IsValid: Boolean;
var
  temp: TBitNumberEx;
begin
  Result := IsValid(temp);
end;

procedure TIPv4SubnetMask.SetBorrowedBits(AValue: TBitNumberEx);
const
  HostBits: Array[TUseableIPv4AddressClass] of TBitNumberEx = (24, 16, 8, 0);
begin
  FBorrowedBits := AValue;
end;

constructor TIPv4SubnetHelper.Create;
begin
  FSubnetMask := TIPv4SubnetMask.Create;
end;

destructor TIPv4SubnetHelper.Destroy;
begin
  FSubnetMask.Free;
end;

function TIPv4SubnetHelper.GetNetworkPortion(AnAddress: Cardinal): Cardinal;
begin
  Result := AnAddress and FSubnetMask.IP;
end;

function TIPv4SubnetHelper.GetNetworkPortion(AnAddress: TIPv4Address): TIPv4Address;
begin
  Result := TIPv4Address.Create;
  Result.IP := GetNetworkPortion(AnAddress.IP);
end;

function TIPv4SubnetHelper.GetHostPortion(AnAddress: Cardinal): Cardinal;
begin
  Result := AnAddress and not FSubnetMask.IP;
end;

function TIPv4SubnetHelper.GetHostPortion(AnAddress: TIPv4Address): TIPv4Address;
begin
  Result := TIPv4Address.Create;
  Result.IP := GetHostPortion(AnAddress.IP);
end;

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

procedure TForm2.FormCreate(Sender: TObject);
var
  h: TIPv4SubnetHelper;
  i: TIPv4Address;
begin
  h := TIPv4SubnetHelper.Create;
  i := TIPv4Address.Create;
  try
    with i do begin
      Octets[1] := 10;
      Octets[2] := 251;
      Octets[3] := 100;
      Octets[4] := 1;
      ShowMessage(ToString);
      ShowMessage(ToBinaryString);
      end;
    with h.SubnetMask do begin
      AddressClass := uacA;
      ShowMessage(ToString);
      ShowMessage(ToBinaryString);
      end;
  finally
    FreeAndNil(i);
    FreeAndNil(h);
    end;
end;