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