Perfect powers in more than one way?
Mathematica: 103 chars    

Spaces can be removed

Select[Flatten@
       Table[
        Solve[Log@#/Log@b == k, k, Integers] /. k -&gt; #, {b, 2, #}] &amp; /@ Range@#, 
Length@# &gt; 2 &amp;][[All, 1, 1]] &amp;  


Usage:  

%[81]
{16, 64, 81}