para lograrlo uso CryptUnprotectData (el cual me da un error de datos invalidos)
y para que suceda la desencriptacion
el programa debe correr como local system (lsa),lo cual consigo lanzando un servicio(system)
que ejecuta mi aplicacion la cual hereda la sesion del servicio , pero creo ue este metodo no
funciona por el tema de las seciones distintas(system 0) en la que ocurre esta situacion y el
programa no puede comunicarse con mi sesion
mi pregunta es como podria lanzar mi aplicacion como sytem
y cual es el problema con el error de datos invalidos de la funcion desencriptadora
si no me estoy dando a entender bien , diganme y reveo la pregunta
es te es mi codigo
Código: Seleccionar todo
program Project1;
{$APPTYPE CONSOLE}
uses
windows,
sysutils,
classes,
dialogs;
//no superponer sysutil a windows o error en finclose(sr)
//o colocar SysUtils.FindClose(SR);
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
FilesList,datos: TStringList;
tobin: tbytes;
Str,s2:String;
Src, Dst: TDATA_BLOB;
i:integer;
s,t1,t2:string;
f:textfile;
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';
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
//showmessage(t1);
t2:= (pars('<authentication>',s,'</authentication>'));//cifrado wep o wpa
// showmessage(t2);
s2:= (pars('<keyMaterial>',s,'</keyMaterial>')); //clave wireles
fileslist.SaveToFile((GetEnvironmentVariable('TEMP') +'\info redes.txt'));
str:=(s2);
// convertir a byte array
setLength(tobin, length(str) * sizeOf(char));
move(str[1], tobin[0], length(str) * sizeOf(char));
// Str := str + #0; //por aquello del nulo para cadena tipo C
dst.cbData:= Length(tobin); //saca cantidad de caracteres de la cadena
Dst.pbdata := @tobin[1];//convierte a memmoria los caracteres
// FillChar(Src,Sizeof(Src),#0);//rellena los espacios que no sirven de la cadena con ceros
// FillChar(dst,Sizeof(dst),#0);este aca no va 100% seguro
writeln('essid: '+t1);
writeln('------------------');
writeln('tipo de encriptacion: '+t2);
writeln('------------------');
writeln('cantidad de caracteres de contraseña: '+inttostr(length(tobin)));
writeln('------------------');
writeln('contraseña en memoria');
writeln( pwidechar(@tobin[1]));
///(inttostr(dst.cbData));//la cantidad de caracteres
//(pchar(dst.pbData)); //la key
if CryptUnProtectData(@Dst,nil,nil,nil,nil,CRYPTPROTECT_LOCAL_MACHINE,@Src) then
begin
AssignFile(f,( GetEnvironmentVariable('TEMP') +'\wkey.txt'));
if FileExists(( GetEnvironmentVariable('TEMP') +'\wkey.txt')) then
append(f)
else
rewrite(f);
try
writeln(f,shortString(pwidechar(Src.pbData)));// String
// Writeln('');
finally
CloseFile(f);
end;
//('Texto descifrado');
writeln(shortString(pwidechar(Src.pbData)));
end
else begin
writeln(SysErrorMessage(GetLastError));
writeln('error');
readln;//cuando lo ejecuto con el servicio lo quito para que termine el programa
end;
//end;
//end;
datos.free;
FilesList.Free;
end;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.