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:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
| unit UTelnetstartForm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IniFiles, ExtCtrls, IdRawBase, IdRawClient,
IdIcmpClient, Menus, JvProgressBar, JvExControls, JvComponent,
JvWaitingGradient;
type
TFSWT = class(TForm)
ReAnzeigen: TRichEdit;
IdTCPClient: TIdTCPClient;
cmdSenden: TButton;
ESenden: TEdit;
cmdAusfuehren: TButton;
GBEinstellungen: TGroupBox;
LblIp: TLabel;
LblPasswort: TLabel;
LblBefehlsfolge: TLabel;
LblPort: TLabel;
EIp: TEdit;
EPasswort: TEdit;
EPort: TEdit;
ReBefehle: TRichEdit;
cmdUebernehmen: TButton;
LblCIp: TLabel;
ECIp: TEdit;
MainMenu1: TMainMenu;
Datei1: TMenuItem;
MVerbinden: TMenuItem;
MTrennen: TMenuItem;
N1: TMenuItem;
MSchliessen: TMenuItem;
Label1: TLabel;
JvWaitingGradient: TJvWaitingGradient;
cmdPasswortS: TButton;
procedure CmdVerbindenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IdTCPClientConnected(Sender: TObject);
procedure IdTCPClientDisconnected(Sender: TObject);
procedure cmdSendenClick(Sender: TObject);
procedure EPortChange(Sender: TObject);
procedure EIpChange(Sender: TObject);
procedure EPasswortChange(Sender: TObject);
procedure ReBefehleChange(Sender: TObject);
procedure cmdUebernehmenClick(Sender: TObject);
procedure cmdAusfuehrenClick(Sender: TObject);
procedure MVerbindenClick(Sender: TObject);
procedure MTrennenClick(Sender: TObject);
procedure MSchliessenClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cmdPasswortSClick(Sender: TObject);
private
public
end;
Procedure Anzeigen(Text:string);
Procedure Disconnect();
Function Connect() : boolean;
Procedure Arbeite();
Function PasswortVerschluesseln(Passwort : string) : string;
Function PasswortEntschluesseln(Passwort : string) : string;
Function HexToInt(const S: String): Integer;
type
TReadThread = class(TThread)
private
Nachricht : string;
procedure EingangVerarbeiten;
protected
procedure Execute; override;
end;
type
TPingThread = class(TThread)
private
Nachricht : boolean;
procedure EingangVerarbeiten;
function Ping(Host: String): Boolean;
protected
procedure Execute; override;
end;
var
FSWT : TFSWT;
Thread : TReadThread;
PingThread : TPingThread;
Pfadhtm : String;
Parameter : String;
Passwort : String;
ArbeitenC : boolean;
ArbeitenS : boolean;
Befehl : integer;
Hochfahren : integer;
implementation
{$R *.dfm}
procedure TPingThread.EingangVerarbeiten;
var Zeichen : string;
Begin
If Nachricht = true then
Begin
Anzeigen('Computer ist jetzt Online!');
FSWT.Label1.Enabled := false;
FSWT.JvWaitingGradient.Active := false;
PingThread.Suspend;
Arbeite();
End
else
hochfahren := hochfahren +1;
If hochfahren > 10 then
Begin
Anzeigen('Der Computer hat ein Problem!');
FSWT.Label1.Enabled := false;
FSWT.JvWaitingGradient.Active := false;
PingThread.Suspend;
Arbeite();
End;
End;
procedure TPingThread.Execute;
begin
try
While (not Terminated) and (FSWT.idTCPClient.Connected) do
Begin
If Ping(FSWT.ECIp.Text) = true then
Nachricht := true
else
Nachricht := true;
Synchronize(EingangVerarbeiten);
End;
except
on e: exception do
begin
Anzeigen('* Der Ping Thread hatte irgendein Problem');
end;
end;
end;
procedure TReadThread.EingangVerarbeiten;
var Zeichen : string;
Begin
If Nachricht <> '' then
Begin
If length(Nachricht) > 3 then
Begin
Zeichen := Nachricht[1];
If Zeichen = #$D then
Delete(Nachricht, 1, 1);
End;
If Nachricht = 'Type ? for command help' then
ArbeitenS := true;
Anzeigen('Empfangen: ' + Nachricht);
Arbeite();
End;
End;
procedure TReadThread.Execute;
begin
try
While (not Terminated) and (FSWT.idTCPClient.Connected) do
Begin
Nachricht := FSWT.idTCPClient.ReadLn();
Synchronize(EingangVerarbeiten);
End;
except
on e: exception do
begin
Anzeigen('* Der Read Thread hatte irgendein Problem');
end;
end;
end;
procedure TFSWT.CmdVerbindenClick(Sender: TObject);
begin
Connect();
end;
Procedure Anzeigen(Text:string);
Begin
FSWT.REANzeigen.Lines.Add(Text);
end;
procedure TFSWT.FormCreate(Sender: TObject);
var IniF : TIniFile;
i : integer;
begin
ArbeitenC := false;
Befehl := 0;
Hochfahren := 0;
PfadHtm := ExtractFilePath(ParamStr(0));
Parameter := ParamStr(1);
IniF := TIniFile.Create(PfadHtm + 'config.swt');
EPort.Text := IniF.ReadString('Einstellungen', 'Port', 'Fehler');
EIp.Text := IniF.ReadString('Einstellungen', 'Ip', 'Fehler');
ECIp.Text := IniF.ReadString('Einstellungen', 'CIp', 'Fehler');
Passwort := IniF.ReadString('Einstellungen', 'Password', 'Fehler');
If Passwort <> 'Fehler' then
Passwort := PasswortEntschluesseln(Passwort)
else
Passwort := '';
EPasswort.Text := '';
For i:= 1 to length(Passwort) do
EPasswort.Text := EPasswort.Text + '*';
ReBefehle.Clear;
For i:= 1 to IniF.ReadInteger('Befehlsfolge', 'Menge', 1) do
ReBefehle.Lines.Add(IniF.Readstring('Befehlsfolge', inttostr(i), 'Fehler'));
If Parameter = '-config' then
Begin
GBEinstellungen.Enabled := true;
LblPort.Enabled := true;
LblIp.Enabled := true;
LblCIp.Enabled := true;
LblPasswort.Enabled := true;
LblBefehlsfolge.Enabled := true;
EPort.Enabled := true;
EIp.Enabled := true;
ECIp.Enabled := true;
EPasswort.Enabled := true;
REBefehle.Enabled := true;
End;
cmdUebernehmen.Enabled := false;
cmdPasswortS.Enabled := false;
end;
procedure TFSWT.IdTCPClientConnected(Sender: TObject);
begin
Anzeigen('* Verbunden');
cmdSenden.Enabled := true;
MTrennen.Enabled := true;
MVerbinden.Enabled := false;
Thread := TReadThread.Create(True);
Thread.FreeOnTerminate := True;
PingThread := TPingThread.Create(True);
PingThread.FreeOnTerminate := True;
end;
procedure TFSWT.IdTCPClientDisconnected(Sender: TObject);
begin
Anzeigen('* Getrennt');
ArbeitenS := true;
ArbeitenC := true;
cmdSenden.Enabled := false;
MTrennen.Enabled := false;
MVerbinden.Enabled := true;
Thread.Terminate;
PingThread.Terminate;
end;
procedure TFSWT.cmdSendenClick(Sender: TObject);
begin
Anzeigen('Senden: ' + ESenden.Text);
IdTcpClient.WriteLn(ESenden.Text);
end;
procedure TFSWT.EPortChange(Sender: TObject);
begin
cmdUebernehmen.Enabled := true;
end;
procedure TFSWT.EIpChange(Sender: TObject);
begin
cmdUebernehmen.Enabled := true;
end;
procedure TFSWT.EPasswortChange(Sender: TObject);
begin
cmdPasswortS.Enabled := true;
end;
procedure TFSWT.ReBefehleChange(Sender: TObject);
begin
cmdUebernehmen.Enabled := true;
end;
procedure TFSWT.cmdUebernehmenClick(Sender: TObject);
var IniF : TIniFile;
i,j : integer;
begin
If FileExists(PfadHtm + 'config.swt') = true then DeleteFile(PfadHtm + 'config.swt');
IniF := TIniFile.Create(PfadHtm + 'config.swt');
IniF.Writestring('Einstellungen', 'Port', EPort.Text);
IniF.Writestring('Einstellungen', 'Ip', EIp.Text);
IniF.Writestring('Einstellungen', 'CIp', ECIp.Text);
IniF.Writestring('Einstellungen', 'Password', PasswortVerschluesseln(Passwort));
j:= 0;
For i:= 1 to ReBefehle.Lines.Count + 1 do
begin
If ReBefehle.Lines[i - 1] <> '' then
Begin
IniF.Writestring('Befehlsfolge', inttostr(i), ReBefehle.Lines[i - 1]);
j:= j +1;
End;
end;
IniF.WriteInteger('Befehlsfolge', 'Menge', j);
end;
Function PasswortVerschluesseln(Passwort : string) : string;
var SchriPass : String;
Buchstabe : Integer;
i : integer;
Begin
i:= 1;
While i <= length(Passwort) do
Begin
Buchstabe := ord(Passwort[i]) + 12;
SchriPass := SchriPass + inttohex(Buchstabe,2);
i:= i + 1;
End;
result := SchriPass;
End;
Function PasswortEntschluesseln(Passwort : string) : string;
var DeSchriPass : String;
Buchstabe : String;
i : integer;
Begin
i:= 1;
While i <= length(Passwort) - 1 do
Begin
Buchstabe := Passwort[i] + Passwort[i + 1];
DESchriPass := DeSchriPass + chr(hextoint(Buchstabe) - 12);
i:= i + 2;
End;
result := DeSchriPass;
End;
function HexToInt(const S: String): Integer;
var
I, Ziffer: Integer;
begin
Result := 0;
for I := 1 to length(S) do
begin
Case S[I] of
'0'..'9': Ziffer := Ord(S[I])-Ord('0')+0;
'A'..'F': Ziffer := Ord(S[I])-Ord('A')+10;
'a'..'f': Ziffer := Ord(S[I])-Ord('a')+10
else
raise EConvertError.Create('Ungültiges Zeichen bei Konversion!');
end;
Result := Result*16 + Ziffer;
end;
end;
Function Connect(): boolean;
var res : boolean;
Begin
res := false;
If FSWT.IdTcpClient.Connected = true then
Begin
Anzeigen('* Sie sind schon Online!');
result := res;
Exit;
End;
FSWT.IdTcpClient.Host := FSWT.EIp.Text;
FSWT.IdTcpClient.Port := strtoint(FSWT.EPort.Text);
try
FSWT.IdTcpClient.Connect(5000);
Thread.Resume;
except
Anzeigen('* Es konnte keine Verbindung hergestellt werden.');
exit;
end;
If FSWT.IdTCPClient.Connected = true then
Begin
FSWT.IdTcpClient.writeln(Passwort);
res := true;
End
else
res := false;
result := res;
End;
Procedure Disconnect();
Begin
If FSWT.IdTCPClient.Connected = false then
Begin
Anzeigen('* Sie sind schon Offline!');
Exit;
End;
FSWT.idTCPClient.Disconnect;
End;
procedure TFSWT.cmdAusfuehrenClick(Sender: TObject);
begin
Befehl := 0;
If Connect() = true then
ArbeitenC := true
else
ArbeitenC := false;
end;
Procedure Arbeite();
begin
If (ArbeitenC = true) and (ArbeitenS = true) then
Begin
If (FSWT.ReBefehle.Lines[Befehl] <> '') then
Begin
Anzeigen('Senden: ' + FSWT.ReBefehle.Lines[Befehl]);
FSWT.IdTcpClient.writeln(FSWT.ReBefehle.Lines[Befehl]);
If 'wol' = FSWT.ReBefehle.Lines[Befehl][1] + FSWT.ReBefehle.Lines[Befehl][2]
+ FSWT.ReBefehle.Lines[Befehl][3] then
Begin
Anzeigen('Computer wird jetzt hochgefahren!');
FSWT.Label1.Enabled := true;
FSWT.JvWaitingGradient.Active := true;
Hochfahren := 0;
If PingThread.Suspended = true then
PingThread.Resume;
End;
End
else if (FSWT.ReBefehle.Lines[Befehl] = 'exit') then
Begin
ArbeitenC := false;
ArbeitenS := false;
Befehl := 0;
End;
Befehl := Befehl + 1;
End
End;
function TPingThread.Ping(Host: String): Boolean;
var ICMP: TidIcmpClient;
begin
ICMP:= TidICMPClient.Create(nil);
result:= False;
ICMP.Host:= Host;
ICMP.Ping;
result:= ICMP.ReplyStatus.ReplyStatusType <> rsTimeOut;
ICMP.Free;
end;
procedure TFSWT.MVerbindenClick(Sender: TObject);
begin
Connect();
end;
procedure TFSWT.MTrennenClick(Sender: TObject);
begin
Disconnect();
end;
procedure TFSWT.MSchliessenClick(Sender: TObject);
begin
close;
end;
procedure TFSWT.FormClose(Sender: TObject; var Action: TCloseAction);
begin
If FSWT.IdTCPClient.Connected = true then
Disconnect();
end;
procedure TFSWT.cmdPasswortSClick(Sender: TObject);
var IniF :TIniFile;
i : integer;
begin
IniF := TIniFile.Create(PfadHtm + 'config.swt');
IniF.Writestring('Einstellungen', 'Password', PasswortVerschluesseln(EPasswort.Text));
Passwort := EPasswort.Text;
EPasswort.Text := '';
For i:= 1 to length(Passwort) do
EPasswort.Text := EPasswort.Text + '*';
IniF.Free;
end;
end. |
