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:

procedure TForm4.Button1Click(Sender: TObject);
var
   Start: string;
   Name: string;
   Pwd: string;
   Stop: string;
   X, S, S1, S2:  string;
   a: array[0..20] of Ansichar;
   I1, I2 : Integer;

begin
   //
    //IdTCPClient1.Host := '192.168.178.46'; //
    //IdTCPClient1.Port := 5000; //
    IdTCPClient1.Host := IP;
    IdTCPClient1.Port := StrToInt(Form4.Edit2.Text);
    //IdTCPClient1.ReadTimeout := 600;

    Start := #$01#$02;

    Name  := #$55#$53#$45#$52#$3a;
    s1 := '';
    I1:= 21 - Length(Form4.Edit3.Text);
    S1:= Edit3.Text + StringOfChar(' ', I1);
    StrPCopy(Versuch.UserID, S1);

    Pwd   := #$50#$57#$44#$3a;
    s2 := '';
    I2:= 21 - Length(Form4.Edit4.Text);
    S2:= Edit4.Text + StringOfChar(' ', I2);
    StrPCopy(Versuch.Passwort, S2);

    Stop := #$01#$00;

     //IdTCPClient1.Connect;

  S := Start+Name+Versuch.UserID+Pwd+Versuch.Passwort+Stop;


  if IdTCPClient1.Connected = False then
    IdTCPClient1.Connect

  else
    Label5.Text := ('Connected');
    idTcpClient1.IOHandler.Write(S);
    
  try
    while IdTCPClient1.IOHandler.CheckForDataOnSource(IdTimeoutDefault) do begin end;
  finally
    X := IdTCPClient1.IOHandler.InputBufferAsString;
    //X:= chr(IdTcpClient1.IOHandler.ReadByte);
   Memo1.Lines.add('Version: ' + X);
    Label6.Text:= X;
    //Timer1.Enabled:=True;

  end;
 End;					

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:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:

unit UClientSimple;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  ExtCtrls, IdStack, IdGlobal;

  type
   TMyRec = record
       UserID : array[0..20] of Char;
       Passwort : array[0..20] of Char;
end;

type
  //Le type de l'évenement OnReception
  TReceptEvent = procedure (Sender : TObject; Recept : string) of object;

  TReceptionthread = class(TThread)
  private
    FRecept : string;
    FIdClient : TIdTCPClient;
    FOnReception : TReceptEvent;
  protected
    procedure Execute; override;
    procedure DoOnReception;
  public
    constructor Create (CreateSuspended : boolean; AIdTCPClient : TIdTCPClient);

    //L'évenement OnReception
    property OnReception : TReceptEvent read FOnReception write FOnReception;
  end;

  TFClient = class(TForm)
    IdTCPClient1: TIdTCPClient;
    EMessage: TEdit;
    BConnect: TButton;
    BSend: TButton;
    MChat: TMemo;
    EHost: TLabeledEdit;
    BDisconnect: TButton;
    Timer1: TTimer;
    Button1: TButton;
    Label1: TLabel;
    procedure BDisconnectClick(Sender: TObject);
    procedure BSendClick(Sender: TObject);
    procedure BConnectClick(Sender: TObject);
    procedure IdTCPClient1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure Button1Click(Sender: TObject);
    procedure DomoSend();
    {procedure DomoSend(para1: byte; port1: byte; port2: byte; port3: byte; port4: byte; port5: byte; port6: byte; port7: byte; port8: byte; para3: byte);}
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

  private
    FReceptionThread : TReceptionThread;
    StartTime: TTime;

    { Déclarations privées }
  public
    procedure ReceptionMessage (Sender : TObject; Recept : string);


    { Déclarations publiques }
  end;

var
  FClient: TFClient;
  Versuch : TMyRec;
       IP : String;

implementation

{$R *.dfm}
{Convert a string to a hex string, obviously twice as long. Rudementary encryption, good for passing funny characters as parameters in a url}
function StringToHex(S: String): String;
var I: Integer;
begin
  Result:= '';
  for I := 1 to length (S) do
    Result:= Result+' '+IntToHex(ord(S[i]),2);
end;


function GetRemoteIp(const pHostName: string): string;

begin
  TIdStack.IncUsage;
  try
    Result := GStack.ResolveHost(pHostName);
  finally
    TIdStack.DecUsage;
  end;
end;

procedure TFClient.BConnectClick(Sender: TObject);
begin
  //Nous vérifions si l'adresse IP saisie est valide, dans le cas contraire, nous en informons l'utilisateur
  //if not GStack.IsIP(EHost.Text) then
    MChat.lines.Clear;
    if  GetRemoteIp(EHost.Text) ='' then
    ShowMessage('L''adresse IP saisie est invalide.')
  else
  begin
    try
      //Nous nous connectons. Si cette ligne déclenche une exception, la suite ne sera pas exécutée.
      //Le port saisi ici doit être le même que celui du serveur.
      IdTCPClient1.Connect(EHost.Text, 6355);

      //Nous créons notre thread destiné à gerer la réception des messages.
      FReceptionThread:=TReceptionthread.Create(false,IdTCPClient1);
      // Nous lui affectons aussi son évenement OnReception.
      FReceptionThread.OnReception:=ReceptionMessage;

      //Nous activons les composants de notre fiche
      Button1.Enabled := True;
      BDisconnect.Enabled:=true;
      BConnect.Enabled:=false;
      BSend.Enabled:=true;
      EMessage.Enabled:=true;
      MChat.Enabled:=true;
    except
      ShowMessage('Connection avec le serveur impossible.');
    end;
  end;
end;


procedure TFClient.BDisconnectClick(Sender: TObject);
begin
  //Procedure de déconnection
  Timer1.Enabled := False;
  IdTCPClient1.Disconnect;

  //Désactivation des composants de la fiche
  Button1.Enabled := False;
  BDisconnect.Enabled:=false;
  BConnect.Enabled:=true;
  BSend.Enabled:=false;
  EMessage.Enabled:=false;
  MChat.Enabled:=false;
end;

procedure TFClient.BSendClick(Sender: TObject);
Var port1on: string;

begin
  //Envoi 
    DomoSend();
 // port1on := #$04#$01#$02#$23#$3c#$00#$0a#$01#$ff#$00#$00#$00#$00#$00#$00#$00#$fe;
  //IdTCPClient1.IOHandler.WriteLn(EMessage.Text);
 // IdTCPClient1.IOHandler.Write(port1on);
  EMessage.Clear;
end;

procedure TFClient.Button1Click(Sender: TObject);
var
   Start: string;
   Name: string;
   Pwd: string;
   Stop: string;
   X, S, S1, S2:  string;
   a: array[0..20] of Ansichar;
   I1, I2 : Integer;
begin
      StartTime := Time;
    //IdTCPClient1.Host := '192.168.178.46'; //
    //IdTCPClient1.Port := 5000; //
    //TCPClient.Host := 'www.jeng-net.lu'; //IP;
    //TCPClient.Port := 6355;//StrToInt(Form4.Edit2.Text);
    //IdTCPClient1.ReadTimeout := 600;
    Start := #$01#$02;

    Name  := #$55#$53#$45#$52#$3a;
    s1 := '';
    I1:= 21 - Length('admin'); //Length(Edit3.Text);
    S1:= 'admin' + StringOfChar(' ', I1); //Edit3.Text + StringOfChar(' ', I1);
    StrPCopy(Versuch.UserID, S1);

    Pwd   := #$50#$57#$44#$3a;
    s2 := '';
    I2:= 21 - Length('admin');//Length(Edit4.Text);
    S2:=  'admin' + StringOfChar(' ', I2); //Edit4.Text + StringOfChar(' ', I2);
    StrPCopy(Versuch.Passwort, S2);

    Stop := #$01#$00;

     //IdTCPClient1.Connect;

  // Name:=  #$61#$64#$6d#$69#$6e#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20;
  //TMyRec.Pword := #$50#$57#$44#$3a;
  // Pw:=    #$61#$64#$6d#$69#$6e#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20#$20;
  //TMyRec.byte2 := #$01;
  //TMyRec.Byte3 := #$00;
    S := Start+Name+Versuch.UserID+Pwd+Versuch.Passwort+Stop;
  //Memo1.Lines.Add(Form4.Edit3.Text[1]);
  //s := #$03+#$00+#$8F+#$14+#$FF+#$05+#$0C+#$30;
   Timer1.Enabled := True;
   IdTCPClient1.IOHandler.Write(S);

end;

procedure TFClient.FormCreate(Sender: TObject);
begin
IP := GetRemoteIp(FClient.EHost.Text);
end;

{Procedure TFClient.DomoSend(para1: byte; port1: byte; port2: byte; port3: byte;
  port4: byte; port5: byte; port6: byte; port7: byte; port8: byte; para3: byte);}
// A procedure with parameters
Procedure TFClient.DomoSend();
var
  Buf: TIdBytes;
begin

  SetLength(Buf, 17);
  //TCP Exo1 Port1 OFF Hex: 04 01 02 23 3c 00 0a 01 00 00 00 00 00 00 00 00 01
  //TCP Exo1 Port1 On  Hex: 04 01 02 23 3c 00 0a 01 ff 00 00 00 00 00 00 00 fe

  FillBytes(Buf, 17, 0); // para3 = off
  Buf[0] := $04;
  Buf[1] := $01;
  Buf[2] := $02;
  Buf[3] := $23;
  Buf[4] := $3c; // para1; //Exo1
  Buf[5] := $00;
  Buf[6] := $0a;
  Buf[7] := $01;
  Buf[8] := $ff;//port1;
  Buf[9] := $00;//port2;
  Buf[10] := $00;//port3;
  Buf[11] := $00;//port4;
  Buf[12] := $00;//port5;
  Buf[13] := $00;//port6;
  Buf[14] := $00;//port7;
  Buf[15] := $00;//port8;
  Buf[16] := $fe;//para3;

  FClient.IdTCPClient1.IOHandler.Write(Buf, 17);
  //sleep(5);
    // Memo1.Clear;
  // if ReceivedString = '' then
  // Memo1.Lines.Add('No response received from the server after ' +
  // IntToStr(IdUDPClient1.ReceiveTimeout) + ' millseconds.')
  // else
  // Memo1.Lines.Add('Received: ' + ReceivedString);
end;

procedure TFClient.IdTCPClient1Status(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: string);
begin
     MChat.Lines.Add(AStatusText);
end;

procedure TFClient.ReceptionMessage (Sender : TObject; Recept : string);
begin
  //Evenement OnReception de notre objet TReceptionThread
  //Si nous n'avions pas utilisé la méthode Synchronize, l'utilisation du Mémo Mchat pourrait poser des problemes.

  MChat.Lines.Add(Recept);
end;

procedure TFClient.Timer1Timer(Sender: TObject);
begin
Label1.Caption := TimeToStr(Time - StartTime);
end;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//                          Objet TReceptionThread                            //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////

constructor TReceptionThread.Create (CreateSuspended : boolean; AIdTCPClient : TIdTCPClient);
begin
  inherited Create(CreateSuspended);
  FIdClient:=AIdTCPClient;
end;

procedure TReceptionThread.DoOnReception;
begin
  //Si l'évenement OnReception a été assigné, alors on l'exécute en lui fournissant les bons parametres
  if Assigned(FOnReception) then
    FOnReception(Self,FRecept);
end;

procedure TReceptionThread.Execute;
    var AByte:array[0..17] of Byte;
        Count,i: Integer;
        Value1, Value2 : Integer;
        Recieve: integer;
        RBuffer: TIdBytes;
        RByteBuffer: array of byte;
        AnsiSTR : String;

    //Buffer: array[0..255] of Char;
begin
  //On exécute en boucle jusqu'a que le thread se termine
   SetLength(RBuffer, 17);
   FillBytes(RBuffer, 17, 0);

  while FIdClient.connected and not Terminated do

  begin
    FRecept:='';

    

    //On utilise une structure Try Except qui permet de détecter la déconnection du client.
    //Si le client se déconnecte, ReadLn provoque une exception, et donc le thread se terminera.
    try
        FIdClient.IOHandler.CheckForDataOnSource(500);
        count := FIdClient.IOHandler.InputBuffer.Size;

        FIdClient.IOHandler.ReadBytes(RBuffer, FidClient.IOHandler.InputBuffer.Size,False);

        SetLength(RByteBuffer, count);
        Move(RBuffer[0], RByteBuffer[0], count);
        SetString(AnsiStr, PAnsiChar(@RByteBuffer[0]), Length(RByteBuffer));
      
      if count > 0 then

               FRecept:='Got: ' + IntToStr(count) +' bytes ' + Ansistr + ' ' +StringToHex(ansistr);

      except
      Terminate;
    end;

     //if FRecept = 'V' then
     //   Fclient.Mchat.Lines.add('Version: ' + FRecept);

     if FRecept<>'' then
    //On synchronise l'évenement OnReception pour pouvoir utiliser les éléments de la VCL
      Synchronize(DoOnReception);

  end;
end;


end.