Skip to content

Commit c675ef1

Browse files
bluemsbluems
committed
Add 180517
1 parent 85e485a commit c675ef1

File tree

8 files changed

+865
-0
lines changed

8 files changed

+865
-0
lines changed

‎pTCP2Serial.dpr‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
program pTCP2Serial;
2+
3+
uses
4+
Vcl.Forms,
5+
uTCP2SerialMain in 'uTCP2SerialMain.pas' {Form2},
6+
uTCP2SerialClient in 'uTCP2SerialClient.pas',
7+
uTCP2SerialServer in 'uTCP2SerialServer.pas',
8+
uWinSock in 'uWinSock.pas';
9+
10+
{$R *.res}
11+
12+
begin
13+
Application.Initialize;
14+
Application.MainFormOnTaskbar := True;
15+
Application.CreateForm(TForm2, Form2);
16+
Application.Run;
17+
end.

‎pTCP2Serial.dproj‎

Lines changed: 563 additions & 0 deletions
Large diffs are not rendered by default.

‎pTCP2Serial.res‎

58 KB
Binary file not shown.

‎uTCP2SerialClient.pas‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
unit uTCP2SerialClient;
2+
3+
interface
4+
5+
uses
6+
IdWinSock2;
7+
8+
type
9+
TBlueMSRawTCPSocketClient = class(TObject)
10+
11+
end;
12+
13+
implementation
14+
15+
end.

‎uTCP2SerialMain.dfm‎

Lines changed: 145 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,145 @@
1+
object Form2: TForm2
2+
Left = 0
3+
Top = 0
4+
Caption = 'Form2'
5+
ClientHeight = 485
6+
ClientWidth = 657
7+
Color = clBtnFace
8+
Font.Charset = DEFAULT_CHARSET
9+
Font.Color = clWindowText
10+
Font.Height = -11
11+
Font.Name = 'Tahoma'
12+
Font.Style = []
13+
OldCreateOrder = False
14+
OnCreate = FormCreate
15+
PixelsPerInch = 96
16+
TextHeight = 13
17+
object RadioGroup1: TRadioGroup
18+
AlignWithMargins = True
19+
Left = 5
20+
Top = 3
21+
Width = 647
22+
Height = 46
23+
Margins.Left = 5
24+
Margins.Right = 5
25+
Align = alTop
26+
Caption = 'RadioGroup1'
27+
Columns = 2
28+
Items.Strings = (
29+
'Server'
30+
'Client')
31+
TabOrder = 0
32+
end
33+
object GroupBox1: TGroupBox
34+
AlignWithMargins = True
35+
Left = 5
36+
Top = 55
37+
Width = 647
38+
Height = 106
39+
Margins.Left = 5
40+
Margins.Right = 5
41+
Align = alTop
42+
Caption = 'Server'
43+
TabOrder = 1
44+
object cbServerServiceIP: TComboBox
45+
Left = 69
46+
Top = 17
47+
Width = 145
48+
Height = 21
49+
TabOrder = 0
50+
end
51+
object StaticText1: TStaticText
52+
Left = 11
53+
Top = 21
54+
Width = 52
55+
Height = 17
56+
Caption = 'Service IP'
57+
TabOrder = 1
58+
end
59+
object CheckBox1: TCheckBox
60+
AlignWithMargins = True
61+
Left = 233
62+
Top = 18
63+
Width = 70
64+
Height = 83
65+
Align = alRight
66+
Alignment = taLeftJustify
67+
Caption = 'Using ABD?'
68+
TabOrder = 2
69+
ExplicitLeft = 235
70+
ExplicitTop = 19
71+
ExplicitHeight = 17
72+
end
73+
object GroupBox3: TGroupBox
74+
AlignWithMargins = True
75+
Left = 309
76+
Top = 15
77+
Width = 333
78+
Height = 86
79+
Margins.Top = 0
80+
Align = alRight
81+
Caption = 'ABD'
82+
TabOrder = 3
83+
ExplicitTop = 17
84+
ExplicitHeight = 174
85+
object RadioGroup2: TRadioGroup
86+
AlignWithMargins = True
87+
Left = 5
88+
Top = 18
89+
Width = 323
90+
Height = 34
91+
Align = alTop
92+
Caption = 'Type'
93+
Columns = 2
94+
Items.Strings = (
95+
'Called Me'
96+
'Called Device')
97+
TabOrder = 0
98+
ExplicitLeft = 2
99+
ExplicitTop = 15
100+
ExplicitWidth = 329
101+
end
102+
object Panel1: TPanel
103+
AlignWithMargins = True
104+
Left = 5
105+
Top = 58
106+
Width = 323
107+
Height = 26
108+
Align = alTop
109+
BevelOuter = bvNone
110+
TabOrder = 1
111+
ExplicitLeft = 2
112+
ExplicitTop = 55
113+
ExplicitWidth = 329
114+
object StaticText2: TStaticText
115+
Left = 3
116+
Top = 8
117+
Width = 21
118+
Height = 17
119+
Caption = 'Call'
120+
TabOrder = 0
121+
end
122+
object Edit1: TEdit
123+
Left = 30
124+
Top = 3
125+
Width = 121
126+
Height = 21
127+
TabOrder = 1
128+
end
129+
end
130+
end
131+
end
132+
object GroupBox2: TGroupBox
133+
AlignWithMargins = True
134+
Left = 5
135+
Top = 167
136+
Width = 647
137+
Height = 147
138+
Margins.Left = 5
139+
Margins.Right = 5
140+
Align = alTop
141+
Caption = 'Client'
142+
TabOrder = 2
143+
ExplicitTop = 166
144+
end
145+
end

‎uTCP2SerialMain.pas‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
unit uTCP2SerialMain;
2+
3+
interface
4+
5+
uses
6+
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7+
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, uWinSock;
8+
9+
type
10+
TForm2 = class(TForm)
11+
RadioGroup1: TRadioGroup;
12+
GroupBox1: TGroupBox;
13+
GroupBox2: TGroupBox;
14+
cbServerServiceIP: TComboBox;
15+
StaticText1: TStaticText;
16+
CheckBox1: TCheckBox;
17+
GroupBox3: TGroupBox;
18+
RadioGroup2: TRadioGroup;
19+
Panel1: TPanel;
20+
StaticText2: TStaticText;
21+
Edit1: TEdit;
22+
procedure FormCreate(Sender: TObject);
23+
private
24+
{ Private declarations }
25+
public
26+
{ Public declarations }
27+
end;
28+
29+
var
30+
Form2: TForm2;
31+
WS:TWinSockLib;
32+
33+
implementation
34+
35+
{$R *.dfm}
36+
37+
procedure TForm2.FormCreate(Sender: TObject);
38+
begin
39+
WS:=TWinSockLib.Create;
40+
cbServerServiceIP.Items:=(WS.GetIP);
41+
end;
42+
43+
end.

‎uTCP2SerialServer.pas‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
unit uTCP2SerialServer;
2+
3+
interface
4+
5+
uses
6+
IdWinSock2;
7+
8+
type
9+
TBlueMSRawTCPSocketServer = class(TObject)
10+
11+
end;
12+
13+
implementation
14+
15+
end.

‎uWinSock.pas‎

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
unit uWinSock;
2+
3+
interface
4+
5+
uses System.SysUtils,System.classes, Winapi.Windows, WinSock;
6+
7+
type
8+
TWinSockLib = class(TObject)
9+
public
10+
function GetIP(): TStrings;
11+
end;
12+
13+
implementation
14+
15+
{ TWinSockLib }
16+
17+
{ function TWinSockLib.GetIP: String;
18+
var
19+
wData: WSADATA;
20+
HostName: String;
21+
pHostInfo: pHostEnt;
22+
begin
23+
WSAStartup(MAKEWORD(2, 2), wData);
24+
GetHostName(PAnsiChar(HostName), 512);
25+
pHostInfo := GetHostByName(PAnsiChar(HostName));
26+
if Assigned(pHostInfo) then
27+
Result := inttostr(ord(pHostInfo.h_addr_list^[0])) + '.' +
28+
inttostr(ord(pHostInfo.h_addr_list^[1])) + '.' +
29+
inttostr(ord(pHostInfo.h_addr_list^[2])) + '.' +
30+
inttostr(ord(pHostInfo.h_addr_list^[3])){ + '.' +
31+
inttostr(ord(pHostInfo.h_addr_list^[4])) }
32+
{ else
33+
Result := '';
34+
WSACleanup;
35+
end; }
36+
37+
{ TWinSockLib }
38+
39+
function TWinSockLib.GetIP: TStrings;
40+
type
41+
TaPInAddr = array [0 .. 10] of PInAddr;
42+
PaPInAddr = ^TaPInAddr;
43+
var
44+
phe: PHostEnt;
45+
pptr: PaPInAddr;
46+
Buffer: PAnsiChar;
47+
I: Integer;
48+
WSAData: TWSAData;
49+
begin
50+
WSAStartup(MakeWord(2, 2), WSAData);
51+
Result := TStringList.Create;
52+
Result.Clear;
53+
GetHostName(Buffer, SizeOf(Buffer));
54+
phe := GetHostByName(Buffer);
55+
if phe = nil then
56+
Exit;
57+
pptr := PaPInAddr(phe^.h_addr_list);
58+
I := 0;
59+
while pptr^[I] <> nil do
60+
begin
61+
Result.Add(inet_ntoa(pptr^[I]^));
62+
Inc(I);
63+
end;
64+
WSACleanUp;
65+
end;
66+
67+
end.

0 commit comments

Comments
 (0)