type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
// cbIP: TComboBox;
protected
procedure DoRun; override;
private
FTCPClient: TTCPClient;
FSettings: TSettings;
FTCPBase: TTCPBase;
FTCPBaseType: TBaseType;
Connection: TConnection;
procedure AddLog(ALogMsg: String);
procedure DoOnRecvMessage(Sender: TObject; AMsg: String; AParams: TStringArray; AConnection: TConnection);
procedure DoOnConnect(Sender: TObject; AConnection: TConnection);
public
procedure execute;
constructor Create(ATCPClient: TTCPClient);
destructor Destroy; override;
procedure WriteHelp; virtual;
procedure connect_tcp; virtual;
procedure sending(ATCPBase: TTCPBase; ATCPBaseType: TBaseType; ASettings: TSettings; AConnection: TConnection);
// public
// procedure RecvMessage(Sender: TObject;AMsg: String; AParams: TStringArray; {%H-}AConnection: TConnection; AddLog: TAddLog);
end;
{ TMyApplication }
type
TAddLog = procedure(ALogMsg: String) of Object;
Tfrclient = class
private
FTCPBase: TTCPBase;
FTCPBaseType: TBaseType;
FSettings: TSettings;
FConnection: TConnection;
public
procedure RecvMessage(Sender: TObject; AMsg: String; AParams: TStringArray; {%H-}AConnection: TConnection; {%H-}AddLog: TAddLog);
end;
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h', 'help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h', 'help') then begin
WriteHelp;
Terminate;
Exit;
end;
{ add your program here }
connect_tcp;
terminate;
end;
constructor TMyApplication.Create(ATCPClient: TTCPClient);
begin
// inherited Create(TheOwner);
FTCPClient := ATCPClient;
// FSettings := ASettings;
FTCPClient := TTCPClient.Create;
FTCPClient.OnRecvMessage := @DoOnRecvMessage;
FTCPClient.OnConnect:=@DoOnConnect;
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure Tfrclient.RecvMessage(Sender: TObject;AMsg: String; AParams: TStringArray; {%H-}AConnection: TConnection;AddLog: TAddLog);
var
rcv_msg : string;
begin
writeln('what');
case AMsg of
'TEXT':
begin
rcv_msg := AParams[0];
writeln('waiting...');
readln(rcv_msg);
end;
end;
end;
procedure Tmyapplication.AddLog(ALogMsg: String);
begin
writeln('log added');
end;
procedure Tmyapplication.DoOnConnect(Sender: TObject; AConnection: TConnection);
begin
writeln('connected');
end;
procedure Tmyapplication.DoOnRecvMessage(Sender: TObject; AMsg: String;
AParams: TStringArray; AConnection: TConnection);
type
TAddLog = procedure(ALogMsg: String) of Object;
var
AddLogCallback: TAddLog;
rcv_msg : string;
FPCClient : Tfrclient;
begin
FPCClient := Tfrclient.Create;
FPCClient.RecvMessage(Sender, AMsg, AParams, AConnection, AddLogCallBack);
end;
procedure Tmyapplication.sending(ATCPBase: TTCPBase; ATCPBaseType: TBaseType; ASettings: TSettings; AConnection: TConnection);
begin
// FTCPBase := TTCPBase.Create;
FTCPBase := ATCPBase;
FTCPBaseType := ATCPBaseType;
FSettings := ASettings;
Connection := AConnection;
try
writeln('sending a msg');
FTCPBase.SendMessage('TEXT', ['8989898'], AConnection.FUniqueID);
readln;
except
writeln('faild');
end;
end;
procedure Tmyapplication.connect_tcp;
var
// Connection: TConnection;
list : Tstringlist;
connection_status : boolean;
MS: TMemoryStream;
bla:string;
chat : Tmyapplication;
begin
FSettings :=Tsettings.Create;
FTCPClient := TTCPClient.Create;
if FTCPClient.Connected = false then
// begin
connection_status := false;
r_host := '127.0.0.1';
FSettings.ActiveConnection.FIP := r_host;
FSettings.ActiveConnection.FPort := IntToStr(4433);
FSettings.ActiveConnection.FUser := 'wtf';
FSettings.ActiveConnection.FPass := '';
Connection := TConnection.Create;
FSettings.CopyConnection(FSettings.activeConnection, Connection);
r_host := connection.fip;
FTCPClient.Connect(FSettings.ActiveConnection);
while FTCPClient.Connected do begin
writeln('ok');
end;
readln;
end;