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:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, winsock, NB30;

type
  TForm1 = class(TForm)
GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    ServerSocket1: TServerSocket;
    ServerBlock: TLabel;
    ClientBlock: TLabel;
    ClientSocket: TClientSocket;
    {***...formularbestandteile
    
    ...***}
    
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1ClientWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1Accept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);

    //Client
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);

    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);

    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);

    procedure Button7Click(Sender: TObject);
    function ExecConsole(const Command: String; var Output, Errors: String): Boolean;
    function GetLocalIPs: String;

  private
      { Private declarations }



  public
    { Public declarations }
  end;

var
  {***lokale variablen***}

implementation

{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var port:integer;
begin

        port:=StrToInt(Edit1.Text);
        ServerSocket1.Port:=port;
        ServerSocket1.Active:=True;
        edit4.text:='Listening ...';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
        if ServerSocket1.Active then
        begin
        ServerSocket1.Socket.Connections[0].SendText(edit6.text);
        edit6.text:='';
        end;
end;

procedure TForm1.ServerSocket1ClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ServerSocket1Accept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
        Checkbox1.Checked:=true;
        edit2.text:=Socket.RemoteAddress;
        edit3.Text:=Socket.RemoteHost;
        edit5.text:=Socket.LocalAddress;
        edit4.text:='Connected';
 end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
        close;
end;

//den Hostnamen auslesen, winsock muss eingebunden werden
function TForm1.GetLocalIPs: String;
type PPInAddr= ^PInAddr;
var
wsaData: TWSAData;
HostInfo: PHostEnt;
HostName: Array[0..255] of Char;
Addr: PPInAddr;
begin
Result:='';
if WSAStartup($0102, wsaData)<>0 then exit;
try
if gethostname(HostName, SizeOf(HostName)) <> 0 then exit;
HostInfo:= gethostbyname(HostName);
if HostInfo=nil then Exit;
Addr:=Pointer(HostInfo^.h_addr_list);
if (Addr=nil) or (Addr^=nil) then exit;
Result:=StrPas(inet_ntoa(Addr^^));
inc(Addr);
while Addr^<>nil do begin
Result:=Result+^M^J+StrPas(inet_ntoa(Addr^^));
inc(Addr);
end;
finally
WSACleanup;
end;
end;


procedure TForm1.Button4Click(Sender: TObject);
var port,i,j:integer;
  Output, Errors: String;
  tmp,S2: TStringList;

begin
        if ServerSocket1.Active then
        begin
        port:=StrToInt(edit9.text);
        ClientSocket.Port:=port;
        ClientSocket.Host:=edit8.text;
        ClientSocket.ClientType:=ctNonBlocking;
        ClientSocket.Active:=true;
        Button3.Enabled:=true;
        Button5.Enabled:=true;
        Button6.Enabled:=false;
        end;
end;
end;

procedure TForm1.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
        Checkbox2.Checked:=true;
        Edit10.Text:=Socket.LocalAddress;
        Edit11.Text:=Socket.LocalHost;
        Memo2.Lines.Clear;
        edit7.Text:='';
        Button1.Enabled:=true;
        edit13.text:=GetLocalIPs;
        //edit13.text:=ExecConsole;
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var p:String;
begin
        p:=Socket.ReceiveText;
        TextvomServer:=p;
        Memo2.Lines.Add(p);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
        ClientSocket.Socket.SendText(edit7.text);
        edit7.text:='';
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
        ServerSocket1.Close;
        ClientSocket.Close;
        Checkbox2.Checked:=false;
        Edit10.Text:='';
        Edit11.Text:='';
        Memo1.Lines.Clear;
        Memo2.Lines.Clear;
        Memo3.Lines.Clear;
        Memo4.Lines.Clear;
        edit7.Text:='';
        Button1.Enabled:=false;
        Button3.Enabled:=false;
        Button4.Enabled:=false;
        Button6.Enabled:=true;

        Checkbox1.Checked:=false;
        edit2.text:='';
        edit3.Text:='';
        edit5.text:='';
        edit12.text:='';
        edit4.text:='Disconnected.....';

end;

procedure TForm1.Button6Click(Sender: TObject);
var port:integer;
begin
        port:=StrToInt(Edit1.Text);
        ServerSocket1.Port:=port;
        ServerSocket1.Active:=True;
        edit4.text:='Listening ...';
        Button4.Enabled:=true;

end;


//---Konsole aufrufen
 function TForm1.ExecConsole(const Command: String; var Output, Errors: String): Boolean;
  var
    StartupInfo: TStartupInfo;  
    ProcessInfo: TProcessInformation;  
    SecurityAttr: TSecurityAttributes;  
    PipeOutputRead, PipeOutputWrite,  
    PipeErrorsRead, PipeErrorsWrite: THandle;

 
  // Pipe in einen String auslesen (speicherschonend)  
  function ReadPipeToString(const hPipe: THandle): String;  
    const  
      MEM_CHUNK_SIZE = 8192; // Blockgröße, mit der Speicher angefordert wird  
    var  
      NumberOfBytesRead,  
      NumberOfBytesTotal: Cardinal;  
  begin  
    Result := ''; // Standard-Ergebnis  
    NumberOfBytesTotal := 0; // noch nichts gelesen  
    repeat  
      SetLength(Result,Length(Result) +MEM_CHUNK_SIZE); // mehr Platz machen  
      // versuchen, aus der Pipe zu lesen  
      if ReadFile(hPipe,(@Result[1+NumberOfBytesTotal])^,MEM_CHUNK_SIZE,  
                  NumberOfBytesRead,NIL) then // hat geklappt  
        Inc(NumberOfBytesTotal,NumberOfBytesRead); // Gesamtanzahl aktualisieren  
      SetLength(Result,NumberOfBytesTotal); // überzählige Bytes abschneiden  
    until (NumberOfBytesRead = 0); // bis die Pipe leer ist  
  end;  

 
begin  
  // Win-API-Strukturen initialisieren/füllen  
  FillChar(ProcessInfo,SizeOf(TProcessInformation),0);  
  FillChar(SecurityAttr,SizeOf(TSecurityAttributes),0);  
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := TRUE;
  SecurityAttr.lpSecurityDescriptor := NIL;  
  CreatePipe(PipeOutputRead,PipeOutputWrite,@SecurityAttr,0);  
  CreatePipe(PipeErrorsRead,PipeErrorsWrite,@SecurityAttr,0);  
  FillChar(StartupInfo,SizeOf(TStartupInfo),0);  
  StartupInfo.cb := SizeOf(StartupInfo);  
  StartupInfo.hStdInput := 0;  
  StartupInfo.hStdOutput := PipeOutputWrite;  
  StartupInfo.hStdError := PipeErrorsWrite;  
  StartupInfo.wShowWindow := SW_HIDE;  
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;  
  // Befehl ausführen (Prozess starten)  
  Result := CreateProcess(NIL,PChar(Command),NIL,NIL,TRUE,
                          CREATE_DEFAULT_ERROR_MODE
                          or CREATE_NEW_CONSOLE  
                          or NORMAL_PRIORITY_CLASS,  
                          NIL,NIL,StartupInfo,ProcessInfo);  
  // Write-Pipes schließen  
  CloseHandle(PipeOutputWrite);  
  CloseHandle(PipeErrorsWrite);  
  if (Result) then begin // konnte der Befehl ausgeführt werden?  
    Output := ReadPipeToString(PipeOutputRead); // Ausgabe-Read-Pipe auslesen  
    Errors := ReadPipeToString(PipeErrorsRead); // Fehler-Read-Pipe auslesen  
    WaitForSingleObject(ProcessInfo.hProcess,INFINITE); // auf Prozessende warten  
    CloseHandle(ProcessInfo.hProcess); // und Handle freigeben  
  end;  
  // Read-Pipes schließen  
  CloseHandle(PipeOutputRead);  
  CloseHandle(PipeErrorsRead);  
end; 

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

procedure TForm1.ClientSocketConnect(Sender: TObject; Socket: TCustomWinSocket);  
begin  
  Checkbox2.Checked:=true;  
  Edit10.Text:=Socket.LocalAddress; // was soll das bringen? ist doch immer das gleiche... ?!
  Edit11.Text:=Socket.LocalHost; // meinst du nicht eher .RemoteAddress und .RemoteHost?
  Memo2.Lines.Clear;  
  edit7.Text:='';  
  Button1.Enabled:=true;  
  edit13.text:=GetLocalIPs;  
  //edit13.text:=ExecConsole;  
end;