mainform.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 900 行 · 第 1/2 页

    ClientsSharedResource.WaitToWrite;
    try
      Client := TSimpleClient.Create;
    { Assign its default values }
      Client.DNS  := AContext.Connection.Socket.Binding.PeerIP;
      Client.Name := AContext.Connection.Socket.Binding.PeerIP;
      Client.Context := AContext;
    { SSH ClientServer IOhandler initialization }  
      Client.SSHCSIOHandler :=
        TElIdSSHClientServerIOHandler(AContext.Connection.IOHandler);
      Client.SSHCSIOHandler.OnOpenChannel := Client.HandleOpenConnection;
      Client.SSHCSIOHandler.OnAuthAttempt := Client.HandleAuthAttempt;
      Client.SSHCSIOHandler.OnAuthPassword := Client.HandleAuthPassword;
      Client.SSHCSIOHandler.OnError := Client.HandleError;

      Client.SSHDataConnection := nil;
    { Assign it to the thread so we can identify it later }
      AContext.Data := Client;
    { Add it to the clients list }
      Clients.Add(Client);
    { updating clients list }
      UpdateClientList;
    finally
      ClientsSharedResource.Done;
    end;
  end;
end;

procedure TfrmMain.tcpServerDisconnect(AContext: TIdContext);
var
  Client : TSimpleClient;
begin
  ClientsSharedResource.WaitToWrite;

  try
    { Retrieve Client Record from Data pointer }
    Client := Pointer(AContext.Data);

    if Assigned(Client) then
    begin
    { Remove Client from the Clients list }
      Clients.Delete(Clients.IndexOf(Client));
      UpdateClientList;
    { Broadcast leaving message }
      SendText(nil, '** ' + Client.Name + ' disconnected.');
      SendText(nil, ClientList);
    { Free the Client object }
      Client.Free;
      AContext.Data := nil;
    end;
  finally
    ClientsSharedResource.Done;
  end;
end;

procedure TfrmMain.tcpServerExecute(AContext: TIdContext);
var
  Client : TSimpleClient;
  Com, Msg : String;
begin
  { Get the clients package info }
  Client := Pointer(AContext.Data);

  if not Assigned(Client.SSHCSIOHandler) then
  begin
    AContext.Connection.Disconnect;
    Exit;
  end;

  Client.SSHCSIOHandler.DataAvailable;

  if (Client.SSHCSIOHandler.Active) and Assigned(Client.SSHDataConnection) then
  begin
  { Get the text sent from the client }
    Msg := RecvText(Client);
    { If name is set, then send the message }

    if Length(Msg) = 0 then
    begin
      Sleep(100);
      Exit;
    end;

    if Msg[1] <> '@' then
    begin
      SendText(nil, Client.Name + '>' + Msg);
    end
    else
    begin
    { System command }
      Com := UpperCase(Trim(Copy(Msg, 2, Pos(':', Msg) -2)));
      Msg := Trim(Copy(Msg, Pos(':', Msg) +1, Length(Msg)));
      if Com = 'CLIENTS' then
      begin
        SendText(Client, ClientList);
        AddToLog('** Clientlist request from ' + Client.Name);
      end
      else if Com = 'MSG' then
      begin
        SendText(nil, Client.Name + '>' + Msg);
      end;
    end;
  end;
end;

procedure TfrmMain.DisconnectClient(Client: TSimpleClient; const Reason: string);
begin
  if Assigned(Client.SSHDataConnection) and
    (Client.SSHDataConnection.Connected) then
  begin
    try
      SendText(Client, edSysopName.Text + '>' + Reason);
    except
    end;
  end;

  if Assigned(Client.SSHCSIOHandler) then
  try
    Client.SSHCSIOHandler.Close;
  except
  end;
end;

procedure TfrmMain.btnLoadKeyClick(Sender: TObject);
var
  Res : integer;
  Key : TElSSHKey;
begin
  if dlgLoadKey.Execute then
  begin
    Key := TElSSHKey.Create;
    try
      Res := Key.LoadPrivateKey(dlgLoadKey.FileName, '');

      if Res = 0 then
        SetServerKey(Key)
      else
      if Res = SB_ERROR_SSH_KEYS_INVALID_PASSPHRASE then
      begin
        Res := frmPassword.ShowModal;
        if Res = mrOk then
        begin
          Res := Key.LoadPrivateKey(dlgLoadKey.FileName, frmPassword.edPassword.Text);
          if Res = 0 then
            SetServerKey(Key)
          else
            Application.MessageBox('Incorrect passphrase!','Error', MB_OK);
        end;
      end
      else
        Application.MessageBox('Cannot load server key!','Error', MB_OK);
    finally
      Key.Free;
    end;
  end;
end;

procedure TfrmMain.SendText(Client : TSimpleClient; const Msg: string);
var
  I : integer;
begin
  if Client = nil then
  begin
    { broadcasting message to all connected users }
    for I := 0 to Clients.Count - 1 do
      SendText(Clients[I], Msg);
    if (Length(Msg) > 0) and (Msg[1] <> '@') then
      AddToLog(Msg);
  end
  else
  begin
    if Assigned(Client.SSHDataConnection)
      then
      try
        Client.SSHDataConnection.IOHandler.WriteLn(Msg);
      except
        on E : Exception do
        begin
          AddToLog('** Client ' + Client.Name + ' error : ' + E.Message);
          DisconnectClient(Client, '');
        end;
      end;
  end;
end;

procedure TfrmMain.AddToLog(const Str: string);
begin
  memLog.Lines.Add(Str);
end;

function TfrmMain.ClientList: string;
begin
  Result := '@CLIENTS:' + lbClients.Items.CommaText;
end;

function TfrmMain.RecvText(Client: TSimpleClient): string;
begin
  if Assigned(Client) and Assigned(Client.SSHDataConnection)
    and (Client.SSHDataConnection.Connected) then
  begin
    try
      Result := Client.SSHDataConnection.IOHandler.ReadLn('', 5);
    except
      on E : Exception do
      begin
        Result := '';
        AddToLog('** Client ' + Client.Name + ' error : ' + E.Message);
        DisconnectClient(Client, '');
      end;
    end;
  end;
end;

{ TSimpleClient }

constructor TSimpleClient.Create;
begin
  inherited;

  Name := '';
  Context := nil;
  SSHCSIOHandler := nil;
  SSHDataConnection := nil;
end;

destructor TSimpleClient.Destroy;
begin
  if Assigned(SSHCSIOHandler) then
    FreeAndNil(SSHCSIOHandler);
  if Assigned(SSHDataConnection) then
    FreeAndNil(SSHDataConnection);

  inherited;
end;

procedure TSimpleClient.HandleAuthPassword(Sender: TObject; const Username,
  Password: string; var Accept, ForceChangePassword: boolean);
var
  Index : integer;
  Digest : TMessageDigest160;
begin
  Accept := false;

  for Index := 0 to frmMain.AllowedClients.Count - 1 do
    if LowerCase(Trim(Username)) =
      LowerCase(Trim(TAllowedClientInfo(frmMain.AllowedClients[Index]).Login)) then
  begin
    if TAllowedClientInfo(frmMain.AllowedClients[Index]).HasPassword then
    begin
      Digest := HashSHA1(Password);
      if CompareMD160(Digest, TAllowedClientInfo(frmMain.AllowedClients[Index]).Digest) then
      begin
        Accept := true;
        Name := Username;
        Exit;
      end;
    end
    else
    begin
      Accept := true;
      Name := Username;
      Exit;
    end;
  end;

  frmMain.AddToLog('** Authentication failed for user ' + Username);
end;

procedure TSimpleClient.HandleAuthAttempt(Sender: TObject;
  const Username: string; AuthType: integer; var Accept: boolean);
begin
  if not (AuthType = SSH_AUTH_TYPE_PASSWORD) then
    Accept := false
  else
    Accept := true;
end;

procedure TSimpleClient.HandleOpenConnection(Sender: TObject;
  Connection: TElIdSSHConnection);
begin
  { checking connection type }
  if (Connection.TunnelType = ttSubsystem) and (Connection.Subsystem = 'chat') then
  begin
    frmMain.AddToLog(Format('** Opened channel to client %s', [Self.Name]));
    SSHDataConnection := Connection;

    frmMain.SendText(Self, frmMain.memEntry.Text);
    frmMain.UpdateClientList;
    frmMain.SendText(nil, frmMain.ClientList);
  end;
end;

procedure TSimpleClient.HandleError(Sender: TObject; ErrorCode: integer);
begin
  frmMain.AddToLog(Format('** Client %s SSH error %d, disconnecting.', [Name, ErrorCode]));
end;


procedure TfrmMain.btnRefreshClick(Sender: TObject);
begin
  LoadAllowedClientsList;
end;

procedure TfrmMain.UpdateAllowedClientsList;
var
  Index : integer;
  Str : string;
begin
  lbAllowedUsers.Clear;
  for Index := 0 to AllowedClients.Count - 1 do
  begin
    Str := TAllowedClientInfo(AllowedClients[Index]).Login;
    if TAllowedClientInfo(AllowedClients[Index]).HasPassword then
      Str := Str + '(*)';
    lbAllowedUsers.Items.AddObject(Str, AllowedClients[Index]);
  end;
end;

procedure TfrmMain.LoadAllowedClientsList;
var
  FUsers : TextFile;
  UStr, Hash, Login : string;
  I : integer;
  Digest : TMessageDigest160;
  UInfo : TAllowedClientInfo;
begin
  AllowedClients.Clear;
  if FileExists('.chat_users') then
  try
    System.Assign(FUsers, '.chat_users');
    ReSet(FUsers);

    while not EOF(FUsers) do
    begin
      ReadLn(FUsers, UStr);
      I := Pos(':', UStr);
      if I > 0 then
      begin
        Login := Copy(UStr, 1, I - 1);
        Hash := Trim(Copy(Ustr, I + 1, Length(UStr) - I));

        UInfo := TAllowedClientInfo.Create;
        UInfo.Login := Login;

        if (Length(Hash) = 40) and (SBUtils.StrToDigest(Hash, Digest)) then
        begin
          UInfo.Digest := Digest;
          UInfo.HasPassword := true;
        end
        else
          UInfo.HasPassword := false;

        AllowedClients.Add(UInfo);
      end;
    end;
    System.Close(FUsers);
  finally
  end;

  UpdateAllowedClientsList;
end;

procedure TfrmMain.btnAddUserClick(Sender: TObject);
var
  UserInfo : TAllowedClientInfo;
  Login : string;
begin
  Login := InputBox('Adding user..', 'Enter login : ', '');

  if Login <> '' then
  begin
    UserInfo := TAllowedClientInfo.Create;
    UserInfo.Login := Login;
    UserInfo.HasPassword := false;
    AllowedClients.Add(UserInfo);
    UpdateAllowedClientsList;
  end;
end;

procedure TfrmMain.btnSetPasswordClick(Sender: TObject);
var
  UInfo : TAllowedClientInfo;
  Index : integer;
  Password : string;
begin
  Index := lbAllowedUsers.ItemIndex;
  if Index < 0 then Exit;

  UInfo := TAllowedClientInfo(lbAllowedUsers.Items.Objects[Index]);

  if Assigned(UInfo) then
  begin
    Password := InputBox('New password', 'Password (empty to remove):', '');
    if Password = '' then
    begin
      FillChar(UInfo.Digest, SizeOf(UInfo.Digest), 0);
      UInfo.HasPassword := false;
    end
    else
    begin
      UInfo.Digest := HashSHA1(Password);
      UInfo.HasPassword := true;
    end;
  end;

  UpdateAllowedClientsList;
end;

procedure TfrmMain.btnSaveClick(Sender: TObject);
var
  FUsers : TextFile;
  Index : integer;
begin
  try
    System.Assign(FUsers, '.chat_users');
    ReWrite(FUsers);

    for Index := 0 to AllowedClients.Count - 1 do
    begin
      Write(FUsers, TAllowedClientInfo(AllowedClients[Index]).Login, ':');
      if TAllowedClientInfo(AllowedClients[Index]).HasPassword then
      begin
        WriteLn(FUsers, DigestToStr(TAllowedClientInfo(AllowedClients[Index]).Digest));
      end
      else
        WriteLn(FUsers);
    end;
    
    System.Close(FUsers);
  finally
  end;

  UpdateAllowedClientsList;
end;

procedure TfrmMain.btnDelUserClick(Sender: TObject);
var
  UInfo : TAllowedClientInfo;
  Index : integer;
begin
  Index := lbAllowedUsers.ItemIndex;
  if Index < 0 then Exit;

  UInfo := TAllowedClientInfo(lbAllowedUsers.Items.Objects[Index]);
  AllowedClients.Remove(UInfo);
  UpdateAllowedClientsList;
end;

end.