*.BMP - Verschicken

Narses · Verfasst: Mi 24.03.10 16:34

Moin!

Robii hat folgendes geschrieben :

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.

Robii hat folgendes geschrieben :

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.

Robii hat folgendes geschrieben :

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.

Robii hat folgendes geschrieben :

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

_________________
There are 10 types of people - those who understand binary and those who don´t.

Robii · Beiträge: 236

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

markieren

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 > 0) and (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:

markieren

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 · Verfasst: Do 25.03.10 00:50

Moin!

Robii hat folgendes geschrieben :

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.

Robii hat folgendes geschrieben :

Das ist mein Protokoll:

Kann man so machen, auch wenn die Server-Adresse da nix zu suchen hat.

Robii hat folgendes geschrieben :

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:

Robii hat folgendes geschrieben :

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...

Einfach starten, Online schalten, einen Browser nehmen und als Adresse "http://localhost:8080" eingeben, Return drücken, zur Anmeldung "user" und "kennwort" eingeben, staunen.

cu
Narses

Einloggen, um Attachments anzusehen!

_________________
There are 10 types of people - those who understand binary and those who don´t.

Robii · Beiträge: 236

Narses hat folgendes geschrieben :

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:

markieren

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 icon

Narses für die Hilfe,
lieben Gruß, robii.

Edit:

Client-Quellcode:

markieren

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 > 0) and (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:

markieren

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 > 0) and (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:

markieren

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]

Robii · Beiträge: 236

// Push

Narses · Verfasst: Fr 26.03.10 17:29

Moin!

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?

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Robii · Beiträge: 236

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 :

markieren

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 > 0) and (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 · Verfasst: Fr 26.03.10 18:26

Moin!

Robii hat folgendes geschrieben :

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...

)

Robii hat folgendes geschrieben :

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.

Robii hat folgendes geschrieben :

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

_________________
There are 10 types of people - those who understand binary and those who don´t.

Robii · Beiträge: 236

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 · Verfasst: Sa 27.03.10 21:54

Moin!

Robii hat folgendes geschrieben :

Nach der letzen Korrektur von Narses klappt es jetzt endlich.

Fein, dann zeig doch auch den anderen Lesern mal den Code.

Robii hat folgendes geschrieben :

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.

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Robii · Beiträge: 236

Narses hat folgendes geschrieben :

Robii hat folgendes geschrieben :

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:

markieren

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 > 0) and (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:

markieren

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 > 0) and (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:

markieren

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 Narses: Zitat gekürzt.

Narses · Verfasst: So 28.03.10 02:40

Moin!

Robii hat folgendes geschrieben :

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

Einloggen, um Attachments anzusehen!

_________________
There are 10 types of people - those who understand binary and those who don´t.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme