este codigo que les dejo debe lanzarse desde un servicio(solo la cuenta system desencrypta la key)
crean el servicio con delphi y agregan el codigo, luego tienen que instalar el
servicio y despues inciarlo)
"hay muchos manuales en delphi para programar servicios".
intente con inyeccion en system pero no pude , mejor me quede con el servicio.
la unica cosa extraña es que en ves de dejarme el wkey.txt (es donde almaceno la key) en c:\user\appdata\local\temp, donde le indico , me lo deja en c:\windows\temp y ese era mi error que me tenia de los pelos , generaba el log donde yo no lo encontraba y pense que era problema de mal programacion del servicio, pero no funciona de 10 .
cuando termine otros codigos voy a dejar en nuestros programas el ejecutable final full.
este es el codigo final para recuperar la clave wireles de tu pc
Código: Seleccionar todo
program Project1;
{$APPTYPE CONSOLE}
uses
windows,
sysutils,
classes,
dialogs;
CONST
CRYPT_STRING_HEX=4;
type
TDATA_BLOB = record
cbData: DWORD;
pbData: PByte;
end;
PDATA_BLOB = ^TDATA_BLOB;
TCRYPTPROTECT_PROMPTSTRUCT = record
cbSize: DWORD;
dwPromptFlags: DWORD;
hwndApp: HWND;
szPrompt: PWChar;
end;
PCRYPTPROTECT_PROMPTSTRUCT = ^TCRYPTPROTECT_PROMPTSTRUCT;
function Pars(T_, ForS, _T: string): string;
var
a, b: integer;
begin
Result := '';
if (T_ = '') or (ForS = '') or (_T = '') then
Exit;
a := Pos(T_, ForS);
if a = 0 then
Exit
else
a := a + Length(T_);
ForS := Copy(ForS, a, Length(ForS) - a + 1);
b := Pos(_T, ForS);
if b > 0 then
Result := Copy(ForS, 1, b - 1);
end;
procedure FindFiles(StartDir, FileMask: string;
recursively: boolean;var FilesList: TStringList);
const
MASK_ALL_FILES = '*.*';
CHAR_POINT = '.';
var
sRec: TSearchRec;
// SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
begin
if (StartDir[length(StartDir)] <> '\') then begin
StartDir := StartDir + '\';
end;
// Crear la lista de ficheos en el dir. StartDir (no directorios!)
IsFound := FindFirst(StartDir + FileMask,
faAnyFile - faDirectory, sRec) = 0;
// MIentras encuentre
while IsFound do begin
FilesList.Add(StartDir + sRec.Name);
IsFound := FindNext(sRec) = 0;
end;
FindClose(sRec);
// Recursivo?
if (recursively) then begin
// Build a list of subdirectories
DirList := TStringList.Create;
// proteccion
try
IsFound := FindFirst(StartDir + MASK_ALL_FILES,
faAnyFile, sRec) = 0;
while IsFound do begin
if ((sRec.Attr and faDirectory) <> 0) and
(sRec.Name[1] <> CHAR_POINT) then begin
DirList.Add(StartDir + sRec.Name);
end;
IsFound := FindNext(sRec) = 0;
// end; // if
end; // while
FindClose(sRec);
// Scan the list of subdirectories
for i := 0 to DirList.Count - 1 do begin
FindFiles(DirList[i], FileMask, recursively, FilesList);
end;
finally
DirList.Free;
end;
end;
end;
const
// flag el dato lo puede descifrar cualquier usuario
CRYPTPROTECT_LOCAL_MACHINE = 4;
var
size :dword = 1024;
byteKey: array[0..1024] of pbyte;
FilesList,datos: TStringList;
s2:wideString;
Src, Dst: TDATA_BLOB;
i:integer;
s,t1,t2:string;
f:textfile;
resp:bool;
function CryptUnprotectData(pDataIn: PDATA_BLOB; szDataDescr: PWChar;
pOptionalEntropy: PDATA_BLOB; pvReserved: Pointer;
pPromptStruct: PCRYPTPROTECT_PROMPTSTRUCT; dwFlags: DWORD; pDataOut: PDATA_BLOB
): BOOL; stdcall; external 'Crypt32.dll';
function CryptStringToBinary(pszString: PwideChar; cchString: DWORD; dwFlags: DWORD;
pbBinary: pbyte; var pcbBinary: dword; pdwSkip: PDWORD;
pdwFlags: PDWORD): BOOL; stdcall;
external 'Crypt32.dll' name 'CryptStringToBinaryW';
//CryptStringToBinaryW (Unicode) d2010 and CryptStringToBinaryA (ANSI) d7
begin
try
begin
datos := TStringList.Create;
FilesList := TStringList.Create;
findfiles('C:\ProgramData\Microsoft\Wlansvc\Profiles\','*.xml',true,FilesList) ; //true recursividad es si busca en subcarpetas
for i:=0 to FilesList .Count -1 do begin
datos.loadfromfile(fileslist[i]);
s:=datos.text;
t1:= (pars('<name>',s,'</name>'));
//essid
t2:= (pars('<authentication>',s,'</authentication>'));//cifrado wep o wpa
s2:= (pars('<keyMaterial>',s,'</keyMaterial>')); //clave wireles
fileslist.SaveToFile((GetEnvironmentVariable('TEMP') +'\info redes.txt'));
// convertir a byte array
resp:= CryptStringToBinary (pwidechar(S2),length(S2),CRYPT_STRING_HEX, @byteKey,size,nil, nil);
if resp =true then
begin
AssignFile(f,( GetEnvironmentVariable('TEMP') +'\wkey.txt'));
if FileExists(( GetEnvironmentVariable('TEMP') +'\wkey.txt')) then
append(f)
else
rewrite(f);
try
dst.cbData:= (size);
Dst.pbdata :=(@bytekey[0]);
showmessage( pchar(@bytekey[0]));
writeln(f,'essid: '+t1);
writeln(f,'------------------');
writeln(f,'tipo de encriptacion: '+t2);
writeln(f,'------------------');
if CryptUnProtectData(@Dst,nil,nil,nil,nil,CRYPTPROTECT_LOCAL_MACHINE,@Src) then
begin
writeln(f,('password is: '+pansichar(Src.pbData)));
CloseFile(f);
end
else begin
writeln(SysErrorMessage(GetLastError));
writeln('presione enter para saliir');
readln;
end;
finally
end;
end;
end;
datos.free;
FilesList.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
