Announcement

**Prinz Michael S.** · 14.09.2004, 12:28

oops ... so hab ich mir das aber nich vorgestellt...
naja ... meldet euch dann kann ich den source code
auch via e-mail schicken
sorr

**Bernhard Geyer** · 14.09.2004, 16:01

PRE-Tags verwenden!

<pre>
function MyFunc(Param1: String): Boolean;
begin
result := False;
end;
</pre&gt

**Prinz Michael S.** · 22.09.2004, 07:14

dumme frage: was ist den ein PRE-TAG ???

und wof�r ist diese "seltsame" function gut???

THX!!

**Bernhard Geyer** · 22.09.2004, 07:24

Dies war ein Beispiel f�r die Verwendung von Pre-Tags. Damit bleibt deine Einr�ckung des Quelltexts vorhanden. 
Schau einfach den Quellcode der Seite an. 

F�r Erkl�rung des Pre-Tags, schau auf <a href="http://de.selfhtml.org/html/referenz/elemente.htm#pre">SelfHtml</a> bzw das <a href="http://de.selfhtml.org/html/text/praeformatiert.htm">Beispiel</a> an

**Michael Koecher** · 22.09.2004, 07:27

Hi, wenn du einfach vor den Sourcecode in spitzen Klammern (&lt) PRE und hinter den Sourcecode /PRE in spitzen Klammern (&gt) schreibst, bleibt die Formatierung erhalten :-)
 Michae

**Prinz Michael S.** · 24.09.2004, 14:31

<PRE>
unit DTT;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ProgressBar1: TProgressBar;
ProgressBar2: TProgressBar;
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Edit1: TEdit;
Label1: TLabel;
StatusBar1: TStatusBar;
ControlBar1: TControlBar;
ListBox1: TListBox;
Edit2: TEdit;
Button3: TButton;
ControlBar2: TControlBar;
Button4: TButton;
Button5: TButton;
Label2: TLabel;
Edit3: TEdit;
Button6: TButton;
StatusBar2: TStatusBar;
OpenDialog1: TOpenDialog;
ClientSocket2: TClientSocket;
ServerSocket2: TServerSocket;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button3Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket2ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket2Read(Sender: TObject; Socket: TCustomWinSocket);

private
{ Private-Deklarationen}
public
{ Public-Deklarationen}
end;

var
Form1: TForm1;
Datei,Ordner :string;
OrdnerI :array of string;
count,gelesen,geschrieben :integer;
FStream: TFileStream;
Buffer: array[1..1024] of Byte;

implementation

{$R *.DFM}

procedure TForm1.ClientSocket2Read(Sender: TObject;
Socket: TCustomWinSocket);
var
ziel :file;
begin
assignfile(ziel,'c:\test.asf');
rewrite(ziel,1);
repeat
Form1.ClientSocket2.Socket.ReceiveBuf(Buffer,1024) ;
blockwrite(ziel,Buffer,1024,geschrieben);
until geschrieben < 1024;

end;

procedure test;
var
DV :file;
begin
assignfile(dv,'e:\test.asf');
reset(dv,1);
repeat
blockread(dv,Buffer,1024,gelesen);
Form1.ServerSocket2.Socket.SendBuf(Buffer,1024);
until gelesen < 1024;

end;

function abhacken(help :string):string;
begin
if length(help) > 25 then
begin
//zeilenumbruch

end;
result := help;
end;

procedure stream();
var
DV :file;
help :integer;

begin
if ((datei <> '') or (ordner <> '') or (OrdnerI[0] <> '')) then
begin
if ((Form1.ServerSocket1.Active) or (Form1.ClientSocket1.Active)) then
begin
if (Form1.ServerSocket1.Socket.ActiveConnections > 0) then
begin
test;

end;
if Form1.ClientSocket1.Socket.Connected then
begin

end;
end
else
begin
Showmessage('Keine Verbindung');
end;
end;
end;

procedure recsuch(Dir: string; ARekursiv: Boolean);
var
SR: TSearchRec;
begin
if (Dir <> '') and (Dir[length(Dir)] <> '\') then
begin
Dir:=Dir + '\';
end;

if (FindFirst(Dir + '*.*',faAnyFile-faDirectory,SR)=0) then
begin
repeat
if (SR.Name<>'.') and (SR.Name<>'..') and (SR.Attr<>faDirectory) then
begin
inc(count);
Setlength(OrdnerI,count);
OrdnerI[count-1] := Dir + SR.Name;
end;
Application.ProcessMessages;
until FindNext(SR)<>0;
FindClose(SR);
end
else
begin
//keine datei gefunden, aber k�nnten jedoch existieren ...
if count = 0 then ARekursiv := true;
end;

if ARekursiv = true then
begin
if (FindFirst(Dir + '*.*',faDirectory,SR)=0) then
begin
repeat
if (SR.Name<>'.') and (SR.Name<>'..') then
begin
recsuch(Dir + SR.Name,True);
end;
Application.ProcessMessages;
until FindNext(SR)<>0;
FindClose(SR);
end;
end;
end;

//////////////not my /////////////////////////////

function GetLocalIPs: String;
type PPInAddr= ^PInAddr;
var
wsaData: TWSAData;
HostInfo: PHostEnt;
HostName: Array[0..255] of Char;
Addr: PPInAddr;
begin
Result:='';
if WSAStartup($0102, wsaData)<>0 then exit;
try
if gethostname(HostName, SizeOf(HostName)) <> 0 then exit;
HostInfo:= gethostbyname(HostName);
if HostInfo=nil then Exit;
Addr:=Pointer(HostInfo^.h_addr_list);
if (Addr=nil) or (Addr^=nil) then exit;
Result:=StrPas(inet_ntoa(Addr^^));
inc(Addr);
while Addr^<>nil do begin
Result:=Result+^M^J+StrPas(inet_ntoa(Addr^^));
inc(Addr);
end;
finally
WSACleanup;
end;
end;

///////////////end not my//////////////////////////////////////////

procedure TForm1.Button1Click(Sender: TObject);
begin
with ServerSocket1 do
begin
Port := 1111;
Active := True;
end;
ClientSocket1.Active := false;
StatusBar1.SimpleText := 'Server wartet auf Client ...';
Label1.Caption := GetLocalIPs;

with ServerSocket2 do
begin
Port := 1112;
Active := True;
end;
ClientSocket2.Active := false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// incomming dir
if not (DirectoryExists('incomming')) then
begin
if not (CreateDir('incomming')) then
begin
Showmessage('Incomming Ordner Konnte nicht erstellt werden');
end;
end;

FStream := nil;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if (Edit1.Text <> '') then
begin
with ClientSocket1 do
begin
Port := 1111;
Address := Form1.Edit1.Text;
Active := True;
end;
ServerSocket1.Active := false;

with ClientSocket2 do
begin
Port := 1112;
Address := Form1.Edit1.Text;
Active := True;
end;
ServerSocket2.Active := false;
end
else
begin
Showmessage('Sie m�ssen einen Host angeben!');
end;
end;

//begin TCP aktivity

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Client verbindet ...';
end;

procedure TForm1.ServerSocket1Accept(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Verbunden mit ' + socket.RemoteHost;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Client Disconnected!';
ServerSocket1.Active := true;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode:= 100;
Form1.Statusbar1.SimpleText:= 'St�rung';
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Statusbar1.SimpleText:= 'Verbunden';
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Statusbar1.SimpleText:= 'Verbindungsaufbau ...';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Statusbar1.SimpleText:= 'Verbindung verloren!';
end;

// end simple TCP activity

procedure TForm1.Button3Click(Sender: TObject);
var
chat :string;
begin
if (((ServerSocket1.Active) or (ClientSocket1.Active)) and (Edit2.Text <> '')) then
begin
chat := edit2.text;
Edit2.Text := '';
if (ServerSocket1.Socket.ActiveConnections > 0) then
begin
ListBox1.Items.Add('Ich: ' + chat);
ServerSocket1.Socket.Connections[0].SendText('Er : ' + chat);
end;
if ClientSocket1.Socket.Connected then
begin
ListBox1.Items.Add('Ich: ' + chat);
ClientSocket1.Socket.SendText('Er : ' + chat);
end;
end
else
begin
Showmessage('Keine Verbindung oder Kein Text');
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
help :string;
begin
help := Socket.ReceiveText;
help := abhacken(help);
listbox1.Items.add(help);

end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
help :string;
begin
help := Socket.ReceiveText;
help := abhacken(help);
listbox1.Items.add(help);

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Datei := OpenDialog1.FileName;
end;
edit3.text := Datei;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
SelectDirectory(Ordner,[sdAllowCreate, sdPerformCreate, sdPrompt],0);
// rekrusiv datein suchen
StatusBar2.SimpleText := 'Ordner wird durchsucht ...';
recsuch(Ordner, false);
StatusBar2.SimpleText := 'Ordner ist OK';
edit3.text := ordner;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
// stream;
test;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FStream.free;
end;

procedure TForm1.ServerSocket2ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
FStream.free;
en

**Prinz Michael S.** · 24.09.2004, 14:32

jear!
jetzt hab ichs gecheckt ;o)
danke!
kann mir nun jemand bei meinem problemchen helfen

Announcement

probleme mit Client/Server Socket

probleme mit Client/Server Socket

Comment

Comment

Comment

Comment

Comment

Comment

Comment