Klient i Serwer Osobno Bez Zbednych Rzeczy...

0

mam spory problem... przeszperalem po serwisie i znalazlem w dziale download projekt do przesylania plikow Clientsocket<>ServerSocket... problem tylko w tym, ze to sa dwa programy w jednym, a nie rodzielone na Server i Klient... do tego wyskakuja pytania i trzeba wybierac jaki plik sie wysyla... ja juz sam sobie napisalem server i klient, jestem ladnie podlaczony i wiem jaki plik chce wyslac... nie potrzebuje takich zbednych rzeczy... niestety nie wiem jak zamienic ten kod, aby nie potrzebne bylo pytanie, nie wybieralo sie plikow i byly dwa odzielne programy...


unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp, ComCtrls, ExtCtrls, XPMan;

const
  Count = 512;  // za jednym razem wysylanych bedzie 512 bajt?w ( 0,5 kB )

type
  { taki rekord bedzie wysylany na samym poczatku wysylania plikow }
  TRecord = packed record
    FSize : Int64; // rozmiar pliku
    FName : String[128]; // nazwa pliku
  end;

  TMainForm = class(TForm)
    Client: TClientSocket;
    Server: TServerSocket;
    btnConnect: TButton;
    edtAddress: TEdit;
    btnSendfile: TButton;
    OpenDialog: TOpenDialog;
    Panel1: TPanel;
    ProgressBar: TProgressBar;
    StatusBar: TStatusBar;
    Bevel1: TBevel;
    lblProgress: TLabel;
    btnDisconnect: TButton;
    cbIsServer: TCheckBox;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ClientConnecting(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure btnSendfileClick(Sender: TObject);
    procedure ServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure btnDisconnectClick(Sender: TObject);
    procedure cbIsServerClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    IsServer : Boolean; // zmienna informuje, czy program robi za serwer, czy tez nie
    RecieveRec : TRecord; // wskazuje na rekord (naglowek) przesylanych danych
    procedure SendFile(const FileName : String); // wysyla plik
    procedure Query(var Rec: TRecord); // wysyla zapytanie, czy uzytkownik chce odebrac plik
  published
  { zdarzenia dla komponentu }
    procedure ReadRecord(Sender: TObject; Socket: TCustomWinSocket);
    procedure RecieveFile(Sender: TObject; Socket: TCustomWinSocket);
    procedure RecievePercentage(Sender: TObject; Socket: TCustomWinSocket);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

var F : File; // zmienna wskazuje na plik, ktory bedziemy odbierac

(********* ZDARZENIA DLA KOMPONENTU ***************)

procedure TMainForm.btnConnectClick(Sender: TObject);
begin
  Client.Host := edtAddress.Text;  // okreslamy Host, z ktorym chcemy sie polaczyc
  Client.Active := True;  // aktywujemy klienta...
  Server.Active := False; // dezaktywujemy serwer...
  IsServer := False; // nasza aplikacja juz nie jest serwerem
end;

procedure TMainForm.ClientConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.SimpleText := 'Po??czenie z: ' + edtaddress.Text;
end;

procedure TMainForm.ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.SimpleText :=  'Roz??czony.';
  btnConnect.Enabled := True;
  btnDisconnect.Visible := False;
end;
        
procedure TMainForm.btnDisconnectClick(Sender: TObject);
begin
  if IsServer then
    Server.Close
  else Client.Close;

  btnDisconnect.Visible := False;
  btnConnect.Enabled := True;
end;

procedure TMainForm.ServerAccept(Sender: TObject; Socket: TCustomWinSocket);
begin
  IsServer := True;
  StatusBar.SimpleText := 'Akceptuje po??czenie z: ' + Socket.RemoteAddress;
  btnSendfile.Enabled := True;
  btnConnect.Enabled := False;
  btnDisconnect.Visible := True;
end;

procedure TMainForm.ServerClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.SimpleText := 'Po??czony z: ' + Socket.RemoteAddress;
end;

procedure TMainForm.ServerClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.SimpleText := 'Klient roz??czy? si?.';
  CloseFile(F);
  btnDisconnect.Visible := False;
  btnConnect.Enabled := True;
end;

procedure TMainForm.ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  btnSendFile.Enabled := true;
  btnConnect.Enabled := False;
  btnDisconnect.Visible := True;
end;

(********* ZDARZENIA DLA KOMPONENTU - KONIEC ***************)



procedure TMainForm.FormCreate(Sender: TObject);
begin
// na starcie dezaktywuj serwer... nie czekaj na przylaczenie klienta
  cbIsServer.Checked:=false;
  Server.Active := false;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  Client.Close;
  Server.Close;
end;

procedure TMainForm.SendFile(const FileName: String);
var    
  SrcF : File;
  RealSize : Integer;  // realna odczytana wartosc z pliku
  Buffer : array[0..Count] of char;  // bufor przesylanych danych
  TotalSize : Int64;
begin
  TotalSize := 0;
  AssignFile(SrcF, FileName);
  try
  { otwieramy plik zrodlowy i okreslamy jego rozmiar }
    Reset(SrcF, 1);
    lblProgress.Caption := 'Wysy?anie pliku...';
   ProgressBar.Max := FileSize(SrcF);

    if IsServer then
      Server.OnClientRead := RecievePercentage
    else Client.OnRead := RecievePercentage; 

    repeat
      Application.ProcessMessages;
      Sleep(10);

      Seek(SrcF, TotalSize); // przesun na odpowiednia pozycje w pliku
    { tutaj nastepuje odczytanie 1 KB danych i przypisanie ich do bufora }
      BlockRead(SrcF, Buffer, SizeOf(Buffer), RealSize);
     
      if RealSize > 0 then  // jezeli liczba odczytanych bajtow jest wieksza od zera...
      begin
      { wyslij pakiet... }
        if IsServer then
          Server.Socket.Connections[0].SendBuf(Buffer, RealSize)
        else Client.Socket.SendBuf(Buffer, RealSize);
        TotalSize := TotalSize + RealSize;
      end;
    until RealSize = 0;
  finally
    CloseFile(SrcF);
    progressbar.Position:=0;
    lblProgress.Caption := 'Plik wys?ano.';
  end;
end;


procedure TMainForm.btnSendfileClick(Sender: TObject);
var
  Rec: TRecord;
  SrcFile : File;
begin
  if OpenDialog.Execute then
  begin
  { okreslamy zdarzenia poczatkowe dla komponentow }
    Server.OnClientRead := ReadRecord;
    Client.OnRead := ReadRecord;
    
    AssignFile(SrcFile, OpenDialog.FileName);
    try
      Reset(SrcFile, 1); // otworz plik, aby odczytac jego rozmiar...

      Rec.FName := ExtractFileName(Opendialog.FileName); // do rekordu przypisz nazwe pliku
      Rec.FSize := FileSize(SrcFile); // przypisz rozmiar pliku
      Query(Rec); // wyslij zapytanie
      lblProgress.Caption := 'Czekam na akceptacj?...'; // info dla usera...
    finally
      CloseFile(SrcFile);
    end;
  end;
end;

var TotalSize : Int64;  // totalna liczba odczytanych bajtow...

procedure TMainForm.RecieveFile(Sender: TObject; Socket: TCustomWinSocket);
var
  Buffer : array[0..Count] of char;
  RealSize : Int64;
begin
{
   procedura odczytuje przeslane dane i zapisuje do pliku
}

  ProgressBar.Max := RecieveRec.FSize;

{ odczytaj odebrana porcej danych - RealSize oznacza ilosc rzeczywiscie odczytanych bajtow }
  RealSize := Socket.ReceiveBuf(Buffer, SizeOf(Buffer));
  {$I-}
  BlockWrite(F, Buffer, RealSize); // bufor zapisz do pliku
  {$i+}

  TotalSize := TotalSize + RealSize; // okresl realna porcje odczytanych juz danych
  ProgressBar.Position := TotalSize;  // oznacz na komponencie

  Socket.SendText(IntToStr(TotalSize));

   { wyswietl informacje dla uzytkownika }
  lblProgress.Caption := 'Odbieram... ' + CurrToStr(TotalSize / 1024) + '/' + CurrToStr(RecieveRec.FSize / 1024) + ' kB';

  { jezeli ilosc odczytanych danych zgadza sie z rzeczywista iloscia - zamknij plik i zakoncz }
  if RecieveRec.FSize = TotalSize then
  Begin
   CloseFile(F);
   lblProgress.Caption:='Plik odebrano.';
   progressbar.Position:=0;
  end;
end;

procedure TMainForm.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
{
   to zdarzenie czeka na odpowiedz klienta. Jezeli zgodzi sie na odebranie pliku
   to wywolujmemy zdarzenie SendFile...
}
  if Socket.ReceiveText = 'accept' then
  begin
    lblProgress.Caption := 'Jest zgoda na odebranie pliku...';
    SendFile(OpenDialog.FileName); // wywolaj procedure
  end
  else if Socket.ReceiveText = 'no' then Application.MessageBox('Nie masz zgody na przes?anie pliku!', 'B??d', MB_OK + MB_ICONWARNING);
end;


procedure TMainForm.Query(var Rec: TRecord);
begin
{
   ta procedura wysyla zapytanie - rekord, ktory zawiera rozmiar i nazwe pliku.
}
  if IsServer then
    Server.OnClientRead := ClientRead
  else Client.OnRead := ClientRead;

  { wyslij rekord }
  if IsServer then
    Server.Socket.Connections[0].SendBuf(Rec, SizeOF(Rec))
  else Client.Socket.SendBuf(Rec, SizeOF(Rec));
end;

procedure TMainForm.ReadRecord(Sender: TObject; Socket: TCustomWinSocket);
begin
{
   to zdarzenie natomiast odczytuje przeslany rekord i prosi uzytkownika o
   akceptacje na odebranie pliku
}
  Socket.ReceiveBuf(RecieveRec, SizeOF(RecieveRec)); // odbierz naglowek...
  { wyswietl info dla usera }
  if Application.MessageBox(PChar('Czy zgadzasz si? na odebranie pliku ' + RecieveRec.FName +
  ' o rozmiarze ' + CurrToStr(RecieveRec.FSize / 1024) + ' kB?'), 'Potwierdzenie przyjmowania pliku.', MB_YESNO) = id_Yes then
  begin
    AssignFile(F, ExtractFilePath(ParamStr(0)) + RecieveRec.FName);
    ReWrite(F, 1);   // stworz plik do ktorego beda zapisywane dane

    if IsServer then
      Server.OnClientRead := RecieveFile
    else client.OnRead := RecieveFile;

    Socket.SendText('accept'); // wyslij tekst - mozna zaczynac przesylanie...
  end else Socket.SendText('no'); // jezeli uzytkownik nie wyrazi zgody... trudno ;)
end;

procedure TMainForm.cbIsServerClick(Sender: TObject);
begin
  Server.Active := cbIsServer.Checked;
  IsServer := Server.Active;
  if cbIsServer.Checked then
   begin
    btnconnect.Enabled:=false;
    edtaddress.Enabled:=false;
    btnsendfile.Enabled:=false;
   end else
   begin
    btnconnect.Enabled:=true;
    edtaddress.Enabled:=true;
    btnsendfile.Enabled:=true;
   end;
end;

procedure TMainForm.RecievePercentage(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 try
  ProgressBar.Position := StrToInt(Socket.ReceiveText);
  except
  application.ProcessMessages;
end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
btnDisconnect.OnClick(sender);
end;

end.

A tutaj link... http://download.4programmers.net/tmp/Sockets2.zip

0

ktos cos cokolwiek ?

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