Entwickler-Ecke

Internet / Netzwerk - Programm läuft auf anderen Rechnern nicht


Blackdead - Mi 26.09.07 19:39
Titel: Programm läuft auf anderen Rechnern nicht
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:

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 user profile iconNarses: Anhang wegen Virenverdacht gelöscht.


JensLaskowski - Mi 26.09.07 19:43

Also bei mir läuft das Programm wunderbar.

Mit freundlichen Grüßen
JensLaskowski


Blackdead - Mi 26.09.07 20:23

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 - Mi 26.09.07 23:42
Titel: Re: Programm läuft auf anderen Rechnern nicht
Moin und :welcome: im Forum!

user profile iconBlackdead 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?
[...]

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


mexx - Do 27.09.07 08:41

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.


Blackdead - Mi 03.10.07 11:47

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