Własny komunikator

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

0

A jakie jest pytanie?

0

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

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.

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ć.

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

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.

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.

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.

0

Lol 79 zł miesiecznie xd

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

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