nusret
RTC Expired
Posts: 4
|
|
« Reply #2 on: May 14, 2018, 12:49:57 PM » |
|
unit Unit1;
interface
uses Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
rtcConn, rtcDataCli, rtcHttpCli, rtcSystem, rtcTimer ;
type TfrmClient = class(TForm) ListBox1: TListBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject);
private { Private declarations } FClient: TRtcHttpClient; FDataRq: TRtcDataRequest; FConnLost, FConnBusy: boolean; FtmLastPing: Cardinal; FPingTimer: TRtcTimer;
procedure DataRq_OnBeginRequest(Sender: TRtcConnection); procedure DataRq_OnDataReceived(Sender: TRtcConnection); procedure DataRq_OnResponseAbort(Sender: TRtcConnection);
procedure DoConnect; procedure DoConnLost(Sender: TRtcConnection); procedure DoPing;
public { Public declarations }
end;
var frmClient: TfrmClient;
implementation
{$R *.dfm}
procedure TfrmClient.FormCreate(Sender: TObject); begin FClient := TRtcHttpClient.Create(nil); FDataRq := TRtcDataRequest.Create(nil); with FDataRq do begin AutoSyncEvents := True; Client := FClient; HyperThreading := True; OnBeginRequest := DataRq_OnBeginRequest; OnDataReceived := DataRq_OnDataReceived; OnResponseAbort := DataRq_OnResponseAbort; end;
FClient.ServerAddr := '127.0.0.1'; FClient.ServerPort := '8088'; //FClient.MultiThreaded := True; FClient.AutoConnect := True;
DoConnect; end;
procedure TfrmClient.FormDestroy(Sender: TObject); begin if Assigned(FPingTimer) then TRtcTimer.Stop(FPingTimer); FreeAndNil(FClient); end;
procedure TfrmClient.DataRq_OnBeginRequest(Sender: TRtcConnection); var Cli: TRtcDataClient absolute Sender; begin if FConnLost then exit;
if Cli.Request.FileName = '/ping' then Cli.Write; end;
procedure TfrmClient.DataRq_OnDataReceived(Sender: TRtcConnection); var Cli: TRtcDataClient absolute Sender; Dt: RtcByteArray; begin if FConnLost then exit;
if Cli.Response.StatusCode <> 200 then DoConnLost(Sender) else if Cli.Response.Done then begin Dt := Cli.ReadEx; FtmLastPing := GetTickCount; FConnBusy := False; end; end;
procedure TfrmClient.DataRq_OnResponseAbort(Sender: TRtcConnection); var Cli: TRtcDataClient absolute Sender; begin Cli.Request.Skip; DoConnLost(Sender); end;
procedure TfrmClient.DoConnect; begin if not Assigned(FPingTimer) then begin FPingTimer := TRtcTimer.Create(True); TRtcTimer.Enable(FPingTimer, 1000, DoPing); end;
FConnLost := False; FConnBusy := False;
DoPing; end;
procedure TfrmClient.DoConnLost(Sender: TRtcConnection); begin if FConnLost then exit;
FConnLost := True; FClient.AutoConnect := False; //FClient.Disconnect; FClient.DisconnectNow(True); FClient.SkipRequests;
FConnBusy := False; FtmLastPing := 0; end;
procedure TfrmClient.DoPing; begin if (FtmLastPing + (2*1000) > GetTickCount) or FConnBusy then Exit;
FConnBusy := True; FtmLastPing := GetTickCount; FDataRq.Request.Method := 'GET'; FDataRq.Request.FileName := '/ping'; FDataRq.Post; end;
end.
|