Programm läuft auf anderen Rechnern nicht

Blackdead · Hält's aus hier Beiträge: 8

Hallo.
Ich habe folgendes problem und hoffe ihr könnt mir helfen...
Ich habe ein kleines Programm zur statusabfrage eines Root Servers und einen darauf laufenden wow Server geschrieben.
Es läuft folgendermaßen ab.
Das Programm pingt zuerst den Root Server an, wenn dieser antwortet wird ein ping an den port auf den der wow Server läuft gesendet, andernfalls wird der root weiter angepingt und gewartet bis er antwortet.
Funktioniert auch alles super...bei MIR!!!
wenn ich das programm jedoch an andere leute verschicke sagen die mir das die Serveranzeige immer offline anzeige!
Wisst ihr vielleicht worand das liegt???
Hier der Komplette quellcode:

markieren

Delphi-Quelltext

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:

unit umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  StdCtrls, IdRawBase, IdRawClient, IdIcmpClient, ExtCtrls, Sockets, Menus,
  GIFImg, jpeg, ShellApi, Registry;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ping: TIdIcmpClient;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Timer1: TTimer;
    TcpClient1: TTcpClient;
    PopupMenu1: TPopupMenu;
    TrayIcon1: TTrayIcon;
    Beenden1: TMenuItem;
    Image1: TImage;
    Hide1: TMenuItem;
    Show1: TMenuItem;
    ConnecttoRoot1: TMenuItem;
    StartWoW1: TMenuItem;
    Image2: TImage;
    Image3: TImage;
    Skin1: TMenuItem;
    White1: TMenuItem;
    Red1: TMenuItem;
    Green1: TMenuItem;
    Timer2: TTimer;
    procedure pingReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
    procedure Timer1Timer(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure Hide1Click(Sender: TObject);
    procedure Show1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrayIcon1DblClick(Sender: TObject);
    procedure ConnecttoRoot1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StartWoW1Click(Sender: TObject);
    procedure Red1Click(Sender: TObject);
    procedure White1Click(Sender: TObject);
    procedure Green1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  installpath : String;

implementation

function PortFree(): boolean;
  var
    socket: TTcpClient;
    b: boolean;
  begin
    socket:= TTcpClient.Create(nil);
    socket.RemoteHost:= '87.118.64.139';
    socket.RemotePort:= '8129';
    socket.Active:= True;
    b:= not socket.Connected;
    if not b then socket.Close;
    socket.Destroy;
    PortFree:= b;
  end;

procedure TForm1.White1Click(Sender: TObject);
  var
    regist: TRegistry;
  begin
    regist:=TRegistry.Create;
    regist.RootKey:=HKEY_CURRENT_USER;
    regist.OpenKey('Software\HomeXP\RSS\1.0', true);
    regist.WriteString('Skin', 'white');
    regist.free;
    Image1.Visible := True;
    Image2.Visible := False;
    Image3.Visible := False;
  end;

procedure TForm1.WMNCHitTest (var M: TWMNCHitTest);
  begin
    inherited;
    if M.Result = htClient then M.Result := htCaption;
  end;

{$R *.dfm}

procedure TForm1.Beenden1Click(Sender: TObject);
  begin
    Form1.Close;
  end;

procedure TForm1.ConnecttoRoot1Click(Sender: TObject);
  begin
    ShellExecute(0,nil,'mstsc.exe','/v 87.118.64.139 /f',nil,SW_SHOW);
  end;

procedure TForm1.FormCreate(Sender: TObject);
  var
    regist: TRegistry;
  begin
    Show1.Enabled := False;
    Hide1.Enabled := True;
    regist := TRegistry.Create;
      regist.RootKey := HKEY_CURRENT_USER;
    try
      regist.OpenKey('Software\HomeXP\RSS\1.0', true);
      Form1.Left := regist.ReadInteger('Left');
      Form1.Top := regist.ReadInteger('Top');
      if(regist.ReadString('skin') = 'white')then
        begin
          White1.Click;
        end
      else if(regist.ReadString('skin') = 'red')then
        begin
          Red1.Click;
        end
      else if(regist.ReadString('skin') = 'green')then
        begin
          Green1.Click;
        end;
    except
      Form1.Left := 0;
      Form1.Top := 0;
      White1.Click;
    end;
    regist.free;
    regist := TRegistry.Create;
    regist.RootKey := HKEY_LOCAL_MACHINE;
    try
      regist.OpenKey('SOFTWARE\Blizzard Entertainment\World of Warcraft', true);
      InstallPath := regist.ReadString('InstallPath');
    except
      InstallPath := '';
    end;
    regist.free;
  end;

procedure TForm1.FormDestroy(Sender: TObject);
  var
    regist: TRegistry;
  begin
    regist:=TRegistry.Create;
    regist.RootKey:=HKEY_CURRENT_USER;
    regist.OpenKey('Software\HomeXP\RSS\1.0', true);
    regist.WriteInteger('Left', Form1.Left);
    regist.WriteInteger('Top', Form1.Top);
    regist.free;
  end;

procedure TForm1.Green1Click(Sender: TObject);
  var
    regist: TRegistry;
  begin
    regist:=TRegistry.Create;
    regist.RootKey:=HKEY_CURRENT_USER;
    regist.OpenKey('Software\HomeXP\RSS\1.0', true);
    regist.WriteString('Skin', 'green');
    regist.free;
    Image1.Visible := False;
    Image2.Visible := False;
    Image3.Visible := True;
  end;

procedure TForm1.Hide1Click(Sender: TObject);
  begin
    Form1.Hide;
    Hide1.Enabled := False;
    Show1.Enabled := True;
  end;

procedure TForm1.pingReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
  begin
    if(AReplyStatus.ReplyStatusType = rsEcho )then
      begin
        Label2.Caption := 'Online';
        Label2.Color := clLime;
        TrayIcon1.Hint := 'Server Status - Online';
        Timer2.Enabled := True;
        Timer1.Interval := 1500;
      end
    else
      begin
        Label2.Caption := 'Offline';
        Label2.Color := clRed;
        TrayIcon1.Hint := 'Server Status - Offline';
        Timer2.Enabled := False;
        Timer1.Interval := 2500;
      end;
  end;

procedure TForm1.Red1Click(Sender: TObject);
  var
    regist: TRegistry;
  begin
    regist:=TRegistry.Create;
    regist.RootKey:=HKEY_CURRENT_USER;
    regist.OpenKey('Software\HomeXP\RSS\1.0', true);
    regist.WriteString('Skin', 'red');
    regist.free;
    Image1.Visible := False;
    Image2.Visible := True;
    Image3.Visible := False;
  end;

procedure TForm1.Show1Click(Sender: TObject);
  begin
    Form1.Show;
    Show1.Enabled := False;
    Hide1.Enabled := True;
  end;

procedure TForm1.StartWoW1Click(Sender: TObject);
  begin
    ShellExecute(0,nil,PAnsiChar(installpath+'WoW.exe'),nil,nil,SW_SHOW);
  end;

procedure TForm1.Timer1Timer(Sender: TObject);
  begin
    try
      ping.Host := '192.168.0.1';
      ping.Ping;
    except
      on Exception do Exit;
    end;
  end;

procedure TForm1.Timer2Timer(Sender: TObject);
  begin
    if(label4.caption = 'Online')then
      begin
        Timer2.Interval := 1500;
      end
    else
      begin
        Timer2.Interval := 2500;
      end;
  try
    if(PortFree = false)then
      begin
        if(label4.Caption = 'Offline')then
          begin
            Label4.Caption := 'Online';
            Label4.Color := clLime;
          end;
      end
    else
      begin
        if(label4.Caption = 'Online')then
          begin
            Label4.Caption := 'Offline';
            Label4.Color := clRed;
            MessageBox(0,PAnsiChar('Server Status'),PAnsiChar('WoW Server Status: Offline'),0);
          end;
      end;
  except
    on Exception do Exit;
  end;
  end;

procedure TForm1.TrayIcon1DblClick(Sender: TObject);
  begin
    if(Show1.Enabled = True)then
      begin
        Form1.Show;
        Show1.Enabled := False;
        Hide1.Enabled := True;
      end
    else
      begin
        Form1.Hide;
        Hide1.Enabled := False;
        Show1.Enabled := True;
      end;
  end;

end.

Anbei findet ihr noch die .exe datei zum downloaden.
Ich bedanke mich schoneinmal im Voraus.

Moderiert von Narses: Anhang wegen Virenverdacht gelöscht.

JensLaskowski · Beiträge: 168 Win XP BDS 2006 Architect

Also bei mir läuft das Programm wunderbar.

Mit freundlichen Grüßen
JensLaskowski

_________________
Nichtstun macht nur dann Spaß, wenn man eigentlich viel zu tun hätte.

Blackdead · Hält's aus hier Beiträge: 8

ich hab mein problem nicht richtig beschrieben sry.
das programm sollte auch ausführbar sein, aber er zeigt immer offline an!
der root ist eigentlich 24std am tag online(jetzt auch grade) also müsste der root server auf online stehen!
bei mir steht das er online ist aber bei den anderen nicht!

Narses · Verfasst: Mi 26.09.07 23:42

Moin und

im Forum!

Blackdead hat folgendes geschrieben:

wenn ich das programm jedoch an andere leute verschicke sagen die mir das die Serveranzeige immer offline anzeige!
Wisst ihr vielleicht worand das liegt?
[...]

markieren

Delphi-Quelltext

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

procedure TForm1.Timer1Timer(Sender: TObject);

  begin

    try

      ping.Host := '192.168.0.1';

      ping.Ping;

    except

      on Exception do Exit;

    end;

  end;

Das ist eine private IP, die natürlich niemand anders "von aussen" (unter dieser IP) erreichen kann. :nixweiss:

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

mexx · Beiträge: 1183

Dem kann ich nur zustimmen. Läuft die Anwendung ausserhalb des Netzwerkes 192.168.0.x kann der Ping nicht funktionieren, sofern kein Netzwerkrouting/VPN gemacht wird. Das glaube ich aber nicht. Der anzupingende Server muss über eine externe IP verfügen. Wenn diese defintiv statisch ist, kannst Du diese IP auch im Quelltext verankern. Ansonsten würde ich dem Programm die Fähigkeit geben, die anzupingende IP zu ändern.

_________________
Das Unsympathische an den Computern ist, dass sie nur ja oder nein sagen können, aber nicht vielleicht.

Blackdead · Hält's aus hier Beiträge: 8

ohh danke bin wohl nach ner zeit codeblind geworden ^^.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme