使用indy製作聊天功能遇到的問題 |
答題得分者是:pcplayer99
|
liangyenchen
一般會員 發表:6 回覆:5 積分:2 註冊:2007-01-20 發送簡訊給我 |
indy的使用,client傳資訊給server,只要sever馬上處裡可以利用當時的acontext馬上回傳給該client
該執行緒只要完畢該acontext就會被刪除 所以如果我要做到,讓server可以傳訊息給所有連線到這server的client的話,我必須將client的acontext記錄下來,以便使用 以上是我的理解,不過不確定是不是真的是這樣,就我看範例的理解是這樣 因此我在server端利用動態陣列記錄client的acontext 實做後也可以將資訊 正確的利用陣列裡的acontext傳輸 但是,只要有client斷線,server端就會出錯,而且無法在有新的client繼續登入 很明顯的是在 disconnect時的處理發生錯誤,但是我利用debug去看,程式很正常的走過去了 並沒有錯誤,可以請大家幫我看哪裡有問題嗎?謝謝 <textarea class="delphi" rows="10" cols="80" name="code">//client unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, StdCtrls, ExtCtrls; type TCLTOnExecute = class(TThread) private { Private declarations } FReadStr: String; protected procedure Execute; override; procedure ShowOnForm; end; TForm1 = class(TForm) IdTCPClient1: TIdTCPClient; Button1: TButton; Button2: TButton; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; CLTOnExecute: TCLTOnExecute; implementation {$R *.dfm} { TCLTOnExecute } procedure TCLTOnExecute.Execute; begin { Place thread code here } while (Form1.IdTCPClient1.Connected) do begin FReadStr := Form1.IdTCPClient1.IOHandler.ReadLn; if FReadStr<>'' then Synchronize(ShowOnForm); end; end; procedure TCLTOnExecute.ShowOnForm; begin { Place thread code here } Form1.Caption := FReadStr; end; { Form1 } procedure TForm1.FormCreate(Sender: TObject); begin //CLT Connect IdTCPClient1.Host := '127.0.0.1'; IdTCPClient1.Port := 12345; IdTCPClient1.Connect; //初始執行緒 CLTOnExecute:=TCLTOnExecute.Create(true); CLTOnExecute.FreeOnTerminate:=True; CLTOnExecute.Resume; end; procedure TForm1.Button1Click(Sender: TObject); begin IdTCPClient1.Disconnect; end; procedure TForm1.Button2Click(Sender: TObject); begin IdTCPClient1.Connect; end; procedure TForm1.Timer1Timer(Sender: TObject); begin if IdTCPClient1.Connected then IdTCPClient1.IOHandler.WriteLn('a'); end; end. </textarea> <textarea class="delphi" rows="10" cols="80" name="code">//server unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, StdCtrls, IdContext, ExtCtrls, SyncObjs; type TForm1 = class(TForm) IdTCPServer1: TIdTCPServer; procedure FormCreate(Sender: TObject); procedure IdTCPServer1Connect(AContext: TIdContext); procedure IdTCPServer1Execute(AContext: TIdContext); procedure IdTCPServer1Disconnect(AContext: TIdContext); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; CLTContextList : array of TIdContext; CLTContextCount : integer; Critical: TCriticalSection; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin IdTCPServer1.DefaultPort := 12345; IdTCPServer1.Active := true; CLTContextCount := 0; Critical := TCriticalSection.Create; end; procedure TForm1.IdTCPServer1Connect(AContext: TIdContext); begin Critical.Acquire; Inc(CLTContextCount); SetLength(CLTContextList,CLTContextCount); CLTContextList[CLTContextCount-1] := AContext; Critical.Release; end; procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); var i : integer; begin Critical.Acquire; if AContext.Connection.IOHandler.ReadLn <> '' then for i:=0 to CLTContextCount-1 do CLTContextList[i].Connection.IOHandler.WriteLn(inttostr(random(1000))); Critical.Release; end; procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext); var i : integer; begin Critical.Acquire; for i:=0 to CLTContextCount-1 do if CLTContextList[i] = AContext then begin if i 1< CLTContextCount then begin CLTContextList[i] := CLTContextList[CLTContextCount-1]; CLTContextList[CLTContextCount-1] := nil; break; end else begin CLTContextList[i] := nil; break; end; end; Dec(CLTContextCount); if CLTContextCount>0 then SetLength(CLTContextList,CLTContextCount); Critical.Release; end; procedure TForm1.FormDestroy(Sender: TObject); begin Critical.Free; end; end. </textarea><br /> 編輯記錄
|
pcplayer99
尊榮會員 發表:146 回覆:790 積分:632 註冊:2003-01-21 發送簡訊給我 |
|
liangyenchen
一般會員 發表:6 回覆:5 積分:2 註冊:2007-01-20 發送簡訊給我 |
謝謝回應
我用的是indy10,我記得我有把所有的demo都下載來看,所以看到您這樣回應,感覺上好像我沒看過demo一樣,不是很舒服 但是還是您說個抱歉,我突然想到,該不會indy9有吧?還真的有!!!! 因此我先將版本改為9在去看程式碼,不過還是遇到幾個問題 他的範例我看到兩個,一個是chat,一個是IdTCPDemo 兩個都有,我想要的東西,不過方法不同 chat: 他使用class存玩家資訊,當玩家連線,創object,加入到TLIST 重點是TLIST地不同 IdTCPDemo: 他使用record的指標來存,當玩家連線create,加入到TTHREADLIST 他使用的是TTHREADLIST 我大致上了解同步的用途 所以我想把Chat的範例改用TTHREADLIST來存 問題就這樣產生,好像LOCK住,就無法UNLOCK 所以導致止能一個人登入,而且會掛掉 請問會是怎樣的原因造成呢? 還是有他的用處? 謝謝 ===================引 用 pcplayer99 文 章=================== 你可以去看 Indy? 提供的 TCP 的 demo,它的做法已经包括了你的问题涉及到的部分。 |
pcplayer99
尊榮會員 發表:146 回覆:790 積分:632 註冊:2003-01-21 發送簡訊給我 |
indy 10 我没用过,也没看过,不知道它内部如何处理的。
indy 9 的 demo 我看过,也照 demo 自己写过一段测试 code,可以工作。 根据 indy 9 的 demo,其原理是:每个 Client 连上 Server,在 Server 的 OnConnect,注意: procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread); 这个 AThread 就是在 Server 端对应的一个 Client 端的 Thread。你在 Server 端要想自己向某个 Client 发消息,就必须拿到这个 AThread. 这就是 Indy TCP Server 的工作原理。 知道了这个原理,我们就可以在 OnConnect 这个 event 里写代码,把这个 AThread 保存到一个我们自己可以找到的地方。比如,用一个 List 来保存它。 当然,我们不能单单保存一个 AThread 。要依据你用什么方式来搜索特定的 Client。所以,可能需要和 AThread 一起保存的是关于这个 Client 的信息,比如 name 或者编号。 因此,就有了: TMyClient = record MyID: Integer; MyName: string; MyThread: TIdPeerThread; end; 每个Client 连接上来的时候,你都可以在 Server 的 OnConnect 里面为什么 Server 动态生成一个 TMyClient 类别的 Record 然后把它的 pointer 放到一个 List 里去。 当然,你可以不用 Record ,用 Class,道理相同。 当你要向一个编号 120 的 Client 发消息,你就可以在 List 里逐个把 TMyClient 类别的东东(可能是Record,也可能是 Class 看你用哪个了)逐个抓出来,比对 MyID,找到 MyID = 120 的,把它的MyThread 拿到,就可以通过 MyThread 发消息给那个 Client 了。 大概原理就是这样的。 至于在 indy 提供的 chat 那个 demo 里,它的 TTHREADLIST 是: List := tcpServer.Threads.LockList; 注意,IdTcpServer.Threads 是一个 TThreadList。因为对应所有的 Client 的 AThread 都保存在 IdTCPServer.Threads 这个 TThreadList 里的。如果不是要根据上面我说的例子的某个 Client 的编号去找到特定的 Client 而是向所有连接到 Server 的 Client 广播消息,就从这个 ThreadList 里把所有的 AThread 取出来逐个发消息就可以了。 另外,如果你自己的 List 要用 ThreadList 也不是问题啊。最好这样用: List := ThreadList.Lock; try Do.... finally ThreadList.Unlock; end; 这样就能保证即时 Do... 出了错,也能 Unlock 了。 你是怎么写的,贴出代码来。 ===================引 用 liangyenchen 文 章=================== 謝謝回應 我用的是indy10,我記得我有把所有的demo都下載來看,所以看到您這樣回應,感覺上好像我沒看過demo一樣,不是很舒服 但是還是您說個抱歉,我突然想到,該不會indy9有吧?還真的有!!!! 因此我先將版本改為9在去看程式碼,不過還是遇到幾個問題 他的範例我看到兩個,一個是chat,一個是IdTCPDemo 兩個都有,我想要的東西,不過方法不同 chat: 他使用class存玩家資訊,當玩家連線,創object,加入到TLIST 重點是TLIST地不同 IdTCPDemo: 他使用record的指標來存,當玩家連線create,加入到TTHREADLIST 他使用的是TTHREADLIST 我大致上了解同步的用途 所以我想把Chat的範例改用TTHREADLIST來存 問題就這樣產生,好像LOCK住,就無法UNLOCK 所以導致止能一個人登入,而且會掛掉 請問會是怎樣的原因造成呢? 還是有他的用處? 謝謝 ===================引 用 pcplayer99 文 章=================== 你可以去看 Indy? 提供的 TCP 的 demo,它的做法已经包括了你的问题涉及到的部分。 |
pcplayer99
尊榮會員 發表:146 回覆:790 積分:632 註冊:2003-01-21 發送簡訊給我 |
上面我把原理讲完了。现在看 DEMO 里的 CODE:
首先: procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread); var Client : TSimpleClient; begin Client := TSimpleClient.Create; //---保存关于这个 Client 的一些其它 data Client.DNS := AThread.Connection.LocalName; Client.Name := 'Logging In'; Client.ListLink := lbClients.Items.Count; //最重要的,把这个Client的连接对象也保存起来: Client.Thread := AThread; //一个技巧,把这个 Client 同时也保存到连接对象里,连接对象提供了一个 Pointer 属性来保存一些外部的东西,刚好利用: AThread.Data := Client; //把这个 Client 放到一个 ListBox 里: lbClients.Items.Add(Client.Name); //把它放到一个 List 里去。Clients : TList; Clients.Add(Client); end; //这样保存的一个 Client 在下面就能用到: //当服务器端要向某个特定的 Client 发消息,在这个 demo 里,是使用者从 ListBox 里选取了一个 Client procedure TfrmMain.btnPMClick(Sender: TObject); var Msg : String; Client : TSimpleClient; begin Msg := InputBox('Private Message', 'What is the message', ''); Msg := Trim(Msg); Msg := edSyopName.Text '> ' Msg; if (Msg <> '') and (lbClients.ItemIndex <> -1) then begin //从 ListBox 里取到这个 Client Client := Clients.Items[lbClients.ItemIndex]; //从取到的 Client 拿到这个 Client 对应的 Thread,通过这个 Thread 来发送消息给这个 Client TIdPeerThread(Client.Thread).Connection.WriteLn(Msg); end; end; 清楚了吧? |
liangyenchen
一般會員 發表:6 回覆:5 積分:2 註冊:2007-01-20 發送簡訊給我 |
謝謝詳細的解說
unit MainForm; interface uses Windows, Messages, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls, ToolWin, ImgList, Spin, Menus, SysUtils, Classes, IdBaseComponent, IdComponent, IdTCPServer, IdThreadMgr, IdThreadMgrDefault; type TSimpleClient = class(TObject) DNS, Name: String; ListLink: Integer; Thread: Pointer; end; TfrmMain = class(TForm) StatusBar1: TStatusBar; Panel1: TPanel; Panel2: TPanel; lbClients: TListBox; PageControl1: TPageControl; TabSheet2: TTabSheet; TabSheet3: TTabSheet; ImageList1: TImageList; Label3: TLabel; lblDNS: TLabel; tcpServer: TIdTCPServer; lblSocketVer: TLabel; Label5: TLabel; Label4: TLabel; seBinding: TSpinEdit; IdThreadMgrDefault1: TIdThreadMgrDefault; Label6: TLabel; memEntry: TMemo; Label7: TLabel; memEMotes: TMemo; Label8: TLabel; Label9: TLabel; lblClientName: TLabel; lblClientDNS: TLabel; puMemoMenu: TPopupMenu; Savetofile1: TMenuItem; Loadfromfile1: TMenuItem; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; ToolBar1: TToolBar; btnServerUp: TToolButton; ToolButton1: TToolButton; btnKillClient: TToolButton; btnClients: TToolButton; btnPM: TToolButton; Label12: TLabel; edSyopName: TEdit; procedure btnServerUpClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure seBindingChange(Sender: TObject); procedure tcpServerConnect(AThread: TIdPeerThread); procedure tcpServerDisconnect(AThread: TIdPeerThread); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Savetofile1Click(Sender: TObject); procedure Loadfromfile1Click(Sender: TObject); procedure tcpServerExecute(AThread: TIdPeerThread); procedure btnClientsClick(Sender: TObject); procedure btnPMClick(Sender: TObject); procedure btnKillClientClick(Sender: TObject); procedure lbClientsClick(Sender: TObject); private { Private declarations } public { Public declarations } Clients : TThreadList; procedure UpdateBindings; procedure UpdateClientList; procedure BroadcastMessage( WhoFrom, TheMessage : String ); end; var frmMain: TfrmMain; implementation {$R *.DFM} uses IdSocketHandle; // This is where the IdSocketHandle class is defined. procedure TfrmMain.UpdateBindings; var Binding : TIdSocketHandle; begin { Set the TIdTCPServer's port to the chosen value } tcpServer.DefaultPort := seBinding.Value; { Remove all bindings that currently exist } tcpServer.Bindings.Clear; { Create a new binding } Binding := tcpServer.Bindings.Add; { Assign that bindings port to our new port } Binding.Port := seBinding.Value; end; procedure TfrmMain.btnServerUpClick(Sender: TObject); begin try { Check to see if the server is online or offline } tcpServer.Active := not tcpServer.Active; btnServerUp.Down := tcpServer.Active; if btnServerUp.Down then begin { Server is online } btnServerUp.ImageIndex := 1; btnServerUp.Hint := 'Shut down server'; end else begin { Server is offline } btnServerUp.ImageIndex := 0; btnServerUp.Hint := 'Start up server'; end; { Setup GUI buttons } btnClients.Enabled:= btnServerUp.Down; seBinding.Enabled := not btnServerUp.Down; edSyopName.Enabled:= not btnServerUp.Down; except { If we have a problem then rest things } btnServerUp.Down := false; seBinding.Enabled := not btnServerUp.Down; btnClients.Enabled:= btnServerUp.Down; edSyopName.Enabled:= not btnServerUp.Down; end; end; procedure TfrmMain.FormCreate(Sender: TObject); begin { Initalize our clients list } Clients := TThreadList.Create; { Call updatebindings so that the servers bindings are correct } UpdateBindings; { Get the local DNS entry for this computer } lblDNS.Caption := tcpServer.LocalName; { Display the current version of indy running on the system } lblSocketVer.Caption := tcpServer.Version; end; procedure TfrmMain.seBindingChange(Sender: TObject); begin UpdateBindings; end; procedure TfrmMain.tcpServerConnect(AThread: TIdPeerThread); var Client : TSimpleClient; begin { Send a welcome message, and prompt for the users name } AThread.Connection.WriteLn('ISD Connection Established...'); AThread.Connection.WriteLn('Please send valid login sequence...'); AThread.Connection.WriteLn('Your Name:'); { Create a client object } Client := TSimpleClient.Create; { Assign its default values } Client.DNS := AThread.Connection.LocalName; Client.Name := 'Logging In'; Client.ListLink := lbClients.Items.Count; { Assign the thread to it for ease in finding } Client.Thread := AThread; { Add to our clients list box } lbClients.Items.Add(Client.Name); { Assign it to the thread so we can identify it later } AThread.Data := Client; { Add it to the clients list } Clients.Add(Client); end; procedure TfrmMain.tcpServerDisconnect(AThread: TIdPeerThread); var Client : TSimpleClient; begin { Retrieve Client Record from Data pointer } Client := Pointer(AThread.Data); { Remove Client from the Clients TList } try Clients.LockList.Delete(Client.ListLink); finally Clients.UnlockList; end; { Remove Client from the Clients List Box } lbClients.Items.Delete(lbClients.Items.IndexOf(Client.Name)); BroadcastMessage('System', Client.Name ' has left the chat.'); { Free the Client object } Client.Free; AThread.Data := nil; end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); begin try if (Clients.LockList.Count > 0) and (tcpServer.Active) then begin Action := caNone; ShowMessage('Can''t close CBServ while server is online.'); end else Clients.Free; finally Clients.UnlockList; end; end; procedure TfrmMain.Savetofile1Click(Sender: TObject); begin if not (puMemoMenu.PopupComponent is TMemo) then exit; if SaveDialog1.Execute then begin TMemo(puMemoMenu.PopupComponent).Lines.SaveToFile(SaveDialog1.FileName); end; end; procedure TfrmMain.Loadfromfile1Click(Sender: TObject); begin if not (puMemoMenu.PopupComponent is TMemo) then exit; if OpenDialog1.Execute then begin TMemo(puMemoMenu.PopupComponent).Lines.LoadFromFile(OpenDialog1.FileName); end; end; procedure TfrmMain.UpdateClientList; var Count : Integer; begin { Loop through all the clients connected to the system and set their names } try for Count := 0 to lbClients.Items.Count -1 do if Count < Clients.LockList.Count then lbClients.Items.Strings[Count] := TSimpleClient(Clients.LockList.Items[Count]).Name; finally Clients.UnlockList; end; end; procedure TfrmMain.tcpServerExecute(AThread: TIdPeerThread); var Client : TSimpleClient; Com, // System command Msg : String; begin { Get the text sent from the client } Msg := AThread.Connection.ReadLn; { Get the clients package info } Client := Pointer(AThread.Data); { Check to see if the clients name has been assigned yet } if Client.Name = 'Logging In' then begin { if not, assign the name and announce the client } Client.Name := Msg; UpdateClientList; BroadcastMessage('System', Msg ' has just logged in.'); AThread.Connection.WriteLn(memEntry.Lines.Text); end else { If name is set, then send the message } if Msg[1] <> '@' then begin { Not a system command } BroadcastMessage(Client.Name, Msg); end else begin { System command } Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2))); Msg := UpperCase(Trim(Copy(Msg, Pos(':', Msg) 1, Length(Msg)))); if Com = 'CLIENTS' then AThread.Connection.WriteLn( '@' 'clients:' lbClients.Items.CommaText); end; end; procedure TfrmMain.BroadcastMessage( WhoFrom, TheMessage : String ); var Count: Integer; List : TList; EMote, Msg : String; begin Msg := Trim(TheMessage); EMote := Trim(memEMotes.Lines.Values[Msg]); if WhoFrom <> 'System' then Msg := WhoFrom ': ' Msg; if EMote <> '' then Msg := Format(Trim(EMote), [WhoFrom]); List := tcpServer.Threads.LockList; try for Count := 0 to List.Count -1 do try TIdPeerThread(List.Items[Count]).Connection.WriteLn(Msg); except TIdPeerThread(List.Items[Count]).Stop; end; finally tcpServer.Threads.UnlockList; end; end; procedure TfrmMain.btnClientsClick(Sender: TObject); begin UpdateClientList; end; procedure TfrmMain.btnPMClick(Sender: TObject); var Msg : String; Client : TSimpleClient; begin Msg := InputBox('Private Message', 'What is the message', ''); Msg := Trim(Msg); Msg := edSyopName.Text '> ' Msg; if (Msg <> '') and (lbClients.ItemIndex <> -1) then begin try Client := Clients.LockList.Items[lbClients.ItemIndex]; finally Clients.UnlockList; end; TIdPeerThread(Client.Thread).Connection.WriteLn(Msg); end; end; procedure TfrmMain.btnKillClientClick(Sender: TObject); var Msg : String; Client : TSimpleClient; begin Msg := InputBox('Disconnect message', 'Enter a reason for the disconnect', ''); Msg := Trim(Msg); Msg := edSyopName.Text '> ' Msg; if (Msg <> '') and (lbClients.ItemIndex <> -1) then begin try Client := Clients.LockList.Items[lbClients.ItemIndex]; finally Clients.UnlockList; end; TIdPeerThread(Client.Thread).Connection.WriteLn(Msg); TIdPeerThread(Client.Thread).Connection.Disconnect; try Clients.LockList.Delete(lbClients.ItemIndex); finally Clients.UnlockList; end; lbClients.Items.Delete(lbClients.ItemIndex); end; end; procedure TfrmMain.lbClientsClick(Sender: TObject); var Client : TSimpleClient; begin btnPM.Enabled := lbClients.ItemIndex <> -1; btnKillClient.Enabled := btnPM.Enabled; if lbClients.ItemIndex = -1 then exit; try Client := Clients.LockList.Items[lbClients.ItemIndex]; finally Clients.UnlockList; end; lblClientName.Caption := Client.Name; lblClientDNS.Caption := Client.DNS; end; end. 這是我將chat的範例 改用 TThreadList存class得程式碼 目前會發生 第二個玩家就無法login
編輯記錄
yckuo 重新編輯於 2007-07-27 14:36:12, 註解 解除程式區塊編輯,避免當住瀏覽器的問題‧
|
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |