Własny komunikator

Odpowiedz Nowy wątek
2011-07-09 09:43
0

Witam.

Mam taki problem znalazłem kod programu dzięki któremu można wysyłać wiadomość
trochę go zmieniłem aż w końcu utknąłem

Chodzi o to że żeby założyć serwer trzeba wpisać tylko Port
Ale żeby się połączyć trzeba podać Port i IP osoby która założyła serwer lub Host zamiast IP

Kod przycisku połącz:

 
f not Klient.Active then
  begin
    if EditIP.Text <> '' then
      ClintSocket1.Address := EdtIP.Text
    else if EditHost.Text <> '' then   
      ClientSocket1.Host := EdtHost.Text
    else
    begin
      StatusBar1.SimpleText := 'Musisz podać numer IP serwera lub jego nazwę.' ;
      Exit ;
    end ;
 
    if EditPort.Text = '' then
    begin
      StatusBar1.SimpleText := 'Musisz podać numer portu.' ;
      Exit ;
    end ;
    ClientSocket1.Port := StrToInt(EdtPort.Text) ;
 
    Polacz.Enabled := false ;
    ClintSocket1.Active := true ;
  end
  else
  begin
    BtnWyslijPlik.Enabled := false ;
    ClientSocket1.Active := false ;
    BtnPolacz.Caption := 'Połącz' ;
  end ;

Cały Kod programu ( originalny )

unit Kod;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ComCtrls;
 
type
  TForm1 = class(TForm)
    Klient: TClientSocket;
    BtnPolacz: TButton;
    RDoWys: TRichEdit;
    EdtPort: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    EdtHost: TEdit;
    EdtIP: TEdit;
    Label4: TLabel;
    StatBar: TStatusBar;
    BtnPrzeslij: TButton;
    Label5: TLabel;
    ROdebrane: TRichEdit;
    Label6: TLabel;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    BtnWyslijPlik: TButton;
    procedure BtnPolaczClick(Sender: TObject);
    procedure KlientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure KlientConnecting(Sender: TObject; Socket: TCustomWinSocket);
    procedure KlientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure KlientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure BtnPrzeslijClick(Sender: TObject);
    procedure KlientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure BtnWyslijPlikClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  F : TFileStream ;
  RozmiarPliku : Integer ;
  OdbierzPlik , WyslijPlik : Boolean ;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.BtnPolaczClick(Sender: TObject);
begin
  if not Klient.Active then
  begin
    if EdtIP.Text <> '' then
      Klient.Address := EdtIP.Text
    else if EdtHost.Text <> '' then
      Klient.Host := EdtHost.Text
    else
    begin
      StatBar.SimpleText := 'Musisz podać numer IP serwera lub jego nazwę.' ;
      Exit ;
    end ;
 
    if EdtPort.Text = '' then
    begin
      StatBar.SimpleText := 'Musisz podać numer portu.' ;
      Exit ;
    end ;
    Klient.Port := StrToInt(EdtPort.Text) ;
 
    BtnPolacz.Enabled := false ;
    Klient.Active := true ;
  end
  else
  begin
    BtnWyslijPlik.Enabled := false ;
    Klient.Active := false ;
    BtnPolacz.Caption := 'Połącz' ;
  end ;
end;
 
procedure TForm1.KlientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  StatBar.SimpleText := 'Połączono z serwerem.' ;
  BtnPrzeslij.Enabled := true ;
  BtnWyslijPlik.Enabled := true ;
  BtnPolacz.Caption := 'Rozłącz' ;
  BtnPolacz.Enabled := true ;
end;
 
procedure TForm1.KlientConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatBar.SimpleText := 'Trwa łączenie...' ;
end;
 
procedure TForm1.KlientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatBar.SimpleText := 'Rozłączono z serwerem.' ;
  BtnPrzeslij.Enabled := false ;
  BtnWyslijPlik.Enabled := false ;
  BtnPolacz.Caption := 'Połącz' ;
  BtnPolacz.Enabled := true ;
  if OdbierzPlik then
  begin
    OdbierzPlik := false ;
    StatBar.SimpleText := 'Odbieranie pliku przerwane.' ;
    F.Free ;
  end ;
  WyslijPlik := false ;
end;
 
procedure TForm1.KlientError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  case ErrorCode of
    10060 : StatBar.SimpleText := 'Komputer-serwer nie jest w sieci.' ;
    10061 : StatBar.SimpleText := 'Podany port nie jest otwarty na danym komputerze.' ;
    else StatBar.SimpleText := 'Wystąpił błąd, jego kod to: ' + IntToStr(ErrorCode) ;
  end ;
  ErrorCode := 0 ;
  BtnPolacz.Enabled := true ;
end;
 
procedure TForm1.KlientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Odczytane : Integer ;
  Buf : array [1..1024] of Char ;
  Wiadomosc : String ;
  NazwaPliku : String ;
begin
  if OdbierzPlik then
  begin
    Odczytane := Socket.ReceiveBuf(Buf , SizeOf(Buf)) ;
 
    Wiadomosc := Buf ;
    if Pos('/m:m' , Wiadomosc) = 1 then
    begin
      Delete(Wiadomosc , 1 , 4) ;
      ROdebrane.Lines.Add(StrPas(PChar(Wiadomosc))) ;
      SendMessage(ROdebrane.Handle , WM_VSCROLL , SB_BOTTOM , 0) ;
      Exit ;
    end ;
 
    StatBar.SimpleText := 'Odbieram plik, postęp: ' + FormatFloat('0.00' , (F.Position / RozmiarPliku) * 100) + '%' ;
    F.Write(Buf , Odczytane) ;
    if F.Position >= RozmiarPliku then
    begin
      F.Free ;
      StatBar.SimpleText := 'Przesyłanie zakończone sukcesem.' ;
      OdbierzPlik := false ;
      BtnWyslijPlik.Enabled := true ;
    end ;
  end
  else
  begin
    Wiadomosc := Socket.ReceiveText ;
 
    if Wiadomosc = '/m:y' then
    begin
      WyslijPlik := true ;
      while F.Position < F.Size do
      begin
        Application.ProcessMessages ;
        if not WyslijPlik then Break ;
        Sleep(10) ;
 
        Odczytane := F.Read(Buf , SizeOf(Buf)) ;
        Klient.Socket.SendBuf(Buf , Odczytane) ;
        StatBar.SimpleText := 'Przesyłam plik, postęp: ' + FormatFloat('0.00' , (F.Position / F.Size) * 100) + '%' ;
      end ;
      if F.Position < F.Size then StatBar.SimpleText := 'Wysyłanie pliku przerwane.'
      else BtnWyslijPlik.Enabled := true ;
      WyslijPlik := false ;
      F.Free ;
    end
    else if Wiadomosc = '/m:n' then
    begin
      StatBar.SimpleText := 'Użytkownik nie chce odebrać pliku.' ;
      BtnWyslijPlik.Enabled := true ;
      F.Free ;
    end
    else if Pos('/m:p' , Wiadomosc) = 1 then
    begin
      RozmiarPliku := StrToInt(Copy(Wiadomosc , 5 , Pos(';' , Wiadomosc) - 5)) ;
      NazwaPliku := Copy(Wiadomosc , Pos(';' , Wiadomosc) + 1 , Length(Wiadomosc) - Pos(';' , Wiadomosc)) ;
      SaveDlg.FileName := NazwaPliku ;
      if (MessageBox(0 , PAnsiChar('Czy chcesz pobrać plik ' + NazwaPliku + ' (rozmiar: ' + IntToStr(RozmiarPliku div 1024) + ' KB) od użytkownika ' +
            Socket.RemoteAddress + '(' + Socket.RemoteHost + ')?') , 'Pobieranie pliku' ,
            MB_YESNO + MB_ICONINFORMATION) = ID_YES) and (SaveDlg.Execute) then
      begin
        F := TFileStream.Create(SaveDlg.FileName , fmCreate) ;
        OdbierzPlik := true ;
        StatBar.SimpleText := 'Odbieram plik' ;
        Klient.Socket.SendText('/m:y') ;
        BtnWyslijPlik.Enabled := false ;
      end
      else Klient.Socket.SendText('/m:n') ;
    end
    else
    begin
      Delete(Wiadomosc , 1 , 4) ;
      ROdebrane.Lines.Add(Wiadomosc) ;
      SendMessage(ROdebrane.Handle , WM_VSCROLL , SB_BOTTOM , 0) ;
    end ;
  end ;
end;
 
procedure TForm1.BtnPrzeslijClick(Sender: TObject);
begin
  if RDoWys.Text = '' then Exit ;
  ROdebrane.Lines.Add(RDoWys.Text) ;
  SendMessage(ROdebrane.Handle , WM_VSCROLL , SB_BOTTOM , 0) ;
  Klient.Socket.SendText('/m:m' + RDoWys.Text) ;
  RDoWys.Text := '' ;
end;
 
procedure TForm1.BtnWyslijPlikClick(Sender: TObject);
begin
  if OpenDlg.Execute then
  begin
    F := TFileStream.Create(OpenDlg.FileName , fmOpenRead) ;
    Klient.Socket.SendText('/m:p' + IntToStr(F.Size) + ';' + ExtractFileName(OpenDlg.FileName)) ;
    BtnWyslijPlik.Enabled := false ;
  end ;
end;
 
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  WyslijPlik := false ;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 
end;
 
end
 

Kod serwera ( programu gdzie zakładamy serwer , napisany przeze mnie ):

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ComCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ROdebrane: TMemo;
    Edit1: TEdit;
    RDoWys: TMemo;
    ServerSocket1: TServerSocket;
    ClientSocket1: TClientSocket;
    StatusBar1: TStatusBar;
    procedure ServerSocket1Accept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.ServerSocket1Accept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Akceptuje połączenie z ' + Socket.RemoteAddress + '(' + Socket.RemoteHost + ')' ;
  Button1.Enabled := true ;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
ServerSocket1.Port := StrToInt(Edit1.Text) ;
  ServerSocket1.Active := not ServerSocket1.Active ;
 
  if ServerSocket1.Active then
  begin
    StatusBar1.SimpleText := 'Serwer oczekuje na klientów.' ;
    Button1.Caption := 'Dezaktywuj' ;
  end
  else
  begin
    StatusBar1.SimpleText := 'Serwer nieaktywny.' ;
    Button1.Caption := 'Aktywuj' ;
  end ;
 
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
if RDoWys.Text = '' then Exit ;
  if ServerSocket1.Socket.ActiveConnections > 0 then
  begin
    ROdebrane.Lines.Add(RDoWys.Text) ;
    SendMessage(ROdebrane.Handle , WM_VSCROLL , SB_BOTTOM , 0) ;
      ServerSocket1.Socket.Connections[ServerSocket1.Socket.ActiveConnections - 1].SendText('/m:m' + RDoWys.Text) ;
    RDoWys.Text := '' ;
  end ;
end;
 
end.
 

Z góry dzięki za pomoc

edytowany 2x, ostatnio: olesio, 2011-07-09 14:26

Pozostało 580 znaków

2011-07-09 10:48
0

A jakie jest pytanie?


Pozostało 580 znaków

2011-07-09 11:05
0

Jak mam połączyć się z serwerem bez podawania IP Lub Hosta osoby która założyła serwer ?

Pozostało 580 znaków

2011-07-09 11:16
uuu
0

a jak ty się chcesz połączyć z innym komputerem nie znając jego lokalizacji? To tak jakbyś chciał napisać do kogoś list nie znając adresu zamieszkania ani imienia i nazwiska. Adres możesz wpisać "na sztywno" i nie truć użytkownikowi o tym ale gdzieś on pojawić się musi.

Pozostało 580 znaków

2011-07-09 11:43
0

Posłuchaj

ja mam ten program i on ma ten program
ja zakładam serwer na porcie np 8585
I w programie wpisuje port 8585 kilka połącz i możemy gadać.

edytowany 2x, ostatnio: AdaxVV, 2011-07-09 11:51

Pozostało 580 znaków

2011-07-09 11:49
0

Masz racje 2xUp
Dopiero pomyślałem no bo jeśli założę na porcie 8585
a druga osoba będzie się chciała połączyć no to się nie połączy bo program nie będzie wiedziała z kim/jakim serwerem ma się połączyć bo music znać adres. ehh

edytowany 2x, ostatnio: AdaxVV, 2011-07-09 11:50

Pozostało 580 znaków

2011-07-09 11:52
fghj
1

Jeśli to jest na sieć lokalną to wystarczy by server zrobił broadcast na UDP, klient nasłuchując dowie się skąd broadcast pochodzi i wtedy masz IP serwera do którego następnie łączysz się po TCP.

Pozostało 580 znaków

2011-07-09 13:02
0

A nie da się może wykupić jakiegoś serwera
pod aplikacje
chodzi mi np tak jak robi się radio online
można wykupić serwer shoutcast
I dostajemy wtedy IP oraz port
tylko że pod aplikacje.

Pozostało 580 znaków

2011-07-09 13:29
0

Da się. Na przykład na: http://biznes-host.pl możesz wykupić w miarę tani VPS i robić na nim wszystko co jest dozwolone polskim prawem.


Pozostało 580 znaków

2011-07-09 14:02
0

Lol 79 zł miesiecznie xd

Zna ktoś taki serwer który można testwać np przez tydzień albo nawet 24 godz ?

edytowany 1x, ostatnio: AdaxVV, 2011-07-09 14:10

Pozostało 580 znaków

2011-07-09 14:25
0

A kto Tobie karze kupować taki, sprawdziłeś w ogóle ceny? Za 28 pln jest najtańszy i najwyżej jak po miesiącu nie sprosta Twoim oczekiwaniom to możesz nie przedłużyć jego żywotności nie opłacając go. Ja tam postawiłem serwer do gry Kaillera (online) dla polskiej społeczności gry Sensible World of Soccer i jestem zadowolony. Ten za 28 pln ma takie osiągi, że spokojnie starcza, postawiłem na nim przyszłościowo jeszcze serwer Lighttpd, stoi tam też sesja ircowa do logowania na kanale. na Quakenecie. Do tego telefon alarmowy na komórkę gdzie w razie czego można uzyskać pomoc. Nie reklamuje na siłę logoutu, ale jak kończył nam się po roku serwer w czerwcu to znowu była promocja i za 168 pln mamy opłacony serwer na rok, bo taka promocja, że pół roku gratis. Do administracji wystarczy minimalna wiedza na temat unixów/linuxów. Ale widzę, że wszyscy się nauczyli, serwer za darmo itp. Na takim najtańszym vpsie spokojnie możesz się pobawić i postawić później prosty serwer pod linuxy jeżeli takowy napiszesz albo skorzystasz z jakiś gotowych. Dla prostych testów taka maszyna powinna wyrobić, chociaż mogę się mylić. A nawet 79 pln miesięcznie, czymże to jest za swobode samodzielnego konfigurowania (poza datą i ustawieniami revdns, bo to robi serwerownia i admini) i możliwości postawienia różnych usług, gdzie ceny serwerów dedykowanych idą - o ile się orientuje - w wyższe kwoty.


Pozostało 580 znaków

Odpowiedz
Liczba odpowiedzi na stronę

1 użytkowników online, w tym zalogowanych: 0, gości: 1, botów: 0