1 | unit UNetworkAddress;
|
---|
2 |
|
---|
3 | {$mode Delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, UCommon, UStringListEx;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TDomainAddress = class(TPersistent)
|
---|
12 | private
|
---|
13 | function GetAsString: string;
|
---|
14 | procedure SetAsString(const Value: string);
|
---|
15 | public
|
---|
16 | Levels: array of string;
|
---|
17 | property AsString: string read GetAsString write SetAsString;
|
---|
18 | end;
|
---|
19 |
|
---|
20 | TAddrClass = (acA, acB, acC, acD, acE);
|
---|
21 |
|
---|
22 | TIpAddress = class(TPersistent)
|
---|
23 | private
|
---|
24 | function GetAddrClass: TAddrClass;
|
---|
25 | function GetAsCardinal: Cardinal;
|
---|
26 | function GetAsString: string;
|
---|
27 | function GetBroadcast: Boolean;
|
---|
28 | procedure SetBroadcast(const Value: Boolean);
|
---|
29 | procedure SetAsCardinal(const Value: Cardinal);
|
---|
30 | procedure SetAsString(const Value: string);
|
---|
31 | public
|
---|
32 | Octets: array[0..3] of Byte;
|
---|
33 | procedure Assign(Source: TPersistent); override;
|
---|
34 | property AsCardinal: Cardinal read GetAsCardinal write SetAsCardinal;
|
---|
35 | property AsString: string read GetAsString write SetAsString;
|
---|
36 | property AddrClass: TAddrClass read GetAddrClass;
|
---|
37 | property Broadcast: Boolean read GetBroadcast write SetBroadcast;
|
---|
38 | end;
|
---|
39 |
|
---|
40 | THostAddressState = (asDomainName, asIpAddress);
|
---|
41 | THostAddress = class(TPersistent)
|
---|
42 | private
|
---|
43 | function GetAsString: string;
|
---|
44 | procedure SetAsString(const Value: string);
|
---|
45 | public
|
---|
46 | State: THostAddressState;
|
---|
47 | DomainName: TDomainAddress;
|
---|
48 | IpAddress: TIpAddress;
|
---|
49 | constructor Create;
|
---|
50 | destructor Destroy; override;
|
---|
51 | property AsString: string read GetAsString write SetAsString;
|
---|
52 | end;
|
---|
53 |
|
---|
54 | implementation
|
---|
55 |
|
---|
56 | { TIpAddress }
|
---|
57 |
|
---|
58 | procedure TIpAddress.Assign(Source: TPersistent);
|
---|
59 | var
|
---|
60 | I: Integer;
|
---|
61 | begin
|
---|
62 | if Assigned(Source) then begin
|
---|
63 | if Source is TIpAddress then begin
|
---|
64 | for I := 0 to High(Octets) do
|
---|
65 | Octets[I] := TIpAddress(Source).Octets[I];
|
---|
66 | end else inherited;
|
---|
67 | end else inherited;
|
---|
68 | end;
|
---|
69 |
|
---|
70 | function TIpAddress.GetAddrClass: TAddrClass;
|
---|
71 | begin
|
---|
72 | if (Octets[3] and $80) = 0 then Result := acA
|
---|
73 | else begin
|
---|
74 | if (Octets[3] and $40) = 0 then Result := acB
|
---|
75 | else begin
|
---|
76 | if (Octets[3] and $20) = 0 then Result := acC
|
---|
77 | else begin
|
---|
78 | if (Octets[3] and $10) = 0 then Result := acD
|
---|
79 | else Result := acE;
|
---|
80 | end;
|
---|
81 | end;
|
---|
82 | end;
|
---|
83 | end;
|
---|
84 |
|
---|
85 | function TIpAddress.GetAsCardinal: Cardinal;
|
---|
86 | begin
|
---|
87 | Result := Octets[0] or (Octets[1] shl 8) or (Octets[2] shl 16) or (Octets[3] shl 24);
|
---|
88 | end;
|
---|
89 |
|
---|
90 | function TIpAddress.GetAsString: string;
|
---|
91 | begin
|
---|
92 | Result := IntToStr(Octets[3]) + '.' + IntToStr(Octets[2]) + '.' +
|
---|
93 | IntToStr(Octets[1]) + '.' + IntToStr(Octets[0]);
|
---|
94 | end;
|
---|
95 |
|
---|
96 | function TIpAddress.GetBroadcast: Boolean;
|
---|
97 | begin
|
---|
98 | Result := AsCardinal = High(Cardinal);
|
---|
99 | end;
|
---|
100 |
|
---|
101 | procedure TIpAddress.SetAsCardinal(const Value: Cardinal);
|
---|
102 | begin
|
---|
103 | Octets[0] := Byte(Value);
|
---|
104 | Octets[1] := Byte(Value shr 8);
|
---|
105 | Octets[2] := Byte(Value shr 16);
|
---|
106 | Octets[3] := Byte(Value shr 24);
|
---|
107 | end;
|
---|
108 |
|
---|
109 | procedure TIpAddress.SetAsString(const Value: string);
|
---|
110 | var
|
---|
111 | Parts: TStringListEx;
|
---|
112 | begin
|
---|
113 | Parts.Explode('.', Value);
|
---|
114 | try
|
---|
115 | // if Length(Parts) = 4 then begin
|
---|
116 | Octets[0] := StrToInt(Parts[3]);
|
---|
117 | Octets[1] := StrToInt(Parts[2]);
|
---|
118 | Octets[2] := StrToInt(Parts[1]);
|
---|
119 | Octets[3] := StrToInt(Parts[0]);
|
---|
120 | // end else raise EConvertError.Create('String to IP address conversion error');
|
---|
121 | except
|
---|
122 | raise EConvertError.Create('String to IP address conversion error');
|
---|
123 | end;
|
---|
124 | end;
|
---|
125 |
|
---|
126 | procedure TIpAddress.SetBroadcast(const Value: Boolean);
|
---|
127 | begin
|
---|
128 | AsCardinal := High(Cardinal);
|
---|
129 | end;
|
---|
130 |
|
---|
131 | { TDomainAddress }
|
---|
132 |
|
---|
133 | function TDomainAddress.GetAsString: string;
|
---|
134 | var
|
---|
135 | I: Integer;
|
---|
136 | begin
|
---|
137 | Result := '';
|
---|
138 | for I := High(Levels) downto 0 do
|
---|
139 | Result := Result + '.' + Levels[I];
|
---|
140 | Delete(Result, 1, 1);
|
---|
141 | end;
|
---|
142 |
|
---|
143 | procedure TDomainAddress.SetAsString(const Value: string);
|
---|
144 | var
|
---|
145 | StrArray: TStringListEx;
|
---|
146 | I: Integer;
|
---|
147 | begin
|
---|
148 | StrArray := TStringListEx.Create;
|
---|
149 | StrArray.Explode('.', Value);
|
---|
150 | SetLength(Levels, Length(StrArray.Text));
|
---|
151 | for I := 0 to Length(StrArray.Text) - 1 do
|
---|
152 | Levels[Length(StrArray.Text) - 1 - I] := StrArray[I];
|
---|
153 | StrArray.Destroy;
|
---|
154 | end;
|
---|
155 |
|
---|
156 | { THostAddress }
|
---|
157 |
|
---|
158 | constructor THostAddress.Create;
|
---|
159 | begin
|
---|
160 | DomainName := TDomainAddress.Create;
|
---|
161 | IpAddress := TIpAddress.Create;
|
---|
162 | State := asDomainName;
|
---|
163 | DomainName.AsString := 'localhost';
|
---|
164 | end;
|
---|
165 |
|
---|
166 | destructor THostAddress.Destroy;
|
---|
167 | begin
|
---|
168 | DomainName.Free;
|
---|
169 | IpAddress.Free;
|
---|
170 | inherited;
|
---|
171 | end;
|
---|
172 |
|
---|
173 | function THostAddress.GetAsString: string;
|
---|
174 | begin
|
---|
175 | case State of
|
---|
176 | asDomainName: Result := DomainName.AsString;
|
---|
177 | asIpAddress: Result := IpAddress.AsString;
|
---|
178 | end;
|
---|
179 | end;
|
---|
180 |
|
---|
181 | procedure THostAddress.SetAsString(const Value: string);
|
---|
182 | begin
|
---|
183 | State := asIpAddress;
|
---|
184 | try
|
---|
185 | IpAddress.AsString := Value;
|
---|
186 | except
|
---|
187 | on EConvertError do State := asDomainName;
|
---|
188 | end;
|
---|
189 | if State = asDomainName then DomainName.AsString := Value;
|
---|
190 | end;
|
---|
191 |
|
---|
192 | end.
|
---|