⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 iggstreamfrm.pas

📁 通信控件
💻 PAS
字号:
unit IGgStreamFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdFTP, IGgStreamComp, IdUDPBase, IdUDPClient, ComCtrls,
  ExtCtrls;

type
  TXxFrm = class(TForm)
    ListView1: TListView;
    Label1: TLabel;
    NameEdit: TEdit;
    Label2: TLabel;
    InfoEdit: TEdit;
    SetBtn: TButton;
    GetBtn: TButton;
    Edit3: TEdit;
    SearchBtn: TButton;
    Label3: TLabel;
    StartBtn: TButton;
    DeleteBtn: TButton;
    Panel1: TPanel;
    Name1Edit: TEdit;
    Info1Edit: TEdit;
    Open1Btn: TButton;
    Set1Btn: TButton;
    Get1Btn: TButton;
    Send1Btn: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Edit2: TEdit;
    Name2Edit: TEdit;
    procedure StartBtnClick(Sender: TObject);
    procedure SetBtnClick(Sender: TObject);
    procedure GetBtnClick(Sender: TObject);
    procedure SearchBtnClick(Sender: TObject);
    procedure DeleteBtnClick(Sender: TObject);
    procedure Open1BtnClick(Sender: TObject);
    procedure Open2BtnClick(Sender: TObject);
    procedure Set1BtnClick(Sender: TObject);
    procedure Set2BtnClick(Sender: TObject);
    procedure Get1BtnClick(Sender: TObject);
    procedure Get2BtnClick(Sender: TObject);
    procedure Send1BtnClick(Sender: TObject);
    procedure Send2BtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure FullListView(P: Pointer);
    procedure TOnConnectStatusNotify(NameID: string; Statue: Integer; IP: string; Port: Integer);
    procedure TOnSendBufferNotify(NameID: string; BufferSize: Integer; ErrString: string='');
    procedure TOnReceiveBufferNotify(NameID: string; Buffer: Pointer; BufferSize: Integer; ErrCode: Integer=0);

  end;

var
  XxFrm: TXxFrm;
  Server: TIStreamServer;
  Client1: TIStreamClient;
  Client2: TIStreamClient;

implementation

uses
  IGgNet, IGgStreamServer;

{$R *.dfm}


procedure TXxFrm.StartBtnClick(Sender: TObject);
begin
  if Server = nil then
    Server := TIStreamServer.Create(nil);

  if not Server.Active then
    Server.Active := TRUE
  else
    Server.Active := FALSE;
  if Server.Active then
    StartBtn.Caption := 'Stop'
  else
    StartBtn.Caption := 'Start';
end;

procedure TXxFrm.SetBtnClick(Sender: TObject);
var
  Info: PChar; Len: Integer;
begin
  Len := Length(InfoEdit.Text);
  Info := AllocMem(Len+1);
  StrLCopy(Info, PChar(InfoEdit.Text), Len);
  if Server <> nil then
    Server.SetUserInfo(NameEdit.Text, Info, Len);
  if (Info <> nil) then FreeMem(Info);
end;

procedure TXxFrm.GetBtnClick(Sender: TObject);
var
  Info: PChar; InfoSize: Integer;
begin
  Info := nil; infoSize := 0;
  if Server <> nil then
   InfoSize := Server.GetUserInfo(NameEdit.Text, Pointer(Info));
  if Info <> nil then
    FreeMem(Info);
end;

procedure TXxFrm.SearchBtnClick(Sender: TObject);
var
  Users: PIUsersLink;
  Res: Integer;
begin
  Users := nil;
  if (Server <> nil) then begin
    Res := Server.GetUsersInfo(Pointer(Users), StrToInt(Edit3.Text));
    FullListView(Users);
  end;
  if (Users <> nil) then
    Server.FreeUsersInfo(Users);
end;

procedure TXxFrm.DeleteBtnClick(Sender: TObject);
var
  I: TIStreamClient;
begin
  //I := TIStreamClient.Create(nil);
  if (Server <> nil) then begin
    Server.DeleteUser(0);
    ListView1.Items.Clear;
  end;
end;

procedure TXxFrm.FullListView(P: Pointer);
var
  Users: PIUsersLink;
  Item: TListItem;
begin
  ListView1.Items.Clear;
  Users := PIUsersLink(P);
  if Users = nil then Exit;
  while(Users <> nil) do
  begin
    Item := ListView1.Items.Add;
    Item.Caption := Users.NameID;
    Item.SubItems.Add(PChar(Users.Info));
    Item.SubItems.Add(Users.IPStr);
    Item.SubItems.Add(IntToStr(Users.Status));
    Users := Users.Link;
  end;
end;

procedure TXxFrm.Open1BtnClick(Sender: TObject);
begin
  //
  if Client1 = nil then
  begin
    Client1 := TIStreamClient.Create(nil);
    Client1.OnConnectStatusNotify := TOnConnectStatusNotify;
    Client1.OnSendBufferNotify    := TOnSendBufferNotify;
    Client1.OnReceiveBufferNotify := TOnReceiveBufferNotify;
  end;
  if not Client1.Active then
    Client1.Open(Name1Edit.Text)
  else
    Client1.Close;
  if Client1.Active then  Open1Btn.Caption := 'Close' else Open1Btn.Caption := 'Open';
end;

procedure TXxFrm.Open2BtnClick(Sender: TObject);
begin
  //
  if Client2 = nil then
  begin
    Client2 := TIStreamClient.Create(nil);
    Client2.OnConnectStatusNotify := TOnConnectStatusNotify;
    Client2.OnSendBufferNotify    := TOnSendBufferNotify;
    Client2.OnReceiveBufferNotify := TOnReceiveBufferNotify;
  end;
  if not Client2.Active then
    Client2.Open(Name1Edit.Text)
  else
    Client2.Close;
  if Client2.Active then  Open1Btn.Caption := 'Close' else Open1Btn.Caption := 'Open';
end;

procedure TXxFrm.Set1BtnClick(Sender: TObject);
var
  P: PChar; L: Integer;
begin
  //
  L := Length(Info1Edit.Text);
  P := AllocMem(L+1);
  StrLCopy(P, pchar(INFO1EDIT.Text), L);
  if Client1 = nil then Exit;
  Client1.SetInfo(P, L);
  FreeMem(P);
end;

procedure TXxFrm.Set2BtnClick(Sender: TObject);
var
  P: PChar; L: Integer;
begin
  //
  L := Length(Info1Edit.Text);
  P := AllocMem(L+1);
  StrLCopy(P, pchar(INFO1EDIT.Text), L);
  if Client2 = nil then exit;
  Client2.SetInfo(P, L);
  FreeMem(P);
end;

procedure TXxFrm.Get1BtnClick(Sender: TObject);
var
 P: PChar;
begin
  //
  if Client1 = nil then Exit;
  P := Client1.GetInfo(Name1Edit.Text);
  if (P <> nil) then
    Info1Edit.Text := p;
end;

procedure TXxFrm.Get2BtnClick(Sender: TObject);
var
 P: PChar;
begin
  //
  if Client2 = nil then Exit;
  P := Client2.GetInfo(NameEdit.Text);
  if (p <> nil) then
  Info1Edit.Text := p;
end;

procedure TXxFrm.Send1BtnClick(Sender: TObject);
var
  P: PChar; L: Integer;
begin
  //
  L := Memo1.GetTextLen;
  P := AllocMem(L+1);
  L := Memo1.GetTextBuf(P, L+1);
  if Client1 = nil then Exit;
  Client1.SendBuffer(Name2Edit.Text, p, l);
  FreeMem(p);
end;

procedure TXxFrm.Send2BtnClick(Sender: TObject);
var
  P: PChar; L: Integer;
begin
  //
  L := Memo1.GetTextLen;
  P := AllocMem(L+1);
  L := Memo1.GetTextBuf(P, L);
  if Client2 = nil then
  Client2.SendBuffer(Name1Edit.Text, p, l);
  FreeMem(p);
end;

procedure TXxFrm.TOnConnectStatusNotify(NameID: string; Statue: Integer; IP: string; Port: Integer);
begin
end;

procedure TXxFrm.TOnSendBufferNotify(NameID: string; BufferSize: Integer; ErrString: string);
begin
end;

procedure TXxFrm.TOnReceiveBufferNotify(NameID: string; Buffer: Pointer; BufferSize: Integer; ErrCode: Integer);
begin
  //if NameID = Name2Edit.Text then
  if (Buffer <> nil) then
    Memo1.SetTextBuf(Buffer)
end;

initialization;

finalization;
  if Server <> nil then
  begin
    Server.Active := FALSE;
    Server.Free;
  end;
  if Client1 <> nil then
  begin
    Client1.Active := FALSE;
    Client1.Free;
  end;
  if Client2 <> nil then
  begin
    Client2.Active := FALSE;
    Client2.Free;
  end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -