Разработка аналога системы p2p

  if not SelectPeer(aHandle) then Exit;

  aOkay := fRights.HasRight(SelPeer.Username, arUnzip);

  if not aOkay then Exit;

  aRoot := fRights.GetRoot(SelPeer.Username);

  LogMsg(CheckName(SelPeer.Username) + ': начало распаковки ' + PreSlash(aPath));

end;

procedure TfMain.GoServerUnzipDone(Sender: TObject; aHandle, aCode: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  LogMsg(CheckName(SelPeer.Username) + ': окончание распаковки - ' + bsErrorDescription(aCode));

end;

procedure TfMain.GoUnzipProgress(Sender: TObject; aHandle, aFileCount, aFileTotal, aByteCountLo, aByteCountHi, aByteTotalLo, aByteTotalHi: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  TfFiles(SelPeer.fFiles).UnzipProgress(aFileCount, aFileTotal, aByteCountLo, aByteCountHi, aByteTotalLo, aByteTotalHi);

end;

procedure TfMain.GoClientUnzipDone(Sender: TObject; aHandle, aCode: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  TfFiles(SelPeer.fFiles).UnzipDone(aCode);

end;

procedure TfMain.btnSearchClick(Sender: TObject);

begin

  ShowForm(TPeer(lvPeers.Selected.Data).fSearch);

end;

procedure TfMain.GoClientSearchDone(Sender: TObject; aHandle, aCode: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  TfSearch(SelPeer.fSearch).SearchDone(aCode);

end;

procedure TfMain.GoHaveFindFile(Sender: TObject; aHandle: Integer; const aName: WideString; aSizeLo, aSizeHi, aTimeLo, aTimeHi: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  TfSearch(SelPeer.fSearch).HaveFindFile(aName, aSizeLo, aSizeHi, aTimeLo, aTimeHi);

end;

procedure TfMain.GoSearchProgress(Sender: TObject; aHandle, aCount: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  TfSearch(SelPeer.fSearch).SearchProgress(aCount);

end;

procedure TfMain.GoNeedSearch(Sender: TObject; aHandle: Integer; const aPath: WideString; var aOkay: WordBool; var aRoot: WideString);

begin

  if not SelectPeer(aHandle) then Exit;

  aOkay := fRights.HasRight(SelPeer.Username, arSearch);

  if not aOkay then Exit;

  aRoot := fRights.GetRoot(SelPeer.Username);

  LogMsg(CheckName(SelPeer.Username) + ': начать поиск в ' + PreSlash(aPath));

end;

procedure TfMain.GoServerSearchDone(Sender: TObject; aHandle, aCode: Integer);

begin

  if not SelectPeer(aHandle) then Exit;

  LogMsg(CheckName(SelPeer.Username) + ': окончание поиска - ' + bsErrorDescription(aCode));

end;

procedure TfMain.btnAlertClick(Sender: TObject);

var

  i: Integer;

begin

  fAlert.mmText.Text := '';

  if lvPeers.SelCount > 0 then

  begin

    fAlert.raSingle.Caption := 'Пользователь ' + lvPeers.Selected.Caption;

    fAlert.raSingle.Enabled := True;

    fAlert.raSingle.Checked := True;

  end

  else

  begin

    fAlert.raAll.Checked := True;

    fAlert.raSingle.Caption := 'Пользователь';

    fAlert.raSingle.Enabled := False;

  end;

  if fAlert.ShowModal <> mrOk then Exit;

  if fAlert.raSingle.Checked then

    P2pAgent.SendAlertMessage(TPeer(lvPeers.Selected.Data).Handle, fAlert.mmText.Text)

  else

  begin

    for i := lvPeers.Items.Count-1 downto 0 do

      P2pAgent.SendAlertMessage(TPeer(lvPeers.Items[i].Data).Handle, fAlert.mmText.Text);

  end;

end;

procedure TfMain.GoAlertMessage(Sender: TObject; aHandle: Integer; const aMessage: WideString);

begin

  MessageBox(0, PChar(String(aMessage)), PChar('Сообщение от ' + CheckName(P2pAgent.GetPeerName(aHandle))), MB_OK or MB_ICONWARNING or MB_SYSTEMMODAL);

end;

procedure TfMain.btnChatClick(Sender: TObject);

begin

  ShowForm(TPeer(lvPeers.Selected.Data).fChat);

end;

procedure TfMain.GoChatMessage(Sender: TObject; aHandle: Integer; const aMessage: WideString);

begin

  if not SelectPeer(aHandle) then Exit;

  if Pos('test ', aMessage) = 1 then

    LogMsg('Тестовое сообщение от ' + SelPeer.Username)

  else

    TfChat(SelPeer.fChat).HaveChatMessage(aMessage);

end;

procedure TfMain.btnConnectClick(Sender: TObject);

begin

  if fConnect.ShowModal <> mrOk then Exit;

  if not P2pAgent.OpenSession(

    fConnect.edHost.Text,

    StrToIntDef(fConnect.edPort.Text, 0),

    fConnect.edUsername.Text,

   fConnect.edPassword.Text) then

      ShowMessage('не могу создать новую сессию: ' + IntToStr(P2pAgent.LastError));

  UpdateStatus;

end;

procedure TfMain.btnCancelClick(Sender: TObject);

begin

  if P2pAgent.GetSessionStatus <> SESSION_STATUS_CONNECTING then Exit;

  P2pAgent.CloseSession;

end;

procedure TfMain.btnDisconnectClick(Sender: TObject);

begin

  P2pAgent.CloseSession;

  UpdateStatus;

end;

procedure TfMain.btnClearLogClick(Sender: TObject);

begin

  mmLog.Clear;

end;

procedure TfMain.btnSettingsClick(Sender: TObject);

begin

  if fSettings.ShowModal <> mrOk then Exit;

  SetSettings;

end;

procedure TfMain.btnUsersClick(Sender: TObject);

begin

  fRights.Ask;

end;

procedure TfMain.btnExitClick(Sender: TObject);

begin

  Application.Terminate;

end;

procedure TfMain.btnBytesClick(Sender: TObject);

var

  Pt: OleVariant;

  P: PByte;

  S: String;

begin

  S := DateTimeToStr(Now);

  Pt := VarArrayCreate([0, Length(S)-1], varByte);

  P := VarArrayLock(Pt);

  if P = nil then Exit;

  Move(S[1], P^, Length(S));

  VarArrayUnlock(Pt);

  if lvPeers.Selected = nil then

    P2pAgent.SendBinaryMessage(0, Pt)

  else

    P2pAgent.SendBinaryMessage(TPeer(lvPeers.Selected.Data).Handle, Pt)

end;

procedure TfMain.GoBinaryMessage(Sender: TObject; aHandle: Integer; var aValue: OleVariant);

var

  Len: Integer;

  P: PByte;

  S: String;

begin

  if not VarIsArray(aValue) then Exit;

  Len := VarArrayHighBound(aValue, 1) - VarArrayLowBound(aValue, 1) + 1;

  P := VarArrayLock(aValue);

  if P = nil then Exit;

  SetLength(S, Len);

  Move(P^, S[1], Len);

  VarArrayUnlock(aValue);

  if not btnAutoTest.Down then

    ShowMessage('поступило сообщение: ' + S);

end;

procedure TfMain.btnRemoveClick(Sender: TObject);

var

  Pr: TPeer;

begin

  if lvPeers.SelCount = 0 then Exit;

  Pr := TPeer(lvPeers.Selected.Data);

  P2pAgent.DisconnectPeer(Pr.Handle);

end;

procedure TfMain.TimerTimer(Sender: TObject);

begin

  AutoTest;

end;

procedure TfMain.AutoTest;

begin

  if not btnAutoTest.Down then Exit;

  case P2pAgent.GetSessionStatus of

    SESSION_STATUS_CONNECTED:

      begin

        if GetTickCount - StateTick > AUTO_OPEN_TIME then

        begin

          StateTick := GetTickCount;

          P2pAgent.CloseSession;

        end;

      end;

    SESSION_STATUS_CONNECTING:  ;

  else

    begin

      if GetTickCount - StateTick > AUTO_CLOSE_TIME then

      begin

        StateTick := GetTickCount;

        if not P2pAgent.OpenSession(

          fConnect.edHost.Text,

          StrToIntDef(fConnect.edPort.Text, 0),

          fConnect.edUsername.Text,

          fConnect.edPassword.Text) then

            LogMsg('Не могу создать новую сессию: ' + IntToStr(P2pAgent.LastError));

      end;

    end;

  end;

  UpdateStatus;

end;

end. 

Хаб приложение:

unit uMain;

interface

uses

  ActiveX, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls, ComCtrls, ToolWin, Menus, ActnList, ImgList, StrUtils, Contnrs,

  ExtCtrls, Registry, Variants, ShellAPI, Buttons, IniFiles,

  Tools, ErrMsg, bsP2PHubSDK_TLB;

type

  TPeer = class

    Handle: Integer;

    Username: WideString;

    ListItem: TListItem;

    UpFileName, DnFileName: String;

    UpFileHandle, UpFileSize, UpFileCount: Integer;

    DnFileHandle, DnFileSize, DnFileCount: Integer;

    UpFileItem, DnFileItem: TListItem;

  end;

  TfMain = class(TForm)

    StatusBar: TStatusBar;

    GroupBox2: TGroupBox;

    btnRemove: TButton;

    lvPeers: TListView;

    GroupBox3: TGroupBox;

    mmLog: TMemo;

    btnClearLog: TButton;

    GroupBox1: TGroupBox;

    btnStart: TButton;