Entwickler-Ecke

Internet / Netzwerk - *.BMP - Verschicken


Robii - Mo 22.03.10 20:31
Titel: *.BMP - Verschicken
Guten Abend


Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
procedure TfClient.Auswerten(var Text: string);
var
    hBitmap: TBitmap;
    sBmp: TStream;
begin
hBitmap := TBitmap.Create;
sBmp := TStream.Create;
  try
    CreateScreenshot(hBitmap);
    Image1.Picture.Assign(hBitmap);
    Image1.Picture.Bitmap.SaveToStream(sBmp);
    Client.Socket.SendStream(sBmp);
  finally
    hBitmap.Free;
    sBmp.Free;
  End;
End;

procedure TfClient.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap)
Then Begin
  dc := GetDC(0);
  Try
    With Bitmap do
    Begin
      Width := Screen.Width;
      Height:= Screen.Height;
      BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    End;
  Finally
    ReleaseDC(0, dc);
  End;
End;
End;


Das ist der Code mit dem ich einen Screenshot erstellen und ihn dann an meinen Server verschicken möchte. Allerdings
kommt beim Aufruf von der Funktion immer ein 'Abstrakter Fehler'. Wieso das?

Lieben Gruß,
Robii.

Moderiert von user profile iconGausi: Code- durch Delphi-Tags ersetzt
Moderiert von user profile iconGausi: Topic aus Internet / Netzwerk verschoben am Mo 22.03.2010 um 19:52
Moderiert von user profile iconNarses: Topic aus Delphi Language (Object-Pascal) / CLX verschoben am Mo 22.03.2010 um 22:57
Moderiert von user profile iconGausi: Ja, so wie sich das Thema entwickelt, ist es hier doch besser aufgehoben. ;-)
Moderiert von user profile iconNarses: Der Code implizierte das schon auf den ersten Blick... :P


Gausi - Mo 22.03.10 20:40

TStream ist eine abstrakte Klasse, die man so nicht instantiieren darf. Also statt
sBmp := TStream.Create; besser sBmp := TMemoryStream.Create;. Die Deklaration von sBmp kannst du bei TStream belassen.


Robii - Mo 22.03.10 21:09

Danke für die schnelle Hilfe. Der gesamte Code sieht jetzt so aus:

Verschicken im Client:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
procedure TfClient.Auswerten(var Text: string);
var
    hBitmap: TBitmap;
    sBmp: TMemoryStream;
begin
If Pos('SCREEN#',Text)>0 Then Begin
hBitmap := TBitmap.Create;
sBmp := TMemoryStream.Create;
  Try
    CreateScreenshot(hBitmap);
    Image1.Picture.Assign(hBitmap);
    Image1.Picture.Bitmap.SaveToStream(sBmp);
    Client.Socket.SendStream(sBmp);
  Finally
    hBitmap.Free;
    sBmp.Free;
  End;
ShowMessage('LÄUFT');
End
End;

procedure TfClient.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap)
Then Begin
  dc := GetDC(0);
  Try
    With Bitmap do
    Begin
      Width := Screen.Width;
      Height:= Screen.Height;
      BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    End;
  Finally
    ReleaseDC(0, dc);
  End;
End;
End;


Empfangen im Server:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Stream: TStream;
  Text: String;
  Size: Integer;
  bStream: Boolean;
begin
If bStream=False // 
Then Begin
  Text := Socket.ReceiveText;
  If Pos('STREAM#',Text)>0
  Then Begin
  Delete(Text,1,7);
  Size:=StrToInt(Copy(Text,1,Length(Text)-1));
  bStream:=True;
End;
End
Else Begin
  If SizeOf(STREAM)<Size
  Then Begin
  Socket.ReceiveBuf(Stream,Size);
  End
  Else Begin
  ShowMessage('KOMPLETT');
  End;
End;
end;


Allerdings funktioniert das nicht so, wie ich mir das vorstelle. Wieso nicht?
Wie lade ich den Stream dann wieder in ein Image?

Lieben Gruß & Danke schonmal für die Hilfe.
Robii

Moderiert von user profile iconNarses: Code- durch Delphi-Tags ersetzt


ALF - Mo 22.03.10 21:22

Hi, was hällst Du von

Delphi-Quelltext
1:
Image1.Picture.Bitmap.LoadFromStream(Stream);                    

Glaube so müsste es gehen. Und dann ebend noch speichern.
Gruss ALf


Robii - Mo 22.03.10 21:54

So, danke ALF ich hab das mal versucht. Mein Code sieht jetzt so aus:

CLIENT:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
procedure TfClient.Auswerten(var Text: string);
var
    hBitmap: TBitmap;
    sBmp: TMemoryStream;
begin
If Pos('SCREEN#',Text)>0 Then Begin
hBitmap := TBitmap.Create;
sBmp := TMemoryStream.Create;
  Try
    CreateScreenshot(hBitmap);
    Image1.Picture.Assign(hBitmap);
    Image1.Picture.Bitmap.SaveToStream(sBmp);
    Client.Socket.SendText('STREAM#'+IntToStr(SizeOf(sBmp))+'#');
    Client.Socket.SendStream(sBmp);
  Finally
    hBitmap.Free;
    sBmp.Free;
  End;
ShowMessage('LÄIFT');
End;
End;

procedure TfClient.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap)
Then Begin
  dc := GetDC(0);
  Try
    With Bitmap do
    Begin
      Width := Screen.Width;
      Height:= Screen.Height;
      BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    End;
  Finally
    ReleaseDC(0, dc);
  End;
End;
End;


SERVER:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Stream: TStream;
  Text: String;
  Size: Integer;
begin

Stream := TMemoryStream.Create;
If bStream=False
Then Begin
  SHOWMESSAGE('INCOMING');
  Text := Socket.ReceiveText;
  If Pos('STREAM#',Text)>0
  Then Begin
  Delete(Text,1,7);
  Size:=StrToInt(Copy(Text,1,Length(Text)-1));
  bStream:=True;
  End;
End
Else Begin
  If SizeOf(STREAM)<Size
  Then Begin
  Socket.ReceiveBuf(Stream,Size);
  End
  Else Begin
  Image1.Picture.Bitmap.LoadFromStream(Stream);
  End;
End;
end;


Allerdings klappt das nicht. Ich bekomme eine Zugriffsverletzung im Server und SHOWMESSAGE('INCOMING') wird auch nicht angezeigt. bStream wird beim Form.Create auf False gesetzt. Bitte helft mir nocheinmal.

Lieben Gruß.

Moderiert von user profile iconNarses: Code- durch Delphi-Tags ersetzt


ALF - Mo 22.03.10 22:09

user profile iconRobii
Zitat:
Ich bekomme eine Zugriffsverletzung im Server

Fehlermeldung währe nicht schlecht!
Wenn Du die Meldung 'INCOMING' nicht sehen kannst, kann es ja sein:
1. bstream ist vielleicht nicht bekannt in der Procedure.
2. evtl wird vorher schon abgebrochen (Zugriffsverletzung)

Es währe also nur ein Raten! :gruebel:
Kam den vor der Änderung ne Fehlermeldung!?

Noch was, wenn der Client funct brauchst Du nicht immer den Quelltext mit Posten!
und sei so nett und korregiere mal diese schreibweisen:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
If bStream=False
Then Begin

{in}

If bStream then
begin
  ......
end;

{oder}

If SizeOf(STREAM)<Size
Then Begin  Socket.ReceiveBuf(Stream,Size);
  End  Else Begin
  Image1.Picture.Bitmap.LoadFromStream(Stream);
  End;

{in}

If SizeOf(STREAM) < Size then
   Socket.ReceiveBuf(Stream, Size)
else
   Image1.Picture.Bitmap.LoadFromStream(Stream);

{usw}

sieht besser aus und ist lesbarer! :wink:
Gruss ALf


Robii - Mo 22.03.10 23:16

Also. Der Screenshot wird im Client jetzt erstellt. Allerdings bekomme ich als Fehlermeldung im Client folgendes:
Ungültige Zeigeroperation!

Hier der Code des Clienten:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
var
  fClient: TfClient;

implementation

{$R *.dfm}
// EIGENE PROCEDUREN
procedure TfClient.Auswerten(var Text: string);
var
    hBitmap: TBitmap;
    sBmp: TMemoryStream;
begin
If Pos('SCREEN#',Text)>0 Then Begin
hBitmap := TBitmap.Create;
sBmp := TMemoryStream.Create;
  Try
    CreateScreenshot(hBitmap);
    Image1.Picture.Assign(hBitmap);
    Image1.Picture.Bitmap.SaveToStream(sBmp);
    Client.Socket.SendText('STREAM#'+IntToStr(SizeOf(sBmp))+'#');
    Client.Socket.SendStream(sBmp);
  Finally
    hBitmap.Free;
    sBmp.Free;
  End;
ShowMessage('LÄIFT');
End;
End;

procedure TfClient.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap)
Then Begin
  dc := GetDC(0);
  Try
    With Bitmap do
    Begin
      Width := Screen.Width;
      Height:= Screen.Height;
      BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    End;
  Finally
    ReleaseDC(0, dc);
  End;
End;
End;

// AUTOMATISCHE PROCEDUREN
procedure TfClient.FormCreate(Sender: TObject);
begin
Client.Port:=TARGET_PORT;
Client.Address:='XX.XX.XXX.XXX';
Client.Active:=True;
end;

procedure TfClient.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  sText: String;
begin
sText:=Socket.ReceiveText;
If Pos('#',sText)=Length(sText)
  Then Auswerten(sText);
End;


Im Server kommt das PopUp 'INCOMING' und als größe des Streams wird mir nur '4' angezeigt. Kann das sein? Auch der Screen wird im Image nicht angezeigt.


Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
var
  Form1: TForm1;
  bStream: Boolean;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
For i := 0 to Server.Socket.ActiveConnections-1 do
Begin
  Server.Socket.Connections[i].SendText(Edit1.Text+'#');
End;
  Log.Lines.Add(Edit1.Text+'#');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
bStream:=False;
end;

procedure TForm1.ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Log.Lines.Add('Neuer Client');
end;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  Stream: TStream;
  Text: String;
  Size: Integer;
begin
Log.Lines.Add(Socket.ReceiveText);
Stream := TMemoryStream.Create;
If bStream=False
Then Begin
  SHOWMESSAGE('INCOMING');
  Text := Socket.ReceiveText;
  If Pos('STREAM#',Text)>0
  Then Begin
  Delete(Text,1,7);
  Size:=StrToInt(Copy(Text,1,Length(Text)-1));
  bStream:=True;
  End;
End
Else Begin
  If SizeOf(STREAM)<Size
  Then Begin
  Socket.ReceiveBuf(Stream,Size);
  End
  Else Begin
  Image1.Picture.Bitmap.LoadFromStream(Stream);
  End;
End;
end;


Sorry Alf, was meinst du mit ich soll die Schreibweise korregieren? ;)
Das mit dem {in} hab ich nicht verstanden.

Lieben Gruß und Danke für die Hilfe.
Robii


Muck - Mo 22.03.10 23:31

Hallo,

Problem 1 siehe Anmerkung

Delphi-Quelltext
1:
2:
Client.Socket.SendText('STREAM#'+IntToStr(SizeOf(sBmp))+'#');
// SizeOf(sBMP) ist immer 4,   benutze sBmp.Size


Problem 2
Du kannst nicht sicher sein, dass Dein BMP in einem Rutsch empfangen wird. Du musst also die ReceiveBuf Procedure auf einen existierenden Stream anwenden bis SIZE erreicht ist. Also wenn Du im Server den Text STREAM# findest einen Stream anlegen, jedoch nicht local, den musst Du anders speichern z.B. ein Object und Socket.Data als Pointer nutzen damit Du wenn der naechste Datenblock eintrifft, den Stream und andere Daten auch wiederfindest.

Besser jedoch ein Protokoll benutzen, da gibt es schon viele Beispiele hier im Forum, denn streng genommen kannst Du Dir ja noch nicht einmal sicher sein, dass der String "STREAM#145554#" in einem Stueck am anderen Ende ankommt. Dieser kann ja auch in 2 Aufrufen als "STRE" und "AM#145554#" ankommen.

Markus


ALF - Mo 22.03.10 23:42

Ich meine, schreibe die if Anweisungen so, das man sie auch richtig lesen kann!
also z.B.:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
If Pos('SCREEN#', Text) > 0 Then
Begin
    hBitmap := TBitmap.Create;
    sBmp := TMemoryStream.Create;
  Try
    CreateScreenshot(hBitmap);
    .....
    .....
  Finally    
    hBitmap.Free;
    sBmp.Free;
end;

und richtiges einrücken. So sieht man wo der Anfang ist und das Ende und muss nicht erst suchen im Quelltext!
Das meinte ich auch mit diesem {in} "richtige Schreibweise".
Felermeldungen liefern meist auch ne Zeilennummer, evtl wird die Stelle auch markiert!
Wenn vorher alles gefunct hatt, ausser das im Server, wieso tauchen jetzt Fehler im Clienten auf????
bisschen merkwürdig :gruebel:

Gruss ALf


Robii - Mo 22.03.10 23:44

user profile iconMuck hat folgendes geschrieben Zum zitierten Posting springen:
Hallo,

Problem 2
Du kannst nicht sicher sein, dass Dein BMP in einem Rutsch empfangen wird. Du musst also die ReceiveBuf auf einen existierenden Stream anwenden bis SIZE erreicht ist. Also wenn Du im Server den Text STREAM# findest ein Stream anlegen, jedoch nicht local, musst Du anders speichern und Socket.Data als Pointer nutzen damit Du wenn der naechste Datenblock eintrifft, den Stream und andere Daten auch wiederfindest.

Besser jedoch ein Protokoll benutzen, da gibt es schon viele Beispiele hier im Forum.

Markus


Hey Markus, danke für deine Hilfe erstmal. Das mit dem Protokoll hab ich beim Suchen schon oft gelesen, allerdings glaube ich ist das doch eher für große Programme geeignet, mit vielen Funktionen oder? Ich möchte lediglich Screens verschicken können.

E:/

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
procedure TForm1.FormCreate(Sender: TObject);
begin
bStream:=False;
Stream := TMemoryStream.Create;
Server.Socket.Data := @stream;
end;

[..]

Socket.ReceiveBuf(Socket.Data,Size);


Wobei Stream: TStream global definiert ist?
Fehlermeldung:
[DCC Fehler] Unit1.pas(78): E2197 Konstantenobjekt kann nicht als Var-Parameter weitergegeben werden

Lieben Gruß & Danke.
Robii


Narses - Mo 22.03.10 23:56

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
user profile iconMuck hat folgendes geschrieben Zum zitierten Posting springen:
Besser jedoch ein Protokoll benutzen
Das mit dem Protokoll hab ich beim Suchen schon oft gelesen, allerdings glaube ich ist das doch eher für große Programme geeignet, mit vielen Funktionen oder? Ich möchte lediglich Screens verschicken können.
Da hat er einfach recht, die einzig brauchbare Lösung ist ein Protokoll, egal wie "groß" dein Programm ist. Auch wenn dein Programm "nur" ein Bild versenden/empfangen soll, das soll es doch aber wohl fehlerfrei tun können, oder? :zwinker:

Was du da machst, wird nie richtig funktionieren, weil du keine brauchbare Verarbeitung der eingehenden Daten hast. Standard-FAQs:
http://www.delphi-library.de/topic_Datenpakete+bei+den+SocketKomponenten+auseinanderhalten_56194.html
http://www.delphi-library.de/topic_Probleme+beim+SendenEmpfangen+von+records++dyn+Objekten_60793.html
http://www.delphi-library.de/topic_Warum+gibt+es+kein+ReceiveStream+bei+den+Sockets_65367.html

Und ich schätze mal, es soll nachher sowas dabei rauskommen [http://www.delphi-library.de/topic_TerminatorzeichenProtokollTutorial++Teil+2+Sockets_65487.html], oder? ;)

cu
Narses


Robii - Di 23.03.10 00:10

Hallo Narses, irgendwie wußte ich das du dich hier zu Wort melden wirst, da du ja quasi der 'Fachmann' in diesem Bereich bist. Dein Tutorial habe ich mir schon runtergeladen usw. und angeguckt, allerdings, erschien mir das immer als recht umfangreich und die Code-Schnipsel die man für das versenden von Bildern benötigt, habe ich nicht herraussuchen können. Ich muss zugeben ich habe mich mit deinem Tutorial nicht 100%ig beschäftigt, aber ich dachte, das es vielleicht für das blosse versenden eines Bildes auf Knopf-Druck eine einfachere Lösung gibt ;)

Vielleicht kannst du dir ja den Code den ich bis jetzt gepostet habe nochmal anschauen, ich schaue mir dein Tutorial mal intensiv an.

Lieben Gruß.
Robii


Muck - Di 23.03.10 01:05

Hi,

Socket.Data benutze ich in meinen Server Programmen um einen Pointer auf Variablen fuer diese Session zu haben. Erzeuge Dir dafuer eine Klasse oder Object wo der Stream oder AnsiString oder was immer Du nutzen willst ein Member ist. Im Connect Ergeignis des Socket erzeugst Du diese Struktur mit Create und speicherst dort in Socket.Data einen Pointer auf das Object. Im Read Ereignis kannst Du dann mit Socket.Data einen Pointer auf dieses Object bilden und die ankommenden Daten zum Buffer addieren. Im Disconnect kannst Du das Object freigeben.

Falls Du jedoch sicher weisst, dass niemals mehr als ein Client mit dem Server verbunden ist, kannst Du Dir das alles sparen und einfach mit einem Public Stream arbeiten, ist aber nicht ganz fein.


Robii - Di 23.03.10 01:20

Habe mir jetzt den ersten Teil des Protokoll-Tutorials von Narses durchgelesen und mir ist so Einiges klar geworden. Versuche das beim schlafen jetzt mal zu verarbeiten und zeige euch dann morgen was ich geschafft habe, in diesem Sinne eine gute Nacht.

Grüße, Robii.


Robii - Di 23.03.10 23:34

Guten Abend, ich bin es noch einmal.
Also ich hab jetzt folgendes versucht:

Client

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
const
  SERVER_PORT = XXXX;
  SERVER_ADDR = 'XX.XX.XXX.XXX';
  cmdSCR = 'SCREEN';

[..]

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.Auswerten;
var
  Data: TStringList;
  hBitmap: TBitmap;
  ImgData: TStringStream;
begin
  Data := TStringList.Create;
  hBitmap := TBitMap.Create;
  ImgData := TStringStream.Create;
  try
    Data.Text := ReceiveBuffer;
    If Data.Strings[0]= cmdSCR Then
      Begin
        CreateScreenshot(hBitmap);
        Image1.Picture.Assign(hBitmap);
        ImgData := TStringStream.Create('');
        Image1.Picture.Bitmap.SaveToStream(ImgData);
        Client.Socket.SendText(cmdSCR+#13+ImgData.DataString+#13);
      End;
  finally
    ImgData.Free;
    Data.Free;
    hBitmap.Free;
  end;
end;

procedure TForm1.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap) then
  begin
  dc := GetDC(0);
  try
  with Bitmap do
    begin
    Width := Screen.Width;
    Height:= Screen.Height;
    BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    end;
  finally
  ReleaseDC(0, dc);
  end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Client.Port := SERVER_PORT;
Client.Address:= SERVER_ADDR;
Client.Open;
end;

procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
Auswerten;
end;
end.


Server:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
const
  SERVER_PORT = 6112;
  cmdSCR = 'SCREEN';

[..]

implementation

{$R *.dfm}

procedure TForm1.Auswerten;
var
  Data: TStringList;
  hBitmap: TBitmap;
  ImgData: TStringStream;
begin
  Data := TStringList.Create;
  hBitmap := TBitMap.Create;
  ImgData := TStringStream.Create;
  try
    Data.Text := ReceiveBuffer;
    If Data.Strings[0]= cmdSCR Then
      Begin
        ImgData := TStringStream.Create(Data.Strings[1]);
        ShowMessage('Lade von Stream');
        Image1.Picture.Bitmap.LoadFromStream(ImgData);
      End;
  finally
    ImgData.Free;
    Data.Free;
    hBitmap.Free;
  end;
end;

procedure TForm1.btScrClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Server.Socket.ActiveConnections - 1 do
    Server.Socket.Connections[i].SendText(cmdSCR+#13);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Server.Port := SERVER_PORT;
Server.Open;
end;

procedure TForm1.ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
ShowMessage('Client Connected');
end;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
Auswerten;
end;

end.


Wenn ich jetzt im Server den Screen-Knopf drücke, wird im Client ein Screen erzeugt und anscheinend auch verschickt, allerdings hängt sich der Server dann auf. Eine Endlos-Schleife oder so etwas in der Richtung, denn es reagiert nicht mehr und zeigt als Cursor die ganze Zeit den 'ARBEITEN'-Cursor.

Narses ich hab mir dein Tutorial durchgelesen, aber irgendwie finde ich, das das zuviel ist. Ich möchte ja nur ein Programm haben, das ein Screen auf Knopf-Druck verschickt.
Was ich in deinem Tutorial nicht verstehe, du sagst, das man den STREAM des Bildes ja bearbeiten muss, damit die Trennzeichen '#13' die wir normalerweise benutzen um das Ende eines Pakets zu makieren ersetzen müssen. Dazu verwendest du folgende Funktion:


Delphi-Quelltext
1:
2:
function MaskTermChar(const S: Stringconst TermChar: Char = #13): String;
function UnmaskTermChar(const S: Stringconst TermChar: Char = #13): String;


Allerdings wird im gesamten Tutorial nicht der Inhalt der Funktionen erläutert, oder ich hab da etwas falsch verstanden. Kann mir auch gut vorstellen, das deshalb mein Gerüst (s.o.) nicht funktioniert.

Hoffe, ihr könnt mir helfen.
Lieben Gruß & Danke schonmal,
Robii.


Narses - Mi 24.03.10 00:10

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Also ich hab jetzt folgendes versucht:
Dein Code zeigt leider, dass du das Tutorial nicht verstanden hast, vermutlich weil es dir zuviel Arbeit ist, das mal ordentlich durchzuarbeiten, warum auch immer, dabei kann ich dir nicht helfen. :nixweiss:

Da sind min. folgende, gravierende Fehler drin:
user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Narses ich hab mir dein Tutorial durchgelesen, aber irgendwie finde ich, das das zuviel ist.
Was soll ich dazu sagen, ich habe mir doch nicht die Anforderung ausgedacht, die du da umsetzen willst. :lol: Ich zeige im Tut lediglich, wie man das lösen kann. Du kannst es gerne anders machen, wenn du möchtest. :nixweiss:

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Ich möchte ja nur ein Programm haben, das ein Screen auf Knopf-Druck verschickt.
Und das scheint wohl nicht ganz so einfach zu sein, wie du mittlerweile selbst festgestellt haben müsstest... 8)

Aber vielleicht solltest du dir mal diese Komponenten [http://www.delphi-forum.de/topic_TNBFPA+v112++SocketKompos+mit+Protokollfunktionen_71223.html] ansehen, damit ist das deutlich leicher umzusetzen. :idea:

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Was ich in deinem Tutorial nicht verstehe, du sagst, das man den STREAM des Bildes ja bearbeiten muss, damit die Trennzeichen '#13' die wir normalerweise benutzen um das Ende eines Pakets zu makieren ersetzen müssen. Dazu verwendest du folgende Funktion:

Delphi-Quelltext
1:
2:
function MaskTermChar(const S: Stringconst TermChar: Char = #13): String;
function UnmaskTermChar(const S: Stringconst TermChar: Char = #13): String;



Allerdings wird im gesamten Tutorial nicht der Inhalt der Funktionen erläutert,
Ja, das ist richtig, die Funktionen liegen allerdings mit ausführlichen Kommentaren im Code-Archiv mit bei. Also einfach mal reinschauen, so schwer sind die nicht zu verstehen. Es ging mir im Tut zu weit, das auch noch im Detail auszuwalzen; vor allem, weil hier ein Binärprotokoll eh der bessere Ansatz ist.

cu
Narses


Martok - Mi 24.03.10 12:55

Wollt ihr dem armen Jungen nicht sagen, dass Indy auch HTTPServer etc mitbringt?
Gut, ich würde jetzt immer ICS vorziehen...

Da hätte man ein fertiges Protokoll und ganz brauchbare Handler, und du kannst einfach eine Abfrage bauen

Pseudocode
1:
2:
WENN Anfrage.URL = "/screen.bmp" DANN
  Antwort.Stream:= Bitmap.AlsStream


KISS... in dem Fall "don't write a protocol if you don't have to".


Narses - Mi 24.03.10 13:01

Moin!

user profile iconMartok hat folgendes geschrieben Zum zitierten Posting springen:
Wollt ihr dem armen Jungen nicht sagen, dass Indy auch HTTPServer etc mitbringt?
Wenn du glaubst, dass er mit den Threads besser klar kommt... :lol: (ist nicht persönlich gemeint :beer: ;))

Klar kann man das machen, aber wer sagt, dass es wirklich "nur" ein Bild ist? Wenn das erstmal klappt, dann kommt noch hier was, und das könnte man auch noch... :nixweiss:

Abgesehen davon bin ich der Meinung, dass man erstmal selbst ein Protokoll verstanden haben sollte, bevor man sich mit Protokoll-Standards rumschlägt, die man dann nicht korrekt anwendet... :?

cu
Narses


Martok - Mi 24.03.10 13:09

user profile iconNarses hat folgendes geschrieben Zum zitierten Posting springen:
Wenn du glaubst, dass er mit den Threads besser klar kommt... :lol: (ist nicht persönlich gemeint :beer: ;))
(Auch) deswegen auch mein Hinweis auf ICS, die sind eventbasiert. Muss man allerdings noch mehr aufpassen, weil man ja die Verbindungen dann auseinanderhalten muss irgendwie.

user profile iconNarses hat folgendes geschrieben Zum zitierten Posting springen:
Klar kann man das machen, aber wer sagt, dass es wirklich "nur" ein Bild ist?

Ja gut... ich antworte nur auf Fragen die auch da sind... das ist dann wohl doch "Kundenerfahrung", dass hinterher immer noch mehr kommt als das bestelle "kleine Tool" ;)

user profile iconNarses hat folgendes geschrieben Zum zitierten Posting springen:
Abgesehen davon bin ich der Meinung, dass man erstmal selbst ein Protokoll verstanden haben sollte, bevor man sich mit Protokoll-Standards rumschlägt, die man dann nicht korrekt anwendet... :?

Okay, das ist allerdings wahr. Man sollte zumindest grob wissen, was da warum passiert... und was nicht.
Und dazu sind deine Tutorials sicherlich gut geeignet, auch wenn ich das Terminatorzeichent. nur mal überflogen hab, sondern gleich Binär eingestiegen bin...


Robii - Mi 24.03.10 15:32

Guten Mittag zusammen,

@ Narses
Ich hab jetzt die beiden Units für TParserStringList & die Unit für das maskieren von Terminator-Zeichen eingebunden und verwende diese auch.


Ich wollte auf ein Protkoll verzichten, da ich ja im Prinzip nur auf Knopf-Druck vom Server aus den Befehl 'SCREEN' schicken möchte und dann der Client einen Screen zurück senden.

Es gibt sonst keine anderen Funktionen und es ist auch immer nur 1 Client mit dem Server verbunden [ -> globaler Buffer].

Wenn ich jetzt meinen SCREEN-Befehl abschicke, wird im Client ein Screen erzeugt und versendet. Doch der Server reagiert dann nicht mehr. Es kommt aber auch keine Fehlermeldung, scheint mir so, als würde da irgendeine Schleife laufen oder sowas.

Im Prinzip muss das Programm doch so ablaufen:

SERVER -> Befehl: Mach einen Screen
CLIENT -> Erzeugt Screen
CLIENT -> Speichert den Screen in einem String und verschickt diesen
SERVER -> Empfängt Stream und speichert diesen in einem Bild


Vielleicht könnt ihr mir da nochmal helfen?

@Martok
Ich würde gerne bei TClientSocket & TServerSocket bleiben, da weiß ich immerhin was ich machen muss usw.
Danke trotzdem.

Lieben Gruß.


Narses - Mi 24.03.10 16:34

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Ich wollte auf ein Protkoll verzichten,
Der Witz ist ja: du kannst in diesem Fall gar nicht auf ein Protkoll verzichten - sei es auch noch so primitiv. ;)

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Es gibt sonst keine anderen Funktionen und es ist auch immer nur 1 Client mit dem Server verbunden [ -> globaler Buffer].
Wenn du das im Code sicherstellen kannst, ist ja gut.

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Im Prinzip muss das Programm doch so ablaufen:

SERVER -> Befehl: Mach einen Screen
CLIENT -> Erzeugt Screen
CLIENT -> Speichert den Screen in einem String und verschickt diesen
SERVER -> Empfängt Stream und speichert diesen in einem Bild
Nun, da die Rolle "Server" üblicherweise mit "Diensteanbieter" übersetzt wird, ist in deinem Beispiel die Rollenzuweisung vertauscht (das hat erstmal nix damit zu tun, wer den ServerSocket auf macht), aber so kann das laufen, ja.

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Vielleicht könnt ihr mir da nochmal helfen?
Aktueller Code? Am besten das Projektverzeichnis ohne die EXE anhängen. Wir können ja nicht hellsehen. ;)

Was ist mit den NBFPA-Kompos? Mal angesehen? Das wäre wirklich deutlich einfacher damit. :nixweiss:

cu
Narses


Robii - Mi 24.03.10 21:19

Guten Abend, so sieht jetzt der QuellCode meines Clienten aus ( das Programm welches den SCREENSHOT erstellt und an den Server schickt):


Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ScktComp, Protokoll,ParserStrList, TCTrans;

type
  TForm1 = class(TForm)
    Client: TClientSocket;
    Image1: TImage;
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }
    procedure CreateScreenshot(var Bitmap: TBitmap);
    procedure ParseBuffer;
    procedure Execute(Cmd: TCmdToken; lData: TParserSTringList);
    procedure BildSenden;
    function GetCmdToken(const StrToken: String): TCmdToken;
  public
    { Public-Deklarationen }
    ReceiveBuffer: String;
    hBitmap: TBitMap;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BildSenden;
var
  sIMG: TStringStream;
begin
  CreateScreenshot(hBitmap);
  Image1.Picture.Assign(hBitmap);
  sIMG := TStringStream.Create('');
  Image1.Picture.Bitmap.SaveToStream(sIMG);
  Client.Socket.SendText(Syntax[cmdSCR]+#13+MaskTermChar(sIMG.DataString)+#13);
  sImg.Free;
end;

procedure TForm1.Execute(Cmd: TCmdToken; lData: TParserSTringList);
begin
case Cmd of
  cmdNOP:
    ;
  cmdSCR:
    BildSenden
    ;
  cmdERROR:
    ;
end;
end;

procedure TForm1.ParseBuffer;
var
  Data: TParserStringList;
  outofArg: Boolean;
  Current: TCmdToken;
begin
  outofArg := False;
  Data.ParseText(ReceiveBuffer);
  try
  while (Data.Count > 0and (NOT outofArg) do begin
    Current := GetCmdToken(UpperCase(Data.Strings[0]));
    If Data.Count > Syntax[Current].ArgCount
      Then Begin
        Execute(Current,Data);
      End
      Else
        OutOfArg := True;
    end;
    Receivebuffer := Data.Text
  finally
    Data.Free;
  end;
end;

function TForm1.GetCmdToken(const StrToken: String): TCmdToken;
begin
Result := Low(Syntax);
while ( (Result < cmdERROR)
and
(StrToken <> Syntax[Result].Text) ) do
Inc(Result);
end;


procedure TForm1.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap) then
  begin
  dc := GetDC(0);
  try
  with Bitmap do
    begin
    Width := Screen.Width;
    Height:= Screen.Height;
    BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    end;
  finally
  ReleaseDC(0, dc);
  end;
end;
end;

procedure TForm1.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin

end;

procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
ParseBuffer;
end;

end.


Das ist mein Protokoll:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
unit Protokoll;

interface

const

SERVER_PORT = XXXXX;
SERVER_ADDR = 'XX.XX.XXX.XXX';

type

TCmdSyntax = record
  Text: ShortString;
  ArgCount: Integer;
end;

TCmdToken = (
  cmdNOP = 0// Nichts tun
  cmdSCR,    // SCREEN-Befehl || Server -> Client
  cmdERROR    // Fehler, ungültiger Befehl
  );

const

Syntax: Array[TCmdToken] of TCmdSyntax = (
  (Text: ''; ArgCount: 1), // Nichts
  (Text: 'SCREEN'; ArgCount: 2), // SCREEN
  (Text: ''; ArgCount: 1// ERROR; ist nur ein Dummy-Befehl -> kein Text
  );

implementation

end.


Allerdings weiß ich jetzt nicht wie ich das mit dem Empfangen auf dem Server machen soll. Im Tutorial leitest du ja jede Zeile über den Server an den Empfänger-Clienten weiter. Kann mir da jemand evtl. helfen?

Lieben Gruß & Dank,
robii.


Narses - Do 25.03.10 00:50

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
so sieht jetzt der QuellCode meines Clienten aus
Den Code hast du blind geschrieben und garantiert noch nie gestartet (oder es ist nicht der komplette Quelltext). :? Jedenfalls läuft das so ganz sicher nicht.

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Das ist mein Protokoll:
Kann man so machen, auch wenn die Server-Adresse da nix zu suchen hat.

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Allerdings weiß ich jetzt nicht wie ich das mit dem Empfangen auf dem Server machen soll. Im Tutorial leitest du ja jede Zeile über den Server an den Empfänger-Clienten weiter.
Ja, der Server im Tutorial ist nur eine transparente Vermittlungsstelle. Aber was hindert sich im OnExecute des Servers bei dem entsprechenden Kommando einfach das Bild auszupacken und irgendwo in der Server-GUI anzuzeigen? :nixweiss:

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Kann mir da jemand evtl. helfen?
Konzept hast du gerade genannt gekriegt. Aber ich werde dir dafür nicht das Verstehen des Tut-Codes abnehmen, indem ich dir das als Code liefere, das bringt nix. Zeig einen Ansatz, dann sehen wir weiter.

Ich muss allerdings gestehen, der Ansatz von Martok war einfach so charmant, ich konnte nicht wiederstehen, das mal eben auszuprobieren... 8) Einfach starten, Online schalten, einen Browser nehmen und als Adresse "http://localhost:8080" eingeben, Return drücken, zur Anmeldung "user" und "kennwort" eingeben, staunen. :D

cu
Narses


Robii - Do 25.03.10 17:03

user profile iconNarses hat folgendes geschrieben Zum zitierten Posting springen:
Moin!
Den Code hast du blind geschrieben und garantiert noch nie gestartet (oder es ist nicht der komplette Quelltext). :? Jedenfalls läuft das so ganz sicher nicht.


Hab mal versucht ihn zu compilen und hab jetzt folgende Zeile geändert:

Delphi-Quelltext
1:
  Client.Socket.SendText(Syntax[cmdSCR].Text+#13+MaskTermChar(sIMG.DataString)+#13);                    


Die Adresse hab ich im Protokoll dazu geschrieben, dann hab ich Port & Adresse immmer zusammen und muss die nicht suchen.

Das mit dem Server versuche ich heute Nachmittag, wenn ich Zeit habe, und poste den Quelltext dazu dann auch nochmal hier rein.

Danke schon mal user profile iconNarses für die Hilfe,
lieben Gruß, robii.

Edit:

Client-Quellcode:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ScktComp, Protokoll,ParserStrList, TCTrans;

type
  TForm1 = class(TForm)
    Client: TClientSocket;
    Image1: TImage;
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure CreateScreenshot(var Bitmap: TBitmap);
    procedure ParseBuffer;
    procedure Execute(Cmd: TCmdToken; lData: TParserSTringList);
    procedure BildSenden;
    function GetCmdToken(const StrToken: String): TCmdToken;
  public
    { Public-Deklarationen }
    ReceiveBuffer: String;
    hBitmap: TBitMap;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BildSenden;
var
  sIMG: TStringStream;
begin
  ShowMessage('1');
  hBitmap := TBitmap.Create;
  CreateScreenshot(hBitmap);
  Image1.Picture.Assign(hBitmap);
  sIMG := TStringStream.Create('');
    try
    Image1.Picture.Bitmap.SaveToStream(sIMG);
    Client.Socket.SendText(Syntax[cmdIN].Text+#13+MaskTermChar(sIMG.DataString)+#13);
  finally
    sImg.Free;
  end;
  Data.Delete(0);
end;

procedure TForm1.Execute(Cmd: TCmdToken; lData: TParserSTringList);
begin
case Cmd of
  cmdNOP:
    ;
  cmdSCR:
    BildSenden
    ;
  cmdERROR:
    ;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Client.Port := SERVER_PORT;
Client.Address:= SERVER_ADDR;
Client.Host := SERVER_ADDR;
Client.Open;
end;

procedure TForm1.ParseBuffer;
var
  outofArg: Boolean;
  Current: TCmdToken;
begin
  Data := TParserStringList.Create;
  outofArg := False;
  Data.ParseText(ReceiveBuffer);
  try
  while (Data.Count > 0and (NOT outofArg) do begin
    Current := GetCmdToken(UpperCase(Data.Strings[0]));
    If Data.Count >= Syntax[Current].ArgCount
      Then Begin
        Execute(Current,Data);
      End
      Else
        OutOfArg := True;
    end;
    Receivebuffer := Data.Text
  finally
    Data.Free;
  end;
end;


function TForm1.GetCmdToken(const StrToken: String): TCmdToken;
begin
Result := Low(Syntax);
while ( (Result < cmdERROR)
and
(StrToken <> Syntax[Result].Text) ) do
Inc(Result);
end;


procedure TForm1.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap) then
  begin
  dc := GetDC(0);
  try
  with Bitmap do
    begin
    Width := Screen.Width;
    Height:= Screen.Height;
    BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    end;
  finally
  ReleaseDC(0, dc);
  end;
end;
end;

procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
ParseBuffer;
end;

end.


Server-Code:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ExtCtrls, ParserStrList, Protokoll, TCTrans;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Server: TServerSocket;
    procedure FormCreate(Sender: TObject);
    procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure ParseBuffer;
    procedure BildEmpfangen(Cur: TCmdToken; Dat: TStringList);
    procedure Execute(Cmd: TCmdToken; lData: TParserSTringList);
    function GetCmdToken(const StrToken: String): TCmdToken;
  public
    { Public-Deklarationen }
    ReceiveBuffer: String;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BildEmpfangen(Cur: TCmdToken; Dat: TStringList);
var
  sIMG: TStringStream;
  i: Integer;
begin
  sIMG := TStringStream.Create(UnmaskTermChar(Dat.Strings[1]));
  Image1.Picture.Bitmap.LoadFromStream(sIMG);
  sIMG.Free;
  for i := 0 to Syntax[Cur].ArgCount - 1 do
  Dat.Delete(0);
end;

function TForm1.GetCmdToken(const StrToken: String): TCmdToken;
begin
Result := Low(Syntax);
while ( (Result < cmdERROR)
and
(StrToken <> Syntax[Result].Text) ) do
Inc(Result);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Server.Port := SERVER_PORT;
Server.Open;
end;

procedure TForm1.ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
ShowMessage('Neuer Client!');
end;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
ParseBuffer;
end;

procedure TForm1.ParseBuffer;
var
  Data: TParserStringList;
  outofArg: Boolean;
  Current: TCmdToken;
begin
  outofArg := False;
  Data.ParseText(ReceiveBuffer);
//  try
  while (Data.Count > 0and (NOT outofArg) do begin
    Current := GetCmdToken(UpperCase(Data.Strings[0]));
    If Data.Count >= Syntax[Current].ArgCount
      Then Begin
        Execute(Current,Data);
      End
      Else
        OutOfArg := True;
    end;
    Receivebuffer := Data.Text;
//  finally
    Data.Free;
//  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
for i := 0 to Server.Socket.ActiveConnections - 1 do
  Server.Socket.Connections[i].SendText(Syntax[cmdSCR].Text+#13);
end;

procedure TForm1.Execute(Cmd: TCmdToken; lData: TParserSTringList);
begin
case Cmd of
  cmdNOP:
    ;
  cmdIN:
    BildEmpfangen(Cmd,lData)
    ;
  cmdERROR:
    ;
end;
end;

end.


Protokoll:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
unit Protokoll;

interface

const

SERVER_PORT = XXXX;
SERVER_ADDR = '';

type

TCmdSyntax = record
  Text: ShortString;
  ArgCount: Integer;
end;

TCmdToken = (
  cmdNOP = 0// Nichts tun
  cmdSCR,    // SCREEN-Befehl || Server -> Client
  cmdIN,
  cmdERROR    // Fehler, ungültiger Befehl
  );

const

Syntax: Array[TCmdToken] of TCmdSyntax = (
  (Text: ''; ArgCount: 1), // Nichts
  (Text: 'SCREEN'; ArgCount: 2), // SCREEN
  (Text: 'INCOMING'; ArgCount: 2),
  (Text: ''; ArgCount: 1// ERROR; ist nur ein Dummy-Befehl -> kein Text
  );

implementation

end.


Wenn ich jetzt den Befehl zum Screenshot erstellen sende, wird die ShowMessage('1') aus der Procedure Bild-Senden angezeigt aber ich bekomme gleichzeitig eine Zugriffsverletzung im Server im onRead oder in der Verarbeitung denke ich mal. Und ich glaube, dass der Code im Server nicht richtig ist. Kann mir ja vielleicht jemand mal drüber gucken und Tipps geben? :)

E²: Debugge im Moment noch und finde selbst lauter Fehler. Aktualisiere dann den Code, wenns nicht klappt. -Schlafen- [23:44Uhr] :D


Robii - Fr 26.03.10 17:05

// Push :?


Narses - Fr 26.03.10 17:29

Moin!

Was mir auf den ersten Blick auffällt:cu
Narses


Robii - Fr 26.03.10 17:44

Guten Nachmittag :)

Zitat:

Was mir auf den ersten Blick auffällt:

Du hast ein (lokales!) Objekt namens Data: TParserStringList deklariert, das nirgendwo erzeugt, aber erstaunlicherweise am Ende freigegeben wird!

Du verwendest die ParserStringList, aber weist nach dem Abarbeiten dem Buffer wieder etwas zu (Receivebuffer := Data.Text;), damit machst du den Bufferinhalt kaputt!

Wozu soll die Image-Kompo im Client gut sein?


Du meinst doch Data im Server-Code oder? ;D Den initialisiere ich jetzt so :

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
procedure TForm1.ParseBuffer;
var
  Data: TParserStringList;
  outofArg: Boolean;
  Current: TCmdToken;
begin
  Data := TParserStringList.Create;
  outofArg := False;
  Data.ParseText(ReceiveBuffer);
//  try
  while (Data.Count > 0and (NOT outofArg) do begin
    Current := GetCmdToken(UpperCase(Data.Strings[0]));
    If Data.Count >= Syntax[Current].ArgCount
      Then Begin
        Execute(Current,Data);
      End
      Else
        OutOfArg := True;
    end;
//  finally
    Data.Free;
//  end;
end;


Das mit dem Receivebuffer := Data.Text; muss ich doch dann einfach rauslöschen oder ? Weil dann bleibt das ja bestehen.

Das Bild im Client ist, damit ich sehen kann ob das mit dem Screenshot geklappt hat, war am Anfang nämlich auch ein Problem, hatte vergessen die hBitmap zu initialisieren. ;)

Danke für die Hilfe erstmal.
Das Problem ist jetzt, wenn ich jetzt im onRead vom Server debugge und mir Data.Count angucke ist das immer 0. Wieso das? So wird Execute ja garnicht ausgeführt usw.

Lieben Gruß.


Narses - Fr 26.03.10 18:26

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Du meinst doch Data im Server-Code oder? ;D Den initialisiere ich jetzt so :
Ja, genau das meine ich. ;) Allerdings ist es ungünstig, das als lokales Objekt anzulegen, ein (klassen-)globales wäre besser, damit du einmal aus dem Empfangspuffer abgetrennte Pakete nicht immer wieder durch die Gegend kopieren musst. (tja, das meine ich mit Tut-Code verstehen, du wurschtelst dich zwar tapfer da durch, aber dir fehlt einfach der Überblick, was du da eigentlich machst... :|)

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Das mit dem Receivebuffer := Data.Text; muss ich doch dann einfach rauslöschen oder ? Weil dann bleibt das ja bestehen.
Ja, wenn du aus Data ein klassenglobales Objekt machst, kann diese Zeile raus.

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Das Problem ist jetzt, wenn ich jetzt im onRead vom Server debugge und mir Data.Count angucke ist das immer 0. Wieso das? So wird Execute ja garnicht ausgeführt usw.
s.o.

cu
Narses


Robii - Sa 27.03.10 21:39

Es klappt !

Nach der letzen Korrektur von Narses klappt es jetzt endlich. :)
Und Narses, du hattest Recht, kaum habe ich mein Programm jetzt fertig, füge ich noch andere praktische Funktionen hinzu, gut das ich ein Protokoll verwende.

Vielen Dank für die viele Hilfe,
robii.


Narses - Sa 27.03.10 21:54

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Nach der letzen Korrektur von Narses klappt es jetzt endlich. :)
Fein, dann zeig doch auch den anderen Lesern mal den Code. ;)

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Und Narses, du hattest Recht, kaum habe ich mein Programm jetzt fertig, füge ich noch andere praktische Funktionen hinzu, gut das ich ein Protokoll verwende.
:D

cu
Narses


Robii - Sa 27.03.10 23:30

user profile iconNarses hat folgendes geschrieben Zum zitierten Posting springen:
user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Nach der letzen Korrektur von Narses klappt es jetzt endlich. :)
Fein, dann zeig doch auch den anderen Lesern mal den Code. ;)

Hier einmal der Code:

CLIENT:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ScktComp, Protokoll,ParserStrList, TCTrans, StdCtrls, ShellApi;

type
  TForm1 = class(TForm)
    [..]
  public
    { Public-Deklarationen }
    ReceiveBuffer: String;
    hBitmap: TBitMap;
    Data: TParserStringList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// EIGENE PROCEDUREN
function TForm1.GetCmdToken(const StrToken: String): TCmdToken;
begin
Result := Low(Syntax);
while ( (Result < cmdERROR)
and
(StrToken <> Syntax[Result].Text) ) do
Inc(Result);
end;

procedure TForm1.BildSenden;
var
  sIMG: TStringStream;
begin
  hBitmap := TBitmap.Create;
  CreateScreenshot(hBitmap);
  Image1.Picture.Assign(hBitmap);
  sIMG := TStringStream.Create('');
    try
    Image1.Picture.Bitmap.SaveToStream(sIMG);
    Client.Socket.SendText(Syntax[cmdIN].Text+#13+MaskTermChar(sIMG.DataString)+#13);
  finally
    sImg.Free;
  end;
  Data.Delete(0);
end;

procedure TForm1.Execute(Cmd: TCmdToken; lData: TParserSTringList);
var
  i: Integer;
  Rec: TRect;
begin
case Cmd of
  cmdNOP:
    ;
  cmdSCR:
    BildSenden
    ;
  cmdERROR:
    ;
end;
end;

procedure TForm1.ParseBuffer;
var
  outofArg: Boolean;
  Current: TCmdToken;
begin
  Data := TParserStringList.Create;
  outofArg := False;
  Data.ParseText(ReceiveBuffer);
  try
  while (Data.Count > 0and (NOT outofArg) do begin
    Current := GetCmdToken(UpperCase(Data.Strings[0]));
    If Data.Count >= Syntax[Current].ArgCount
      Then Begin
        Execute(Current,Data);
      End
      Else
        OutOfArg := True;
    end;
    Receivebuffer := Data.Text
  finally
    Data.Free;
  end;
end;

procedure TForm1.CreateScreenshot(var Bitmap: TBitmap);
var
  dc: THandle;
begin
If Assigned(Bitmap) then
  begin
  dc := GetDC(0);
  try
  with Bitmap do
    begin
    Width := Screen.Width;
    Height:= Screen.Height;
    BitBlt(Canvas.Handle,0,0,Screen.Width,Screen.Height,dc,0,0,SrcCopy);
    end;
  finally
  ReleaseDC(0, dc);
  end;
end;
end;

//AUTOMATISCHE PROCEDUREN
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Client.Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Client.Port := SERVER_PORT;
Client.Address:= SERVER_ADDR;
Client.Host := SERVER_ADDR;
Client.Open;
end;

procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
ParseBuffer;
end;

end.


SERVER:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ExtCtrls, ParserStrList, Protokoll, TCTrans;

type
  TForm1 = class(TForm)
    [..]
  public

    { Public-Deklarationen }
    ReceiveBuffer: String;
    Data: TParserStringList
  end;

var
  Form1: TForm1;
  xBit: TBitMap;

implementation

uses Unit2;

{$R *.dfm}

//EIGENE PROCEDUREN
function TForm1.GetCmdToken(const StrToken: String): TCmdToken;
begin
Result := Low(Syntax);
while ( (Result < cmdERROR)
and
(StrToken <> Syntax[Result].Text) ) do
Inc(Result);
end;

procedure TForm1.BildEmpfangen(Cur: TCmdToken);
var
  sIMG: TStringStream;
  i: Integer;
begin
  sIMG := TStringStream.Create(UnmaskTermChar(Data.Strings[1]));
  Image1.Picture.Bitmap.LoadFromStream(sIMG);
  Form2.Image1.Picture := Form1.Image1.Picture;
  sIMG.Free;
  for i := 0 to Syntax[Cur].ArgCount - 1 do
  Data.Delete(0);
end;

procedure TForm1.Execute(Cmd: TCmdToken);
var
  i: integer;
begin
case Cmd of
  cmdNOP:
    ;
  cmdIN:
  begin
    BildEmpfangen(Cmd);
  end;
  cmdERROR:
    ;
end;
end;

procedure TForm1.ParseBuffer;
var
  outofArg: Boolean;
  Current: TCmdToken;
  x: integer;
begin
  outofArg := False;
  Data.ParseText(ReceiveBuffer);
  x := Data.Count;
//  try
  while (Data.Count > 0and (NOT outofArg) do begin
    Current := GetCmdToken(UpperCase(Data.Strings[0]));
    If Data.Count >= Syntax[Current].ArgCount
      Then Begin
        Execute(Current);
      End
      Else
        OutOfArg := True;
    end;
end;

//AUTOMATISCHE PROCEDUREN
procedure TForm1.FormCreate(Sender: TObject);
begin
Data := TParserStringList.Create;
Server.Port := SERVER_PORT;
Server.Open;
xBit := TBitMap.Create;
end;

procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
ReceiveBuffer := ReceiveBuffer + Socket.ReceiveText;
ParseBuffer;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
for i := 0 to Server.Socket.ActiveConnections - 1 do
  Server.Socket.Connections[i].SendText(Syntax[cmdSCR].Text+#13);
end;

end.


PROTOKOLL:

Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
unit Protokoll;

interface

const

SERVER_PORT = XXXX; 
SERVER_ADDR = 'XX.XX.XXX.XXX';

type

TCmdSyntax = record
  Text: ShortString;
  ArgCount: Integer;
end;

TCmdToken = (
  cmdNOP = 0// Nichts tun
  cmdSCR,     // SCREEN-Befehl || Server -> Client
  cmdIN,      // INCOMING SCREEN || Client -> Server
  cmdERROR    // Fehler, ungültiger Befehl
  );

const


Syntax: Array[TCmdToken] of TCmdSyntax = (
  (Text: ''; ArgCount: 1),
  (Text: 'SCREEN'; ArgCount: 1),
  (Text: 'INCOMING'; ArgCount: 2),
  (Text: ''; ArgCount: 1)
  );

implementation

end.


Ich hoffe ich kann damit Anderen helfen.

Lieben Gruß,
Robii.

Moderiert von user profile iconNarses: Zitat gekürzt.


Narses - So 28.03.10 02:40

Moin!

user profile iconRobii hat folgendes geschrieben Zum zitierten Posting springen:
Ich hoffe ich kann damit Anderen helfen.
Sorry, aber du scheinst dir kaum selbst helfen zu können. :? Dein Code funktioniert so gerade eben (in diesem speziellen Fall), auf dieser Code-Basis wirst du noch interessante Effekte erleben. Du hast das Tutorial leider noch nicht ausreichend verstanden. :nixweiss:

Naja, um das hier zu einem Ende zu bringen im Anhang meine überarbeitete Version des Codes (incl. direkt ausführbarer EXEn, aber UPX-gepackt, wird also Avira zum Zicken machen animieren; wer mir nicht traut: EXE-Dateien löschen und Code selbst übersetzen).

cu
Narses