Çok Yakında Yeni Bir Arayüzle karşınızdayız! http://yeni.delphican.com/

Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Delphi Tethering Client to Client
#1
Delphi Tethering İle bir Chat Projesi Yapıyorum. Server Tarafını Komple Yazdım bir problem yok clientler arası tüm clientlerle birbirleri arası görüşme yaptırabiliyorum. Tek istediğim şey Client to Client Mesaj atabilmesi Bununla Alakalı bir kac bisi yaptım fakat olmadı. bu konuda yardımlarınızı bekliyorum.

Örnek Verecek Olursam

Client 1 
Client 2
Client 3 Bunlar ağda online olan kullanıcılarım 

Client 1 den Client 3 e Mesaj atabileceğim aynı zamanda
Client 3 den client 1 e 




Clientler Üzerinde 3 Farklı Grubum var Bunları ise group, user, alluser şeklinde 3 kısma ayırdım


procedure TClientMain.btnSendClick(Sender: TObject);

var
 I : Integer;
 lvMessage:String;
 lvMessageYou:String;
begin
 lvMessage := Trim(memSendmessage.Text);
 memSendmessage.SetFocus;
 if lvMessage = '' then
   exit;

 case lvMessagetype of

    // Seçilen Kullanıcı Grubuna Mesaj
   eGroup:
   begin
   end;

      // Tek Kullanıcı İle Görüşme
   eUser:
   begin

      Problemli yer

     lvMessageYou := 'Sen:' + Trim(memSendmessage.Text);
     MemMessages.Lines.Add(lvMessageYou);
    for I := 0 to ClientAppProfile.ConnectedProfiles.Count -1 do
     begin
       ClientAppProfile.Resources.FindByName('UserName').Value := 'SomeValue';

      // if ClientAppProfile.Text = lvUserIdSendMessage then
       ClientAppProfile.SendString(ClientAppProfile.ConnectedProfiles[I],SendMessageUserAdd(lvUserName,lvMessage),SendMessageUserAdd(lvUserName,lvMessage));

  
     end;

   end;

      // Sisteme Kayıtlı Tüm Kullanıcılara Mesaj Gönderme.
   eAllUser:
   begin

     lvMessageYou := 'Sen:' +Trim(memSendmessage.Text);
     MemMessages.Lines.Add(lvMessageYou);

     for I := 0 to ClientAppProfile.ConnectedProfiles.Count -1 do
     begin
        ClientAppProfile.SendString(ClientAppProfile.ConnectedProfiles[I],SendMessageUserAdd(lvUserName,lvMessage),SendMessageUserAdd(lvUserName,lvMessage));
     end;
 end;

//  ShowMessage(ClientAppProfile.ConnectedProfiles.Count.ToString);
   memSendmessage.Clear;

end;



Tethering de İse  şunları yapıyprum

 if AResource.ResType = TRemoteResourceType.Data then
 begin
   case lvMessagetype of
      // Seçilen Kullanıcı Grubuna Mesaj
     eGroup:
     begin
     end;

        // Tek Kullanıcı İle Görüşme
     eUser:
     begin
          //if Assigned(AResource.Profile) then  
        //  sIdentifier := AResource.Profile.Identifier;

         MemMessages.Lines.Add(AResource.Value.AsString);
         MemMessages.Lines.Add('');
     end;


        // Sisteme Kayıtlı Tüm Kullanıcılara Mesaj Alma
     eAllUser:
     begin
       lvUseName := lvUserName;
       MemMessages.Lines.Add(AResource.Value.AsString);
       MemMessages.Lines.Add('');
     end;
   end;
 end;
Cevapla
#2
(02-12-2019, Saat: 09:21)yazilimuzmani Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Server Tarafını Komple Yazdım bir problem yok 

Mesaj, istemciden istemciye gidecek de olsa iş yine sunucu tarafında bitiyor bence. İstemcinin mesajı önce sunucuya gelecek, sunucu mesajın kime yada hangi gruba gideceğini tespit edecek ve o kullanıcıya yada gruptaki tüm kullanıcılara mesajı gönderecek. 

Bu tarz işler için hazır protokoller var. Keşke baştan bunlardan birisi ile başlasaydınız. "publish-subscribe messaging" şeklinde aratırsanız çok fazla bilgi bulabilirsiniz. 
AMQP, XMPP, MQTT, RabbitMQ, ZeroMQ vs...
There's no place like 127.0.0.1
WWW
Cevapla
#3
(02-12-2019, Saat: 09:39)SimaWB Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.
(02-12-2019, Saat: 09:21)yazilimuzmani Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Server Tarafını Komple Yazdım bir problem yok 

Mesaj, istemciden istemciye gidecek de olsa iş yine sunucu tarafında bitiyor bence. İstemcinin mesajı önce sunucuya gelecek, sunucu mesajın kime yada hangi gruba gideceğini tespit edecek ve o kullanıcıya yada gruptaki tüm kullanıcılara mesajı gönderecek. 

Bu tarz işler için hazır protokoller var. Keşke baştan bunlardan birisi ile başlasaydınız. "publish-subscribe messaging" şeklinde aratırsanız çok fazla bilgi bulabilirsiniz. 
AMQP, XMPP, MQTT, RabbitMQ, ZeroMQ vs...

Aslında bende bu şekilde yapardım ama problem şu ki şirket bu şekilde istedi Sad
Cevapla
#4
(02-12-2019, Saat: 09:39)SimaWB Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.
(02-12-2019, Saat: 09:21)yazilimuzmani Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Server Tarafını Komple Yazdım bir problem yok 

Mesaj, istemciden istemciye gidecek de olsa iş yine sunucu tarafında bitiyor bence. İstemcinin mesajı önce sunucuya gelecek, sunucu mesajın kime yada hangi gruba gideceğini tespit edecek ve o kullanıcıya yada gruptaki tüm kullanıcılara mesajı gönderecek. 

Bu tarz işler için hazır protokoller var. Keşke baştan bunlardan birisi ile başlasaydınız. "publish-subscribe messaging" şeklinde aratırsanız çok fazla bilgi bulabilirsiniz. 
AMQP, XMPP, MQTT, RabbitMQ, ZeroMQ vs...

Tam ben de hazır bir chat olayı var mı diye sormaya girdim siteye. bu entry yi gördüm.
Firemonkey ile mobil app ve desktop app yapacağım. clientlar arasında mesajlaşma istiyorlar. Ama özellik olarak ta watsapp ı anlatıyorlar bana. Var mı hazır projeye ekleyebileceğim bir şeyler? Idea
...Since Delphi3
Cevapla
#5
Kesinlikle tethering Yapma Onu Söyleyebilirim. 1 Haftadır uğraşıyorum. Malesef 1 kullanıcıya mesaj atabiliyorsun o kullanıcı sana mesaj atamaz hale geliyor Smile Ayriyetten proceni Build edemiyorsun Kesinlikle Uzak durmak gerekir bende başka chat olaylarına bakacağım.
Cevapla
#6
(02-12-2019, Saat: 12:36)yazilimuzmani Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Kesinlikle tethering Yapma Onu Söyleyebilirim. 1 Haftadır uğraşıyorum. Malesef 1 kullanıcıya mesaj atabiliyorsun o kullanıcı sana mesaj atamaz hale geliyor Smile Ayriyetten proceni Build edemiyorsun Kesinlikle Uzak durmak gerekir bende başka chat olaylarına bakacağım.

hazır çözümler varmış bak : Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.

xmpp v.s. gibi protokller var hazır.
...Since Delphi3
Cevapla
#7
Arkadaşlar Problemi Hallettim. Şöyle ki Server Tarafında bir memdatam var gelen mesajları tutuyorum ve bu mesajların kimlere gideceğini cekiyorum buna göre mesajları client tarafına tekrar iletiyorum.Client Tarafında yazanı tekrar servera , server da yazanı tekrar cliente bu şekilde bir döngü kurdum.

Şimdilik Bulabildiğim Çözüm bu.

Yardımlarınızdan dolayı minnetarım @SimaWB ayrıca teşekkürler.
Cevapla
#8
tidudp soket/server ile bir port için ağa broadcast çekebilirsin, diğer tarafdaki o portu dinleyen udp server da gelen komutları işler, oda kendisinden broadcast çeker,
veya datayı broadcast la göndermezsin, client ler broadcastı yeni client ip lerini tespit için kullanır, bir ip list yaparsın, o ip listelere datayı yollarsın tcp den vs..
manuel yapmalısın ozaman istediğine ulaşırsın, yok eğer ben broadcast la ip tespit etmem dersen, ağa arp taraması yapabilirsin bir kaç sn içinde ağda kim var kim yok ip mac list alabilirsin, aşşaya ekliyorum geliştirmesi sana kalmış.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, WinSock, ExThreads, ExtCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   Edit1: TEdit;
   Timer1: TTimer;
   Memo1: TMemo;
   procedure Button1Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   
 end;


var
 Form1: TForm1;

Function SendArp(ipaddr:ulong;
                temp:dword;
                ulmacaddr:pointer;
                ulmacaddrleng:pointer) : DWord; StdCall;

implementation

{$R *.dfm}

Function SendARP; external 'iphlpapi.dll' name 'SendARP';
Function NetApiBufferFree(buffer: Pointer): Cardinal; stdcall; external 'netapi32.dll';
Function NetShareEnum(servername: LPWSTR; level: DWORD; var bufptr: Pointer; prefmaxlen: DWORD; entriesread, totalentries,  resume_handle: LPDWORD): DWORD; stdcall; external 'Netapi32.dll';


function GetMacAddr(const IPAddress: string): string;
var
lDestIP:ulong;
lMacAddr:array[0..5] of byte;
lPhyAddrLen:ulong;

begin
lDestIP:=inet_addr(PChar(IPAddress));
lPhyAddrLen:=length(lMacAddr);
sendarp(lDestIP,0,@lMacAddr,@lPhyAddrLen);
Result:=IntToHex(lMacAddr[0],2)+'-'+
        IntToHex(lMacAddr[1],2)+'-'+
        IntToHex(lMacAddr[2],2)+'-'+
        IntToHex(lMacAddr[3],2)+'-'+
        IntToHex(lMacAddr[4],2)+'-'+
        IntToHex(lMacAddr[5],2);
end;

function GetShares(const CompName: String):TStringList;
Type
 PSHARE_INFO_1 = ^SHARE_INFO_1;
 _SHARE_INFO_1 = record
   shi1_netname: LPWSTR;
   shi1_type: DWORD;
   shi1_remark: LPWSTR;
 end;
 SHARE_INFO_1 = _SHARE_INFO_1;
 TShareInfo1 = SHARE_INFO_1;
 PShareInfo1 = PSHARE_INFO_1;

type TShareInfo1Array = array of TShareInfo1;
var
 entriesread, totalentries: DWORD;
 Info: Pointer;
 I: Integer;
 CN: PWideChar;
 ShareName, ShareInfo:String;

begin
Result:=TStringList.Create;
Result.Sort;
 CN := StringToOleStr(CompName);
 if NetShareEnum(CN, 1, Info, DWORD(-1), @entriesread,
   @totalentries, nil) = 0 then
   try
    if entriesread > 0 then
       for I := 0 to entriesread - 1 do
       Begin
         ShareName:=TShareInfo1Array(@(Info^))[I].shi1_netname;
         ShareInfo:=TShareInfo1Array(@(Info^))[I].shi1_remark;
         If Length(ShareInfo)=0 Then ShareInfo:='(No Info)' Else ShareInfo:='('+ShareInfo+')';
         Result.Add( '\\'+CompName+'\'+ShareName+' '+ShareInfo );
       End;
   finally
     NetApiBufferFree(Info);
   end;
 If Result.count = 0 Then
 Begin
  Result.add('[No Share Found]');
 End;
end;

Function GetHostName(IPAddr: string):String;
var 
 SockAddrIn: TSockAddrIn; 
 HostEnt: PHostEnt;
 WSAData: TWSAData; 
begin 
 WSAStartup($101, WSAData); 
 SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr)); 
 HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); 
 if HostEnt <> nil then 
   Result := StrPas(Hostent^.h_name) 
 else 
   Result := '?';
 WSACleanup; 
end;

Procedure DoScan(TIDTongueointer);
Var
MacID, DIP, HostName, Shares:String;

Begin
Thread_Activate(TID);
{---}
Repeat
 Sleep(1);
Until Prms_Count(TID)>0;
DIP:=Prms_Get(TID, 0);

MacID:=GetMacAddr(DIP);
If MacID<>'00-00-00-00-00-00' Then
Begin
 Shares:=GetShares(DIP).Text;
 HostName:=GetHostName(DIP);

 form1.memo1.Lines.Add( '' );
  form1.memo1.Lines.Add( DIP+' '+HostName+' / '+MacID );
    form1.memo1.Lines.Add( Trim( Shares ) );

End;

{---}
StopThread(TID);
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
I:LongInt;

begin          
memo1.Clear;
For I:=0 To 255 do
Begin
 Prms_Add_Ex( StartThread( Addr(DoScan) ), form1.edit1.text+IntToStr(I) );
 Application.ProcessMessages;
End;

end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Thread_ActiveCount>0 then
button1.Enabled:=False else
button1.Enabled:=true;

form1.Caption:=' Thread: '+IntToStR(Thread_ActiveCount);
end;

end.

exthread
Unit ExThreads;

interface

uses
 Windows, Classes;

Function StartThread(ThreadFunc: TThreadFunc):LongInt;
Procedure StopThread(TIDTongueointer);

Procedure Thread_Activate(TIDTongueointer);
Function Thread_ActiveCount:LongInt;

Procedure Prms_Add(TIDTongueointer; Prm:String);
Procedure Prms_Add_Ex(TID:LongInt; Prm:String);

Procedure Prms_Del(TIDTongueointer; PrmID:LongInt);
Function Prms_Get(TIDTongueointer; PrmID:LongInt):String;

Function Prms_Count(TIDTongueointer):LongInt;

Implementation

Const
MaxThread=65535;

Var
ThreadActive:Boolean=False;
Threads:Array[1..MaxThread] Of LongWord;
Threads_Activate:Array[1..MaxThread] Of Boolean;
   Prms:Array[1..MaxThread] Of TStringList;

Procedure Prms_Add(TIDTongueointer; Prm:String);
Begin
Prms[Integer(TID)].Add(Prm);
End;

Procedure Prms_Add_Ex(TID:LongInt; Prm:String);
Begin
Prms[TID].Add(Prm);
End;

Procedure Prms_Del(TIDTongueointer; PrmID:LongInt);
Begin
Prms[Integer(TID)].Delete(PrmID);
End;

Function Prms_Get(TIDTongueointer; PrmID:LongInt):String;
Begin
Result:=Prms[Integer(TID)].Strings[PrmID];
End;

Function Prms_Count(TIDTongueointer):LongInt;
Begin
Result:=Prms[Integer(TID)].Count;
End;

Function GetEmty_TID:LongInt;
Var
I:LongInt;

Begin
Result:=0;
For I:=1 To MaxThread Do
Begin
 If Threads[I]=0 Then
 Begin
  Result:=I;
  Exit;
 End;
End;
End;

Function Thread_ActiveCount:LongInt;
Var
I:LongInt;

Begin
Result:=0;
For I:=1 To MaxThread Do
Begin
 If Threads[I]>0 Then
 Begin
  Result:=Result+1;
 End;
End;
End;

Procedure Thread_Activate(TIDTongueointer);
Begin
Threads_Activate[Integer(TID)]:=True;
End;

Procedure StopThread(TIDTongueointer);
Begin
Sleep(1000);
CloseHandle(Threads[Integer(TID)]);
Threads[Integer(TID)]:=0;
Prms[Integer(TID)].Clear;
Threads_Activate[Integer(TID)]:=False;
End;

Function StartThread(ThreadFunc: TThreadFunc):LongInt;
Var
TempBig GrinWORD;
 TID:LongInt;
 
Begin
Result:=0;
TID:=GetEmty_TID;
If TID>0 Then
Begin
 Try
  Threads_Activate[TID]:=False;
  Threads[TID]:=BeginThread(nil, 0, Addr(ThreadFunc), Pointer(TID), 0, Temp);
  SetThreadPriority(Threads[TID], THREAD_PRIORITY_NORMAL);
  Prms[TID].Clear;
  Result:=TID;
  Repeat
   Sleep(1);
  Until (Threads_Activate[TID]=True);
 Except
  StopThread(Pointer(TID));
  Result:=0;
 End;
End;
End;

{ *-*--*-*----**-*--*-**-*-*--**--*-*-*-*-*-*-*-* }

Var
I:LongInt;

Begin
For I:=1 To MaxThread Do
Begin
 Threads[I]:=0;
 Prms[I]:=TStringList.Create;
End;
End.


boşuna rep vermeyin kalıcı değlim yakında banlanacağım.
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Delphi Comport kullanımı crypto 4 121 04-12-2019, Saat: 16:17
Son Yorum: QuAdR
  C# kodu Delphi ye çevirme dkadir 2 159 28-11-2019, Saat: 15:11
Son Yorum: dkadir
  Delphi IDE midas.dll Çakışması Hayati 8 387 24-11-2019, Saat: 13:17
Son Yorum: sabanakman
  Rest server client UTF8 Problemi burakb44 10 1.759 01-11-2019, Saat: 15:44
Son Yorum: ikurt07
  Server-client üzerinden Web arayüze erişim SercanTEK 10 615 02-10-2019, Saat: 10:33
Son Yorum: bilsoft8b



Konuyu Okuyanlar: 1 Ziyaretçi