unit Unit_Client;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ScktComp, IdTCPServer, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, WinSock, IdThreadMgr, IdThreadMgrDefault,
ShellAPI, Buttons;
//Buttons;
type
TForm1 =
class(TForm)
Bevel1: TBevel;
IdTCPClient1: TIdTCPClient;
IdTCPServer1: TIdTCPServer;
GroupBox1: TGroupBox;
Edit1: TEdit;
Label1: TLabel;
IdThreadMgrDefault1: TIdThreadMgrDefault;
SaveDialog1: TSaveDialog;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
Bevel2: TBevel;
function GetIPByName(
const HostName:
String):
String;
function infobox(caption,untercaption:
string):boolean;
procedure connect();
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure IdTCPClient1Connected(Sender: TObject);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure IdTCPClient1Disconnected(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
verbunden:boolean;
{ Private-Deklarationen }
public
mode, message1,filename1:
string;
accept:boolean;
{ Public-Deklarationen }
end;
var
Form1: TForm1;
mode, message1,strm,datei:
string;
stream: TFileStream;
streamsend:boolean;
implementation
uses Unit2, Unit3;
{$R *.DFM}
procedure TForm1.connect();
var ip:
string;
begin
IdTCPServer1.Active:=False;
ip:=getipbyname(edit1.text);
if ip<>'
'
then memo1.lines.add('
Computer '+edit1.text+'
found at '+
ip)
else begin
memo1.lines.add('
Computer '+edit1.text+'
is not available');
exit;
end;
memo1.lines.add('
Trying to connect to '+edit1.text);
IdTcpclient1.Host:=
ip;
Try idTcpclient1.Connect(1000)
EXCEPT
memo1.Lines.add('
Not able to connect to '+edit1.text);
IDTCPServer1.Active:=True;
exit;
end;
end;
function TForm1.infobox(caption,untercaption:
string):boolean;
begin
form2.Label1.caption:=caption;
form2.label2.caption:=untercaption;
form2.ShowModal;
//<----- Hier gibts beim öffnen Probleme
result:=accept;
end;
function Tform1.GetIPByName(
const HostName:
String):
String;
type
TaPInAddr =
array[0..10]
of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
i: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result := '
';
phe := GetHostByName(PChar(HostName));
if phe =
nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
i := 0;
while pPtr^[i] <>
nil do
begin
Result := inet_ntoa(pptr^[i]^);
Inc(i);
end;
WSACleanup;
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
memo1.lines.add('
Client connected');
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
begin
memo1.Lines.add('
Client Disconnected');
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
var
fs:TFilestream;
begin
memo1.lines.add('
Connected to '+edit1.text);
if mode='
message'
then begin
if message1<>'
'
then
memo1.lines.add('
Sending message to the remote Computer');
Idtcpclient1.Writeln(message1);
idtcpclient1.Disconnect;
end;
if (mode='
data')
and (streamsend=False)
then begin
Idtcpclient1.writeln('
~fsm'+opendialog1.filename);
idtcpclient1.Disconnect;
streamsend:=true;
idtcpclient1.connect;
end;
if streamsend=True
then begin
memo1.lines.add('
Trying to send File '+filename1 + '
to the remote computer');
with IdTCPClient1
do
begin
fs := TFileStream.Create(filename1, fmOpenRead);
//Datei in FileStream einlesen
try
OpenWriteBuffer;
//stellt sicher, dass alle Daten versendet werden
try
WriteStream(fs, true, true, 0);
{das 2. true ist wichtig!, da es bewirkt, dass die Größe des Streams mittels WriteInteger zuerst verschickt wird}
CloseWriteBuffer;
except
CancelWriteBuffer;
raise;
end;
finally
Disconnect;
streamsend:=False;
fs.Free;
end;
end;
end;
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var endung,filename,dateiname,text,typ:
string;
fs: TFileStream;
SizeOfIncomingStream: integer;
begin
if streamsend=False
then begin
text:=AThread.Connection.ReadLn();
AThread.connection.disconnect;
typ:=copy(text,0,4);
if typ='
~fsm'
then begin
dateiname:=extractfilename(copy(text,pos('
~fsm',text)+4,length(text)-4));
filename1:=dateiname;
endung:=copy(dateiname,pos('
.',dateiname),length(dateiname)-pos('
.',dateiname)+1);
SaveDialog1.Filter := endung + '
- Dateien|*' + endung + '
|Alle Dateien (*.*)|*.*';
SaveDialog1.FileName := dateiname;
streamsend:=True;
exit;
end;
if form3.visible=False
then
if messagedlg(text+#13#10+'
Would you like to open LAN Message Center',mtConfirmation,[mbyes,mbno],0) = mrYes
then
form3.Show;
//<- Hier gibts Probleme (wenn sich Form3 öffnen soll, wird eine leere Form angezeigt)
if form3.Visible
then form3.Memo1.Lines.Add(text);
exit;
end;
fs := TFileStream.Create('
C:\filestream.tmp', fmCreate
or fmShareExclusive);
with AThread.Connection
do
try
SizeOfIncomingStream := ReadInteger;
//Größe des Streams empfangen
ReadStream(fs, SizeOfIncomingStream);
//und übergeben
finally
streamsend:=False;
Disconnect;
fs.Free;
end;
if infobox('
Incomming File Transmission',filename1) = True
then begin
if not SaveDialog1.Execute
then exit;
filename:=savedialog1.filename;
copyfile(PChar('
C:\filestream.tmp'),PChar(filename),false);
end;
deletefile('
C:\filestream.tmp');
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
IdTCPServer1.Active := FALSE;
IdTCPServer1.Destroy;
IdTCPClient1.Destroy;
end;
procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
memo1.lines.add('
Disconnected from '+edit1.text);
IDTCPServer1.Active:=True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
streamsend:=False;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
form3.show;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
if not opendialog1.Execute
then exit;
form1.mode:='
data';
filename1:=opendialog1.FileName;
connect;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
application.ProcessMessages;
end;
end.
Antwort
28. Okt 2004, 16:26
Lan.FS
Zitat
Linear-Darstellung
