offline
- salvarica
- Novi MyCity građanin
- Pridružio: 29 Okt 2004
- Poruke: 20
|
//////////////////////////////////////////////////////
unit ServerForm;
interface
{$WARN UNIT_PLATFORM OFF}
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, FileCtrl, Sockets,WinSock;
const
wm_RefreshClients = wm_User;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
lbClients: TListBox;
Label1: TLabel;
Label2: TLabel;
lbLog: TListBox;
FileListBox1: TFileListBox;
Edit1: TEdit;
Label3: TLabel;
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
public
procedure RefreshClients (var Msg: TMessage);
message wm_RefreshClients;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
lbLog.Items.Add ('Connected: ' +
Socket.RemoteHost + ' (' +
Socket.RemoteAddress + ')' );
end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
lbLog.Items.Add ('Disconnected: ' +
Socket.RemoteHost + ' (' +
Socket.RemoteAddress + ')' );
end;
procedure TForm1.RefreshClients;
begin
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
strCommand, strFile, strFeedback: string;
begin
// read from the client
strCommand := Socket.ReceiveText;
lbLog.Items.Add ('Client: ' + Socket.RemoteAddress + ': ' +
strCommand);
// extract the file name (all commands have 5 characters)
strFile := Copy (strCommand, 6, Length (strCommand) - 5);
if Pos ('MESS!',strCommand) = 1 then
begin
ShowMessage(strFile);
end
// execute program
else if Pos ('EXEC!', strCommand) = 1 then
begin
if FileExists (strFile) and (
WinExec (pChar (strFile), sw_ShowNormal) > 31) then
strFeedback := 'ERROR' + strFile + ' activated'
else
strFeedback := 'ERROR' + strFile + ' not found';
Socket.SendText (strFeedback);
end
// send back a text file
else if Pos ('TEXT!', strCommand) = 1 then
begin
if FileExists (strFile) then
begin
strFeedback := 'TEXT!';
Socket.SendText (strFeedback);
Socket.SendStream (TFileStream.Create (
strFile, fmOpenRead or fmShareDenyWrite));
end
else
begin
strFeedback := 'ERROR' + strFile + ' not found';
Socket.SendText (strFeedback);
end;
end
// send back a bitmap file
else if Pos ('BITM!', strCommand) = 1 then
begin
if FileExists (strFile) then
begin
strFeedback := 'BITM!';
Socket.SendText (strFeedback);
Socket.SendStream (TFileStream.Create (
strFile, fmOpenRead or fmShareDenyWrite));
end
else
begin
strFeedback := 'ERROR' + strFile + ' not found';
Socket.SendText (strFeedback);
end;
end
// send back a directory listing
else if Pos ('LIST!', strCommand) = 1 then
begin
if DirectoryExists (strFile) then
begin
strFeedback := 'LIST!';
Socket.SendText (strFeedback);
FileListBox1.Directory := strFile;
Socket.SendText (FileListBox1.Items.Text);
end
else
begin
strFeedback := 'ERROR' + strFile + ' not found';
Socket.SendText (strFeedback);
end;
end
else
begin
strFeedback := 'ERROR' + 'Undefined command: ' + strCommand;
Socket.SendText (strFeedback);
end;
// log result
lbLog.Items.Add (strFeedback);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
wVersionRequested : WORD;
wsaData : TWSAData;
begin
{Start up WinSock}
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
end;
procedure TForm1.FormShow(Sender: TObject);
var
p : PHostEnt;
s : array[0..128] of char;
p2 : pchar;
begin
{Get the computer name}
GetHostName(@s, 128-);
p := GetHostByName(@s);
Edit1.Text:=(p^.h_Name);
{Get the IpAddress}
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
Edit1.Text:=p2;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
WSACleanup;
end;
end.
/////////////////////////////////////////////////////////////////////////////////////
unit ClientForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, ExtCtrls;
type
TCliStatus = (csIdle, csList, csBitmap, csText, csError);
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
cbActivate: TCheckBox;
EditServer: TEdit;
Label4: TLabel;
btnExec: TButton;
EditServerFile: TEdit;
Label2: TLabel;
ListFiles: TListBox;
Label1: TLabel;
EditDir: TEdit;
btnGetDir: TButton;
LabelDir: TLabel;
Bevel1: TBevel;
btnBitmap: TButton;
btnText: TButton;
Button1: TButton;
Edit1: TEdit;
Label3: TLabel;
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure cbActivateClick(Sender: TObject);
procedure btnExecClick(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure btnGetDirClick(Sender: TObject);
procedure ListFilesClick(Sender: TObject);
procedure btnBitmapClick(Sender: TObject);
procedure btnTextClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
CliStatus: TCliStatus;
Buffer: array [0..9999] of Char;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
CliBmp, CliText;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Caption := 'Connected';
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Caption := 'Disconnected';
end;
procedure TForm1.cbActivateClick(Sender: TObject);
begin
if not ClientSocket1.Active then
ClientSocket1.Address := EditServer.Text;
ClientSocket1.Active := cbActivate.Checked;
end;
procedure TForm1.btnExecClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText ('EXEC!' + EditServerFile.Text);
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
strIn: string;
Stream: TMemoryStream;
nReceived: Integer;
begin
case CliStatus of
// look for data to receive
csIdle:
begin
Socket.ReceiveBuf (Buffer, 5);
strIn := Copy (Buffer, 1, 5);
if strIn = 'TEXT!' then
CliStatus := csText
else if strIn = 'BITM!' then
CliStatus := csBitmap
else if strIn = 'LIST!' then
CliStatus := csList
else if strIn = 'ERROR' then
CliStatus := csError;
end;
// show the messages (might actually not be an error)
csError:
begin
ShowMessage (Socket.ReceiveText);
cliStatus := csIdle;
end;
// get a directory listing
csList:
begin
ListFiles.Items.Text := Socket.ReceiveText;
cliStatus := csIdle;
end;
// read a text file
csText:
begin
with TFormText.Create (Application) do
begin
Memo1.Text := Socket.ReceiveText;
Show;
end;
cliStatus := csIdle;
end;
// read a bitmap file
csBitmap:
with TFormBmp.Create (Application) do
begin
Stream := TMemoryStream.Create;
Screen.Cursor := crHourglass;
try
while True do
begin
nReceived := Socket.ReceiveBuf (Buffer, sizeof (Buffer));
if nReceived <= 0 then
Break
else
Stream.Write (Buffer, nReceived);
// delay (200 milliseconds)
Sleep (200);
end;
// reset and load the temporary file
Stream.Position := 0;
Image1.Picture.Bitmap.LoadFromStream (Stream);
finally
Stream.Free;
Screen.Cursor := crDefault;
end;
Show;
cliStatus := csIdle;
end;
end; // case
end;
procedure TForm1.btnGetDirClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText ('LIST!' + EditDir.Text);
LabelDir.Caption := EditDir.Text;
end;
procedure TForm1.ListFilesClick(Sender: TObject);
begin
EditServerFile.Text := LabelDir.Caption + '\' +
ListFiles.Items [ListFiles.ItemIndex];
end;
procedure TForm1.btnBitmapClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText ('BITM!' + EditServerFile.Text);
end;
procedure TForm1.btnTextClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText ('TEXT!' + EditServerFile.Text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CliStatus := csIdle;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText('MESS!'+Edit1.Text);
end;
end.
|
