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