📄 iggstreamfrm.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 + -