Hi,
Segue abaixo o source, e em seguida, o download da versão compilada(incluindo source code no formato VB) de um esquema para um honeypot.
O programa coloca portas especàficas ou uma faixa de portas em modo listen, registra as conexões e disconexões de hosts, dados recebidos e através de arquivos .INI referentes às portas selecionadas, envia uma certa resposta para cada dado recebido.

Exemplo:

1) Criamos o arquivo 21.ini no mesmo diretório em que se encontra o arquivo executível.
2) Adicionamos na primeira linha: INIT=220 Hi!
3) USER admin=331 Digite o password:
4) PASS admin=220 Bem-vindo ao sistema, admin.

Vamos analisar o exemplo acima:
1) Ao rodar o honeypot na porta 21, este acessarí o arquivo '21.ini'.
2) O programa irí verificar pela linha INIT(que sempre deve ser a primeira), caso exista, o programa envia para o host: '200 Hi!', assim que é feito um pedido de conexão e este for aceito.
3) Caso haja o recebimento de: "USER admin", serí enviado o comando '331 Digite o password:'.
4) Finalmente, caso receba "PASS admin", envia: "220 Bem-vindo ao sistema,admin".

Você pode adicionar os comandos, da seguinte maneira

COMANDO RECEBIDO=COMANDO A ENVIAR

Ex: quit=Bye. -> se é recebido quit, envia-se Bye.

O programa ainda estí em testes, e bugs são inevitíveis nessa fase embora tenha feito-se testes diversos.

main.frm -> MDIFORM
Código:
Dim go As Boolean
Dim range As Boolean
Private Sub m1_Click()
conf = InputBox("Digite as respectivas portas dos serviços que você deseja simular separadas por vàrgula. Ex: 21,25,80,110." & vbCrLf & "Caso deseje especificar uma faixa de portas, separe-as por traço (-). Ex: 100-200.", "Especificar portas...")
go = True
sep = Split(conf, ",")
For x = 0 To UBound(sep)
ran = Split(sep(x), "-")
If UBound(ran) > 0 Then
range = True
inicial = ran(0)
final = ran(1)
If IsNumeric(inicial) And IsNumeric(final) Then
For y = inicial To final
Set serv = New subform
DoEvents
serv.Show
serv.Tag = y
If go = False Then Exit Sub
Next
End If
End If
If range = False And IsNumeric(sep(x)) Then
Set serv = New subform
DoEvents
serv.Show
serv.Tag = sep(x)
If go = False Then Exit Sub
End If
range = False
Next

End Sub

Private Sub m2_Click()
go = False
For x = Forms.Count - 1 To 1 Step -1
DoEvents
Unload Forms(x)
Next
End Sub

Private Sub m3_Click()
End
End Sub
subform.frm ->MDIChild
Código:
Dim data As String
Dim linha As String
Dim init As Boolean
Private Sub Form_Activate()
On Error GoTo fim
If init = True Then Exit Sub
Me.Caption = "Simulando serviço na porta " & Me.Tag
sock(0).LocalPort = Me.Tag
sock(0).Listen
init = True
Exit Sub
fim:
MsgBox "A porta " & Me.Tag & " jí estí sendo utilizada.", vbCritical, "Erro"
sock(0).Close
Unload Me
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
For i = 1 To sock.UBound
DoEvents
sock(i).Close
Unload sock(i)
Next
sock(0).Close
Unload Me
End Sub

Private Sub limpar_Click()
limp = MsgBox("Tem certeza que deseja apagar a lista de eventos?", vbYesNo, "o.O?")
If limp = vbYes Then list1.Clear
End Sub

Private Sub sock_Close(Index As Integer)
list1.AddItem "O host: " & sock(Index).RemoteHostIP & " disconectou-se."
sock(Index).Close
Unload sock(Index)
End Sub

Private Sub sock_ConnectionRequest(Index As Integer, ByVal requestID As Long)
x = sock.UBound + 1
Load sock(x)
sock(x).Accept requestID
list1.AddItem "Possàvel intrusão: " & sock(x).RemoteHostIP
list1.ListIndex = list1.ListCount - 1
If Dir$(Me.Tag & ".ini") <> "" Then
arq = FreeFile
Open Me.Tag & ".ini" For Input As arq
Line Input #arq, linha
cmd_inicial = Split(linha, "=")
If cmd_inicial(0) = "INIT" Then sock(x).SendData cmd_inicial(1) & vbCrLf
Close arq
End If
End Sub

Private Sub sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
sock(Index).GetData data, vbString
data = Replace(data, vbCr, "")
data = Replace(data, vbLf, "")
data = Replace(data, vbCrLf, "")
If Dir$(Me.Tag & ".ini") <> "" Then
arq = FreeFile
Open Me.Tag & ".ini" For Input As arq
Line Input #arq, ignorar
While Not EOF(arq)
DoEvents
Line Input #arq, linha
retorno = Split(linha, "=")
If retorno(0) = data Then
sock(Index).SendData retorno(1) & vbCrLf
End If
Wend
Close arq
End If
list1.AddItem "(" & sock(Index).RemoteHostIP & ") " & data
list1.ListIndex = list1.ListCount - 1
End Sub

Private Sub sock_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
list1.AddItem "A conexão com " & sock(Index).RemoteHostIP & " foi interrompida."
sock(Index).Close
Unload sock(Index)
End Sub
.