WebSocket HTML5 et Delphi

**ShaiLeTroll** · 28/06/2011, 18h25

Essaye SANS server !
Développe petit à petit !
Utilise des valeurs de tests et un retour prévisible dans une application de test !
Une fois la fonction stable dans ce contexte avec le bon résultat, passe à l'étape Socket !

**shadow578** · 29/06/2011, 10h32

Je sais bien qu'il faut faire de faux truc pour tester mais sur un test serveur je ne vois pas comment ...

En tout cas j'ai beau corriger des erreurs ça ne marche point..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
 
var
  Form1: TForm1;
  origin, host: string;
implementation
uses Wcrypt2;
{$R *.dfm}
 
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar1.Panels[0].Text := 'Connexion de ' + Socket.RemoteAddress;
end;
 
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var s: string;
begin
  s := Socket.ReceiveText;
  Memo1.Lines.Add(s);
  envoyerFichier(socket, s);
end;
 
procedure TForm1.envoyerFichier(Socket: TCustomWinSocket; nomFichier: String);
var s, md5rep: string;
begin
  md5rep := decodeEntete(nomFichier);
  s := 'HTTP/1.1 101 WebSocket Protocol Handshake' + #13#10
    +  'Upgrade: WebSocket' + #13#10
    +  'Connection: Upgrade' + #13#10
    +  'Sec-WebSocket-Location: ws://'+host+ #13#10
    +  'Sec-WebSocket-Origin: '+origin+ #13#10
    +  'Sec-WebSocket-Protocol: sample' + #13#10
    + #13#10 + md5rep;
 
  Memo1.Lines.Add(s);
  Socket.SendText(s);
end;
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
end;
 
function TForm1.decodeEntete(s:string):string;
var i: integer;
  key1, key2, data: string;
begin
  data := ''; key1 := ''; key2:='';
  For i := 1 to 10 do begin
    if(pos('Sec-WebSocket-Key1: ', Memo1.Lines[i]) > 0) then
      key1 := Memo1.Lines[i]
    else if(pos('Sec-WebSocket-Key2: ', Memo1.Lines[i]) > 0) then
      key2 := Memo1.Lines[i];
 
    case i of
      3: host   := copy(Memo1.Lines[i], 7, length(Memo1.Lines[i]));
      4: origin := copy(Memo1.Lines[i], 9, length(Memo1.Lines[i]));
      8: data   := Memo1.Lines[i];
    end;
  end;
 
  key1 := copy(key1, 21, length(key1));
  key2 := copy(key2, 21, length(key2));
 
  result := Hixie76Signature(key1, key2, data);
 
end;
 
function Tform1.Hixie76Signature(key1, key2, data: string): string;
var test, n1, n2, totalKey: string;
    i, s1, s2: integer;
    p1, p2: LongWord;
    resultHexa: string;
    Token : string;
begin
  result := '';
  s1 := 0;
  n1 := '';
  s2 := 0;
  n2 := '';
  for i := 1 to length(key1) do
  begin
    if ((key1[i] >= '0') and (key1[i] <= '9')) then
      n1 := n1 + key1[i];
    if (key1[i] = ' ') then
      inc(s1);
  end;
  for i := 1 to length(key2) do
  begin
    if ((key2[i] >= '0') and (key2[i] <= '9')) then
      n2 := n2 + key2[i];
    if (key2[i] = ' ') then
      inc(s2);
  end;
 
  p1 := StrToInt64(n1) div s1;
  p2 := StrToInt64(n2) div s2;
 
  p1 := SwapLongword(p1);
  p2 := SwapLongword(p2);
 
  SetLength(Token, 16);
  CopyMemory(@Token[1], @p1, 4);
  CopyMemory(@Token[5], @p2, 4);
  CopyMemory(@Token[9], @data[1], 8); 
 
  resultHexa := md5(Token);
  // Hexa -> Binaire, MD5 ne fourni que des digits de 0 à 7F, pas besoin d'UTF8
  SetLength(Result, 16);
  HexToBin(@resultHexa[1], @Result[1], 16);
 
 
 
end;
 
function TForm1.md5(const Input: String): String;
var
  hCryptProvider: HCRYPTPROV;
  hHash: HCRYPTHASH;
  bHash: array[0..$7f] of Byte;
  dwHashBytes: Cardinal;
  pbContent: PByte;
  i: Integer;
 
begin
  dwHashBytes := 16;
  pbContent := Pointer(PChar(Input));
 
  Result := '';
 
  if CryptAcquireContext(@hCryptProvider, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT or CRYPT_MACHINE_KEYSET) then
  begin
    if CryptCreateHash(hCryptProvider, CALG_MD5, 0, 0, @hHash) then
    begin
      if CryptHashData(hHash, pbContent, Length(Input) * sizeof(Char), 0) then
      begin
        if CryptGetHashParam(hHash, HP_HASHVAL, @bHash[0], @dwHashBytes, 0) then
        begin
          for i := 0 to dwHashBytes - 1 do
          begin
            Result := Result + Format('%.2x', [bHash[i]]);
          end;
        end;
      end;
      CryptDestroyHash(hHash);
    end;
 
    CryptReleaseContext(hCryptProvider, 0);
  end;
 
  Result := AnsiLowerCase(Result);
end;
 
function TForm1.SwapLongword(Value: Longword): Longword;
asm
  BSWAP EAX
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerSocket1.Open;
  StatusBar1.Panels[1].Text := ' Connecté';
end;
 
end.

EDIT:

Je viens de m'appercevoir que à ce niveau là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
p1 := StrToInt64(n1) div s1;
  p2 := StrToInt64(n2) div s2;
 
  p1 := SwapLongword(p1);
  p2 := SwapLongword(p2);

p1 = p2 !!
Pas normal... ???

**ShaiLeTroll** · 29/06/2011, 17h18

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 8: data   := Memo1.Lines[i];

Dans une autre version de ton code, tu avais mis 9 !
Retire cette utilisation par ligne, recupère les 8 derniers octets directement

s c'est le paramètre de decodeEntete qui j'ai bien lu, c'est le contenu de Socket.ReceiveText;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 data := copy(s, Length(s) - 8 + 1, 8);
 key1 := copy(key1, 21, length(key1));

je modifierais ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
s := Socket.ReceiveText;
  Memo1.Lines.Add(s);

en ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
s := Socket.ReceiveText;
  Memo1.Lines.Text := s;

il y a très peu de probablité que P1 et P2 soit Egaux

Je sais bien qu'il faut faire de faux truc pour tester mais sur un test serveur je ne vois pas comment ...

oubli la notion de serveur pour le debug !
tu fais un Bouton et un code de test comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
procedure TForm1.ButtonTest(Sender: TObject);
var s: string;
begin
  s := 'GET /demo HTTP/1.1' + #13#10 + 
        'Host: example.com' + #13#10 + 
        'Connection: Upgrade' + #13#10 + 
        'Sec-WebSocket-Key2: 12998 5 Y3 1  .P00' + #13#10 + 
        'Sec-WebSocket-Protocol: sample' + #13#10 + 
        'Upgrade: WebSocket' + #13#10 + 
        'Sec-WebSocket-Key1: 4 @1  46546xW%0l 1 5' + #13#10 + 
        'Origin: http://example.com' + #13#10 + 
       + #13#10 + 
        '^n:ds[4U'
 
 
  Memo1.Lines.Text := s;
  ShowMessage(decodeEntete(s) + ' doit être : "8jKS''y:G*Co,Wxa-"');
end;

**shadow578** · 29/06/2011, 17h43

J'ai fait ce que tu m'as dit et j'ai des carrés à la place... regarde

http://s3.noelshack.com/upload/7795242977742_test.png

L'encodage mauvais ?

Le problème vient de là:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 p1 := SwapLongword(p1);
  p2 := SwapLongword(p2);

P1 et P2 devient égaux ! Toujours égale à ceci: 2552216064

**ShaiLeTroll** · 30/06/2011, 10h01

Tu utilises un Memo1 !
Bon, tu as pensé à retirer WordWrap ?
Tu as corrigé 8 et 9

ou utilisé cette variante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 data := copy(s, Length(s) - 8 + 1, 8);
 key1 := copy(key1, 21, length(key1));

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
var 
    p1, p2: LongWord;
    p1BE, p2BE: LongWord;
...
 
  p1 := StrToInt64(n1) div s1;
  p2 := StrToInt64(n2) div s2;
 
  p1BE := SwapLongword(p1);
  p2BE := SwapLongword(p2);
 
  SetLength(Token, 16);
  CopyMemory(@Token[1], @p1BE, 4);
  CopyMemory(@Token[5], @p2BE, 4);
  CopyMemory(@Token[9], @data[1], 8);

C'est étrange, je l'ai testé en C++Builder, tu devrais tester de la même façon !

Code c++ :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
//---------------------------------------------------------------------------
 
//#pragma option push -w-rvl
LongWord __fastcall SwapLongword(LongWord Value)
{
  asm
  {
    BSWAP EAX;
  }
}
//#pragma option pop
 
void __fastcall TBeginningCPPMainForm::Button1Click(TObject *Sender)
{
  LongWord p1, p2;
  p1 = 123;
  p2 = 456;
 
  p1 = SwapLongword(p1);
  p2 = SwapLongword(p2);
 
  ShowMessage(p1);
  ShowMessage(p2);
}

J'ai testé de Delphi aussi, je n'ai pas de mélange de valeur !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
//---------------------------------------------------------------------------
 
   function SwapLongword(Value: Longword): Longword;
   asm
    BSWAP EAX
   end;
 
procedure TFirstProjectMain.Button1Click(Sender: TObject);
var
  p1, p2: LongWord;
begin
  p1 := 123;
  p2 := 456;
 
  p1 := SwapLongword(p1);
  p2 := SwapLongword(p2);
 
  ShowMessage(IntToStr(p1));
  ShowMessage(IntToStr(p2));
end;

**shadow578** · 30/06/2011, 10h08

Wordwrap était sur true mais ça ne change rien ..

J'ai essayé avec ton code est j'obtiens 2552216064 avec P1BE = P2BE !!

Ça me rend dingue !

**ShaiLeTroll** · 30/06/2011, 10h14

Envoyé par shadow578

Wordwrap était sur true mais ça ne change rien ..

Tu te rends compte que si le memo n'était pas assez large cela décale TOUS les Offsets !

Je crois que tu vas rester Dingue, le code fonctionne en C++Builder 2007 et Delphi XE, Bon Courage !

Il n'y a aucune raison que sur D7 cela ne fonctionne pas !
J'ai écrit la fonction ASM pour D6 ! C'est TRES VIEUX, j'ai eu besoin de passer du Big Endian en Little Endian et cela fonctionnait très bien en D6 et D7 !

4146546015 div 5 -> 829309203 -> 323055153
1299853100 div 5 -> 259970620 -> 1020689935

2552216064 est une valeur qui n'entre JAMAIS dans l'opération, tu as une erreur bien avant !
As-tu vérifié n1 et n2 ?

Sur Delphi XE, j'obtiens

---------------------------
Firstproject
---------------------------
8jKS'y:G*Co,Wxa- doit être : "8jKS'y:G*Co,Wxa-"
---------------------------
OK
---------------------------

Ton code fonctionne même sous XE, j'ai juste utiliser AnsiChar et AnsiString ce qui est implicite en D7 (sous XE ce n'est plus le cas !)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
unit FrmFirstProjectMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Vcl.StdCtrls, wcrypt2;
 
type
  TFirstProjectMain = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ButtonTest: TButton;
    procedure Button1Click(Sender: TObject);
procedure ButtonTestClick(Sender: TObject);
  private
    { Déclarations privées }
function decodeEntete(s:Ansistring):Ansistring;
function Hixie76Signature(key1, key2, data: Ansistring): Ansistring;
function md5(const Input: Ansistring): Ansistring;  public
    { Déclarations publiques }
  end;
 
var
  FirstProjectMain: TFirstProjectMain;
 
 
 
implementation
 
{$R *.dfm}
 
   function SwapLongword(Value: Longword): Longword;
   asm
    BSWAP EAX
   end;
 
procedure TFirstProjectMain.Button1Click(Sender: TObject);
var
  p1, p2: LongWord;
begin
  p1 := 123;
  p2 := 456;
 
  p1 := SwapLongword(p1);
  p2 := SwapLongword(p2);
 
  ShowMessage(IntToStr(p1));
  ShowMessage(IntToStr(p2));
end;
 
function TFirstProjectMain.decodeEntete(s:Ansistring):Ansistring;
var i: integer;
  key1, key2, data: Ansistring;
  host, origin: Ansistring;
begin
  data := ''; key1 := ''; key2:='';
  For i := 1 to 10 do begin
    if(pos('Sec-WebSocket-Key1: ', Memo1.Lines[i]) > 0) then
      key1 := Memo1.Lines[i]
    else if(pos('Sec-WebSocket-Key2: ', Memo1.Lines[i]) > 0) then
      key2 := Memo1.Lines[i];
 
    case i of
      3: host   := copy(Memo1.Lines[i], 7, length(Memo1.Lines[i]));
      4: origin := copy(Memo1.Lines[i], 9, length(Memo1.Lines[i]));
 
    end;
  end;
 
  data := copy(s, Length(s) - 8 + 1, 8);
  key1 := copy(key1, 21, length(key1));
  key2 := copy(key2, 21, length(key2));
 
  result := Hixie76Signature(key1, key2, data);
 
end;
 
 
 
 
procedure TFirstProjectMain.ButtonTestClick(Sender: TObject);
var s: ansistring;
begin
  s := 'GET /demo HTTP/1.1' + #13#10 +
        'Host: example.com' + #13#10 +
        'Connection: Upgrade' + #13#10 +
        'Sec-WebSocket-Key2: 12998 5 Y3 1  .P00' + #13#10 +
        'Sec-WebSocket-Protocol: sample' + #13#10 +
        'Upgrade: WebSocket' + #13#10 +
        'Sec-WebSocket-Key1: 4 @1  46546xW%0l 1 5' + #13#10 +
        'Origin: http://example.com' + #13#10
       + #13#10 +
        '^n:ds[4U';
 
 
  Memo1.Lines.Text := s;
  ShowMessage(decodeEntete(s) + ' doit être : "8jKS''y:G*Co,Wxa-"');
end;
 
function TFirstProjectMain.Hixie76Signature(key1, key2, data: Ansistring): Ansistring;
var test, n1, n2, totalKey: Ansistring;
    i, s1, s2: integer;
    p1, p2: LongWord;
    resultHexa: Ansistring;
    Token : Ansistring;
    PToken: PAnsiChar;
begin
  result := '';
  s1 := 0;
  n1 := '';
  s2 := 0;
  n2 := '';
  for i := 1 to length(key1) do
  begin
    if ((key1[i] >= '0') and (key1[i] <= '9')) then
      n1 := n1 + key1[i];
    if (key1[i] = ' ') then
      inc(s1);
  end;
  for i := 1 to length(key2) do
  begin
    if ((key2[i] >= '0') and (key2[i] <= '9')) then
      n2 := n2 + key2[i];
    if (key2[i] = ' ') then
      inc(s2);
  end;
 
  p1 := StrToInt64(n1) div s1;
  p2 := StrToInt64(n2) div s2;
 
  p1 := SwapLongword(p1);
  p2 := SwapLongword(p2);
 
  SetLength(Token, 16);
  PToken := PAnsiChar(Token);
  CopyMemory(PToken, @p1, 4);
  Inc(PToken, 4);
  CopyMemory(PToken, @p2, 4);
  Inc(PToken, 4);
  CopyMemory(PToken, PAnsiChar(data), 8);
 
  resultHexa := md5(Token);
  // Hexa -> Binaire, MD5 ne fourni que des digits de 0 à 7F, pas besoin d'UTF8
  SetLength(Result, 16);
  HexToBin(Pansichar(resultHexa), Pansichar(Result), 16);
 
 
 
end;
 
function TFirstProjectMain.md5(const Input: Ansistring): Ansistring;
var
  hCryptProvider: HCRYPTPROV;
  hHash: HCRYPTHASH;
  bHash: array[0..$7f] of Byte;
  dwHashBytes: Cardinal;
  pbContent: PByte;
  i: Integer;
 
begin
  dwHashBytes := 16;
  pbContent := Pointer(PAnsiChar(Input));
 
  Result := '';
 
  if CryptAcquireContext(@hCryptProvider, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT or CRYPT_MACHINE_KEYSET) then
  begin
    if CryptCreateHash(hCryptProvider, CALG_MD5, 0, 0, @hHash) then
    begin
      if CryptHashData(hHash, pbContent, Length(Input) * sizeof(AnsiChar), 0) then
      begin
        if CryptGetHashParam(hHash, HP_HASHVAL, @bHash[0], @dwHashBytes, 0) then
        begin
          for i := 0 to dwHashBytes - 1 do
          begin
            Result := Result + Format('%.2x', [bHash[i]]);
          end;
        end;
      end;
      CryptDestroyHash(hHash);
    end;
 
    CryptReleaseContext(hCryptProvider, 0);
  end;
 
  Result := AnsiLowerCase(Result);
end;
 
end.

**shadow578** · 30/06/2011, 10h24

(n1) / (s1) = P1 P1BE
4146546015 / 5 = 829309203 -> SwapLongword -> 2552216064
1299853100 / 5 = 259970620 -> SwapLongword -> 2552216064
(n2) / (s2) = P1 P2BE

Donc le problème vient réelement de SwapLongword...

Je viens de tester ton dernier code j'obtient la même clé !!

Je reprend tout et je verifie !!

**ShaiLeTroll** · 30/06/2011, 10h41

Tu as un délire de l'optimisation !
C'est très génant, il ne doit pas aimer !
As-tu un Warning concernant Result ?

utilise donc l'autre SwapLongWord

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
function SwapLongword(Value: Longword): Longword;
type
  MapLongword = array[0..3] of Byte;
begin  
  TMapLongword(Result)[0] := TMapLongword(Value)[3];
  TMapLongword(Result)[1] := TMapLongword(Value)[2];
  TMapLongword(Result)[2] := TMapLongword(Value)[1];
  TMapLongword(Result)[3] := TMapLongword(Value)[0];
end;

Il est plus long mais fait la même chose !

**shadow578** · 30/06/2011, 10h42

alors après vérification que la clé est correct j'essaye avec le socket... serveur fermé je répond mal mais je peut en déduire que cela ne vient pas de la clé ..

**ShaiLeTroll** · 30/06/2011, 10h48

Tu as corrigé quoi finalement pour que le SwapLongWord fonctionne ?

Pour la transmission de la réponse et la gestion par Chrome, je ne peux pas t'aider !
Va falloir que tu trouves des outils de débug pour Chrome, cela doit bien exister !

**shadow578** · 30/06/2011, 10h52

Je n'est rien fait à par reprendre ton code ... Je ne pense pas que le fait de le mettre en premier change guère alors je ne sais pas...

En tout cas bizarre que je n'arrive pas à répondre l'entête que je répond et celle de Wikipédia avec mes infos et la clé doit être bien répondu puisque le fonctionnement de transformation marche en test..

Ca marche !!!!

Chrome à un debug il manquait un slash aprés localhost '/' -_- !!

Merci à toi en tout cas !

**ShaiLeTroll** · 30/06/2011, 11h07

C'était un sujet très interessant !
Après que tu auras poussé plus loin !
Je serais content de voir ton composant pour la gestion du Streaming en WebSockets avec les Objets HTML5 !

**shadow578** · 30/06/2011, 11h08

Je compte continuer et je viendrais sur ce topic faire part des avancés

**VLDG** · 30/06/2011, 13h55

Envoyé par ShaiLeTroll

Delphi On Rails ? ce n'est plus du Delphi mais du Ruby (c'est tout aussi éloigné de Delphi que l'est Delphi For PHP)

http://code.google.com/p/delphionrails/

celui la : c'est bien du Delphi (Pascal)

**BobaL** · 17/09/2012, 11h30

Pour ceux qui cherchent encore une solution (comme moi il y a encore 5 minutes

) :

Code Delphi :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
uses
  ..., IdBaseComponent, IdCoder, IdCoder3to4, IdCoderMIME, IdHashSHA1, IdGlobal;
 
...
 
function GetWebSocketAcceptKey(const WebSocketKey: string): string;
const
  cMagicString = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
var
  HashSHA1: TIdHashSHA1;
begin
  Result := '';
 
  HashSHA1 := TIdHashSHA1.Create;
  try
    Result := TIdEncoderMIME.EncodeBytes(HashSHA1.HashString(WebSocketKey + cMagicString, TIdTextEncoding.Default));
  finally
    HashSHA1.Free;
  end;
end;

WebSocket HTML5 et Delphi

Web & réseau Delphi

Discussions similaires

Partager

Partager