unit uMain;


interface

uses
  ActiveX, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ToolWin, Menus, ActnList, ImgList, StrUtils, Contnrs,
  Shdocvw_tlb, SHDocVwEvents, MSHTML_tlb, ExtCtrls, Registry,
  Variants, ShellAPI, Buttons, IniFiles, MMSystem,
  ForAll, uAbout, uConnect, uSettings,
  bsSocketLibrary_TLB;



const
  pcAlert = 10;
  pcChat = 20;
  pcHAVE_FILE_HEAD = 30;
  pcGIVE_FILE_BODY = 31;
  pcHAVE_FILE_BODY = 32;
  pcSTOP_FILE_BODY = 33;


type

  TPeer = class
    Socket: Longword;
    ListItem: TListItem;
    Address, UpFileName, DnFileName: String;
    Port, UpFileHandle, UpFileSize, UpFileCount: Integer;
    DnFileHandle, DnFileSize, DnFileCount: Integer;
    UpFileItem, DnFileItem: TListItem;
  end;


  TfMain = class(TForm)
    NorImages: TImageList;
    StatusBar: TStatusBar;
    dlgOpen: TOpenDialog;
    GroupBox3: TGroupBox;
    mmChat: TMemo;
    edChat: TEdit;
    btnChat: TButton;
    GroupBox5: TGroupBox;
    Label1: TLabel;
    lvTransfers: TListView;
    btnSend: TButton;
    btnBrowse: TButton;
    edFile: TEdit;
    GroupBox2: TGroupBox;
    lvPeers: TListView;
    btnSettings: TButton;
    btnMyIP: TButton;
    btnAbout: TButton;
    btnExit: TButton;
    btnRemove: TButton;
    Timer1: TTimer;
    btnAbort: TButton;
    GroupBox1: TGroupBox;
    edAlert: TEdit;
    btnAlert: TButton;
    btnConnect: TButton;
    btnCancel: TButton;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

    procedure SetProperties;

    procedure LoadForm;
    procedure SaveForm;

    procedure btnExitClick(Sender: TObject);
    procedure btnAboutClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnSettingsClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure btnMyIPClick(Sender: TObject);
    procedure lvPeersChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure btnCancelClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
    procedure btnChatClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure lvTransfersChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure btnAbortClick(Sender: TObject);
    procedure btnAlertClick(Sender: TObject);

  private
    { Private declarations }

    CallHan: Integer;
    ThePeer: TPeer;
    Peers: TObjectList;

    function SelectPeer: Boolean;
    procedure UpdateStatus;
    procedure UpdateAbortButton;
    procedure AddPeer(aPeer: TPeer);
    procedure RemovePeer(aPeer: TPeer);
    procedure FinishUpload(aPeer: TPeer);
    procedure FinishDownload(aPeer: TPeer);

    procedure SessionInvoked(Sender: TObject; aHandle: Integer);
    procedure SessionCreated(Sender: TObject; aHandle: Integer);
    procedure SessionRejected(Sender: TObject; aHandle: Integer);
    procedure SessionClosed(Sender: TObject; aHandle: Integer);
    procedure PacketReceived(Sender: TObject; aHandle: Integer);
    procedure PacketSent(Sender: TObject; aHandle: Integer);

    procedure RecvAlert;
    procedure RecvChat;
    procedure RecvHaveFileHead;
    procedure RecvGiveFileBody;
    procedure RecvHaveFileBody;
    procedure RecvStopFileBody;

  public
    { Public declarations }
    SockLib: TBSSockLibX;
  end;

var
  fMain: TfMain;


//function InitHook: Boolean; stdcall;
//function DoneHook: Boolean; stdcall;


implementation

{$R *.DFM}






procedure TfMain.FormCreate(Sender: TObject);
begin
  Peers := TObjectList.Create;

  LoadForm;

  try
    SockLib := TBSSockLibX.Create(Self);
    SockLib.Parent := Self;
    SockLib.OnSessionCreated := SessionCreated;
    SockLib.OnSessionInvoked := SessionInvoked;
    SockLib.OnSessionRejected := SessionRejected;
    SockLib.OnSessionClosed := SessionClosed;
    SockLib.OnPacketReceived := PacketReceived;
    SockLib.OnPacketSent := PacketSent;
  except
    MessageDlg('BigSpeed Socket Library control is not registered on your system!', mtError, [mbOk], 0);
    Application.Terminate;
  end;
end;




procedure TfMain.FormDestroy(Sender: TObject);
begin
  SockLib.Free;
  Peers.Free;
  SaveForm;
end;




procedure TfMain.LoadForm;
var
  Ini: TIniFile;
begin
  try
    Ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'settings.ini');
  except
    Ini := nil;
  end;
  if Ini = nil then Exit;

  try
    with Ini do
    begin
      Left := ReadInteger('Last', 'Left', Left);
      Top := ReadInteger('Last', 'Top', Top);
    end;
  finally
    Ini.Free;
  end;
end;





procedure TfMain.SaveForm;
var
  Ini: TIniFile;
begin
  try
    Ini := TIniFile.Create(ExtractFilePath(Application.ExeName)+'settings.ini');
  except
    Ini := nil;
  end;
  if Ini = nil then Exit;

  try
    with Ini do
    begin
      WriteInteger('Last', 'Left', Left);
      WriteInteger('Last', 'Top', Top);
    end;
  finally
    Ini.Free;
  end;
end;






procedure TfMain.SetProperties;
begin

  SockLib.SecurityMode := fSettings.SecurityMode;
  SockLib.PublicKey := fSettings.mmPublic.Text;
  SockLib.PrivateKey := fSettings.mmPrivate.Text;
  SockLib.SecretKey := fSettings.edSecret.Text;
  SockLib.Fingerprints := fSettings.lstFingerprints.Items.CommaText;

  if fSettings.cbxServer.Checked then
  begin
    if not SockLib.StartListening(StrToIntDef(fSettings.edPort.Text, 0)) then
      MessageBox(0, 'Cannot start listening', 'Error!', MB_OK or MB_ICONERROR);
  end
  else
  begin
    SockLib.StopListening;
  end;

  SockLib.ServerAddress := fSettings.edSrvAddr.Text;
  SockLib.ClientAddress := fSettings.edClnAddr.Text;
  SockLib.UseCompression := fSettings.cbxCompression.Checked;
  if fSettings.radSocks5.Checked then
    SockLib.SocksProtocol := '5'
  else
    SockLib.SocksProtocol := '4';

  SockLib.SocksServer         := Trim(fSettings.edSocksAddr.Text);
  SockLib.SocksPort           := StrToIntDef(fSettings.edSocksPort.Text, 0);
  SockLib.SocksUsername       := Trim(fSettings.edSocksUser.Text);
  SockLib.SocksPassword       := Trim(fSettings.edSocksPass.Text);

  UpdateStatus;
end;






function TfMain.SelectPeer: Boolean;
var
  i: Integer;
  Pr: TPeer;
begin
  Result := False;

  if lvPeers.Selected = nil then
  begin
    for i := 0 to lvPeers.Items.Count-1 do
    begin
      Pr := TPeer(lvPeers.Items[i].Data);
      if SockLib.SessionOpen(Pr.Socket) then
      begin
        lvPeers.Items[i].Selected := True;
        Break;
      end;
    end;

    if lvPeers.Selected = nil then
    begin
      ShowMessage('There is no connected peer!');
      Exit;
    end;
  end;

  Pr := TPeer(lvPeers.Selected.Data);
  if not SockLib.SessionOpen(Pr.Socket) then
  begin
    ShowMessage('The selected peer is not connected!');
    Exit;
  end;

  Result := True;
end;



procedure TfMain.UpdateStatus;
begin
  if CallHan > 0 Then
  begin
    //a call is in progress
    btnConnect.Enabled := False;
    btnCancel.Enabled := True;
  end
  else
  begin
    //a new call can be initiated
    btnConnect.Enabled := True;
    btnCancel.Enabled := False;
  end;

  if SockLib.SecurityMode > 0 then
    StatusBar.Panels[0].Text := ' Encryption: ON'
  else
    StatusBar.Panels[0].Text := ' Encryption: OFF';

  if SockLib.IsListening then
    StatusBar.Panels[1].Text := ' Server: ON'
  else
    StatusBar.Panels[1].Text := ' Server: OFF';

  if lvPeers.Items.Count = 0 then
    StatusBar.Panels[2].Text := ' No active connection'
  else
    StatusBar.Panels[2].Text := ' ' + IntToStr(lvPeers.Items.Count) + ' connection(s)';

  if CallHan <> 0 then
    StatusBar.Panels[2].Text := ' Connecting to ' + fConnect.edHost.Text + ':' + fConnect.edPort.Text;
end;



procedure TfMain.UpdateAbortButton;
begin
  btnAbort.Enabled := False;
  if lvTransfers.Selected = nil then Exit;
  if lvTransfers.Selected.Data = nil then Exit;  //non-active
  btnAbort.Enabled := True;
end;



procedure TfMain.AddPeer(aPeer: TPeer);
begin
  Peers.Add(aPeer);
  aPeer.Address := SockLib.GetRemoteAddress(aPeer.Socket);
  aPeer.Port := SockLib.GetRemotePort(aPeer.Socket);

  with lvPeers.Items.Add do
  begin
    Data := Pointer(aPeer);
    Caption := aPeer.Address;
    Subitems.Add(IntToStr(aPeer.Port));
    Subitems.Add(TimeToStr(now));
  end;

  aPeer.ListItem := lvPeers.Items[lvPeers.Items.Count-1];
  UpdateStatus;
end;


procedure TfMain.RemovePeer(aPeer: TPeer);
begin
  aPeer.Socket := 0;
  lvPeers.Items.Delete(aPeer.ListItem.Index);
  Peers.Remove(aPeer);
  UpdateStatus;
end;



procedure TfMain.FinishUpload(aPeer: TPeer);
begin
  if aPeer.UpFileHandle > 0 then
  begin
    FileClose(aPeer.UpFileHandle);
    aPeer.UpFileHandle := 0;
  end;
  aPeer.UpFileItem.Data := nil;
  aPeer.UpFileItem := nil;
  UpdateAbortButton;
end;


procedure TfMain.FinishDownload(aPeer: TPeer);
begin
  if aPeer.DnFileHandle > 0 then
  begin
    FileClose(aPeer.DnFileHandle);
    aPeer.DnFileHandle := 0;
  end;
  aPeer.DnFileItem.Data := nil;
  aPeer.DnFileItem := nil;
end;



//************  User Events


procedure TfMain.btnExitClick(Sender: TObject);
begin
  Application.Terminate;
end;


procedure TfMain.btnAboutClick(Sender: TObject);
begin
  fAbout.ShowModal;
end;




procedure TfMain.FormShow(Sender: TObject);
begin
  SetProperties;
end;



procedure TfMain.btnSettingsClick(Sender: TObject);
begin
  if fSettings.ShowModal <> mrOk then Exit;
  SetProperties;
end;








//************** Socket event handlers


//successful call
procedure TfMain.SessionCreated(Sender: TObject; aHandle: Integer);
var
  Pr: TPeer;
begin
  CallHan := 0;
  Pr := TPeer.Create;
  Pr.Socket := aHandle;
  SockLib.SetMoniker(aHandle, Longword(Pr));
  AddPeer(Pr);
end;



//unsuccessful call
procedure TfMain.SessionRejected(Sender: TObject; aHandle: Integer);
begin
  CallHan := 0;
  UpdateStatus;
  ShowMessage('Cannot connect to ' + fConnect.edHost.Text + ':' + fConnect.edPort.Text);
end;


//incoming connection
procedure TfMain.SessionInvoked(Sender: TObject; aHandle: Integer);
var
  Pr: TPeer;
begin
  Pr := TPeer.Create;
  Pr.Socket := aHandle;
  SockLib.SetMoniker(aHandle, Longword(Pr));
  AddPeer(Pr);
end;


procedure TfMain.SessionClosed(Sender: TObject; aHandle: Integer);
var
  Pr: TPeer;
begin
  Pr := TPeer(SockLib.GetMoniker(aHandle));
  RemovePeer(Pr);
end;


procedure TfMain.PacketReceived(Sender: TObject; aHandle: Integer);
begin
  ThePeer := TPeer(SockLib.GetMoniker(aHandle));
  case SockLib.GetRcvdCmnd(aHandle) of
    pcAlert: RecvAlert;
    pcChat: RecvChat;
    pcHAVE_FILE_HEAD: RecvHaveFileHead;
    pcGIVE_FILE_BODY: RecvGiveFileBody;
    pcHAVE_FILE_BODY: RecvHaveFileBody;
    pcSTOP_FILE_BODY: RecvStopFileBody;
  end;
end;




procedure TfMain.RecvAlert;
var
  S: String;
begin
  S := 'From ' + SockLib.GetRemoteAddress(ThePeer.Socket) + ' at ' + TimeToStr(Now) + #13#13;
  S := S + SockLib.TextFromBuffer(ThePeer.Socket);
  MessageBox(0, PChar(S), 'Alert!', MB_OK or MB_ICONEXCLAMATION or MB_SYSTEMMODAL);
end;



procedure TfMain.RecvChat;
var
  S: String;
begin
  S := '['+TimeToStr(Now) + '] ';
  S := S + SockLib.GetRemoteAddress(ThePeer.Socket) + ':';
  S := S + SockLib.TextFromBuffer(ThePeer.Socket);
  mmChat.Lines.Add(S);
end;



procedure TfMain.RecvHaveFileHead;
begin
  if ThePeer.DnFileHandle > 0 then
  begin
    FileClose(ThePeer.DnFileHandle);
    ThePeer.DnFileItem.SubItems[2] := 'Canceled';
  end;

  ThePeer.DnFileCount := 0;
  ThePeer.DnFileName := SockLib.TextFromBuffer(ThePeer.Socket);
  ThePeer.DnFileSize := SockLib.IntegerFromBuffer(ThePeer.Socket);

  ThePeer.DnFileHandle := FileCreate(ExtractFilePath(Application.ExeName) + ThePeer.DnFileName);
  if ThePeer.DnFileHandle <= 0 then
  begin
    ShowMessage('Cannot create ' + ThePeer.DnFileName);
    Exit;
  end;

  ThePeer.DnFileItem := lvTransfers.Items.Add;
  with ThePeer.DnFileItem do
  begin
    Data := ThePeer;
    Caption := ThePeer.DnFileName;
    SubItems.Add('download');
    SubItems.Add(ThePeer.ListItem.Caption);
    SubItems.Add('handshaking');
  end;

  SockLib.SendPacket(ThePeer.Socket, pcGIVE_FILE_BODY);
end;



procedure TfMain.RecvGiveFileBody;
var
  Pt: OleVariant;
  Len: Integer;
  P: PByte;

begin
  if ThePeer.UpFileItem = nil then Exit;  //aborted

  if ThePeer.UpFileCount >= ThePeer.UpFileSize then
  begin
    //the file is done
    ThePeer.UpFileItem.SubItems[2] := 'Done.';
    FinishUpload(ThePeer);
  end
  else
  begin
    while ThePeer.UpFileCount < ThePeer.UpFileSize  do
    begin
      Len := ThePeer.UpFileSize - ThePeer.UpFileCount;
      if Len > SockLib.GetFreeRoom(ThePeer.Socket) then
        Len := SockLib.GetFreeRoom(ThePeer.Socket);
      if Len <= 0 then Break;

      Pt := VarArrayCreate([0, Len-1], varByte);
      P := VarArrayLock(Pt);
      if P = nil then Exit;
      if FileRead(ThePeer.UpFileHandle, P^, Len) <> Len then
      begin
        ThePeer.UpFileItem.SubItems[2] := 'Error reading';
        FinishUpload(ThePeer);
        Exit;
      end;
      VarArrayUnlock(Pt);
      SockLib.BytesToBuffer(ThePeer.Socket, Pt);
      Inc(ThePeer.UpFileCount, Len);
    end;
    SockLib.SendPacket(ThePeer.Socket, pcHAVE_FILE_BODY);
  end;
end;



procedure TfMain.RecvHaveFileBody;
var
  Pt: OleVariant;
  Len: Integer;
  P: PByte;
begin
  if ThePeer.DnFileHandle < 0 then Exit;
  Pt := SockLib.BytesFromBuffer(ThePeer.Socket);
  if not VarIsArray(Pt) then Exit;
  Len := VarArrayHighBound(Pt, 1) - VarArrayLowBound(Pt, 1) + 1;
  P := VarArrayLock(Pt);
  if P = nil then Exit;
  if FileWrite(ThePeer.DnFileHandle, P^, Len) <> Len then
  begin
    ThePeer.DnFileItem.SubItems[2] := 'Error writing';
    FinishDownload(ThePeer);
    Exit;
  end;
  VarArrayUnlock(Pt);
  Inc(ThePeer.DnFileCount, Len);
  if ThePeer.DnFileCount >= ThePeer.DnFileSize then
  begin
    //the file is done
    ThePeer.DnFileItem.SubItems[2] := 'Done.';
    FinishDownload(ThePeer);
  end;
end;



procedure TfMain.RecvStopFileBody;
begin
  if ThePeer.DnFileItem = nil then Exit;
  ThePeer.DnFileItem.SubItems[2] := 'Aborted';
  FinishDownload(ThePeer);
end;



procedure TfMain.PacketSent(Sender: TObject; aHandle: Integer);
begin
  if SockLib.LastError > 0 then Exit;
  ThePeer := TPeer(SockLib.GetMoniker(aHandle));
  if SockLib.GetSentCmnd(aHandle) = pcHAVE_FILE_BODY then
    RecvGiveFileBody;
end;



procedure TfMain.btnConnectClick(Sender: TObject);
begin
  if fConnect.ShowModal <> mrOk then Exit;
  CallHan := SockLib.CreateSession(fConnect.edHost.Text, StrToIntDef(fConnect.edPort.Text, 0));

  if CallHan = 0  then
    MessageDlg('Cannot create socket: ' + IntToStr(SockLib.LastError), mtError, [mbOk], 0)
  else
  begin
    btnConnect.Enabled := False;
    btnCancel.Enabled := True;
    UpdateStatus;
  end;
end;


procedure TfMain.btnMyIPClick(Sender: TObject);
begin
  ShowMessage(SockLib.LocalIP);
end;


procedure TfMain.lvPeersChange(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  if Change <> ctState then Exit;
  btnRemove.Enabled := lvPeers.SelCount = 1;
  UpdateStatus;
end;

procedure TfMain.btnCancelClick(Sender: TObject);
begin
  SockLib.TerminateSession(CallHan);
  CallHan := 0;
  UpdateStatus;
end;


procedure TfMain.btnRemoveClick(Sender: TObject);
var
  Pr: TPeer;
begin
  if lvPeers.Selected = nil then Exit;
  Pr := TPeer(lvPeers.Selected.Data);
  SockLib.TerminateSession(Pr.Socket);
  RemovePeer(Pr);
end;


procedure TfMain.btnChatClick(Sender: TObject);
var
  Pr: TPeer;
  S: String;
begin
  if not SelectPeer then Exit;
  if lvPeers.Selected = nil then Exit;
  Pr := TPeer(lvPeers.Selected.Data);

  SockLib.TextToBuffer(Pr.Socket, edChat.Text);
  SockLib.SendPacket(Pr.Socket, pcChat);

  S := '['+TimeToStr(Now) + '] Me:';
  S := S + edChat.Text;
  mmChat.Lines.Add(S);
  edChat.Text := '';
end;



procedure TfMain.btnAlertClick(Sender: TObject);
var
  Pr: TPeer;
begin
  if not SelectPeer then Exit;
  if lvPeers.Selected = nil then Exit;
  Pr := TPeer(lvPeers.Selected.Data);

  SockLib.TextToBuffer(Pr.Socket, edAlert.Text);
  SockLib.SendPacket(Pr.Socket, pcAlert);
  edAlert.Text := '';
end;


procedure TfMain.btnBrowseClick(Sender: TObject);
begin
  if not dlgOpen.Execute then Exit;
  edFile.Text := dlgOpen.FileName;
end;


procedure TfMain.btnSendClick(Sender: TObject);
begin
  if not SelectPeer then Exit;

  if not FileExists(edFile.Text) then
  begin
    ShowMessage('File does not exist!');
    Exit;
  end;

  ThePeer := TPeer(lvPeers.Selected.Data);
  if ThePeer.UpFileHandle > 0 then
  begin
    FileClose(ThePeer.UpFileHandle);
    ThePeer.UpFileItem.SubItems[2] := 'Canceled';
  end;

  ThePeer.UpFileHandle := FileOpen(edFile.Text, fmOpenRead or fmShareExclusive);
  if ThePeer.UpFileHandle <= 0 then
  begin
    ShowMessage('Cannot open ' + edFile.Text);
    Exit;
  end;

  ThePeer.UpFileItem := lvTransfers.Items.Add;
  with ThePeer.UpFileItem do
  begin
    Data := ThePeer;
    Caption := edFile.Text;
    SubItems.Add('upload');
    SubItems.Add(ThePeer.ListItem.Caption);
    SubItems.Add('handshaking');
  end;

  ThePeer.UpFileCount := 0;
  ThePeer.UpFileSize := GetFileSize(ThePeer.UpFileHandle, nil);
  SockLib.TextToBuffer(ThePeer.Socket, ExtractFileName(edFile.Text));
  SockLib.IntegerToBuffer(ThePeer.Socket, ThePeer.UpFileSize);
  SockLib.SendPacket(ThePeer.Socket, pcHAVE_FILE_HEAD);
end;



procedure TfMain.btnAbortClick(Sender: TObject);
var
  Pr: TPeer;
begin
  if lvTransfers.Selected = nil then Exit;
  Pr := TPeer(lvTransfers.Selected.Data);
  if Pr.UpFileItem = nil then Exit;
  Pr.UpFileItem.SubItems[2] := 'Aborted';
  FinishUpload(Pr);
  SockLib.SendPacket(Pr.Socket, pcSTOP_FILE_BODY);
end;



procedure TfMain.Timer1Timer(Sender: TObject);
var
  i: Integer;
  Pr: TPeer;
begin
  for i := 0 to lvPeers.Items.Count-1 do
  begin
    Pr := TPeer(lvPeers.Items[i].Data);
    if Pr.UpFileItem <> nil then
      Pr.UpFileItem.SubItems[2] := IntToStr(Pr.UpFileCount) + '/' + IntToStr(Pr.UpFileSize);
    if Pr.DnFileItem <> nil then
      Pr.DnFileItem.SubItems[2] := IntToStr(Pr.DnFileCount) + '/' + IntToStr(Pr.DnFileSize);

//debug    Pr.ListItem.SubItems[1] := IntToStr(SockLib.GetRcvCnt(Pr.Socket)) + '/' + IntToStr(SockLib.GetSndCnt(Pr.Socket));
  end;
end;



procedure TfMain.lvTransfersChange(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  if Change <> ctState then Exit;
  UpdateAbortButton;
end;


end.