Permite recuperar cuentas FTP de FileZilla.

Código: Seleccionar todo

//******************************************************************************
//* UNIT:         UNT_FileZillaRec
//* AUTOR:        Fakedo0r
//* FECHA:        03.05.2012
//* CORREO:       [email protected]
//* BLOG:         Sub-Soul.blogspot.com
//* USO:          FileZillaRec
//******************************************************************************
unit UNT_FileZillaRec;
//******************************************************************************
//DECLARACION DE LIBRERIAS / CLASES
//******************************************************************************
interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, ShlObj;
//******************************************************************************
//DECLARACION DE FUNCIONES / PROCEDIMIENTOS
//******************************************************************************
function FileZillaRec: String;
function IsFileExists(sFile: String): Bool;
function MsgBoxA(sMensaje: String): String;
function ReadFileA(sFile: String): String;
function GetSpecialFolderA(iCSIDL: Integer): String;
function ByteArrayToString(bByteArray: TBytes): AnsiString;
function SplitA(sCadena: String; sDelimitador: String): TStrings;
function MidText(sCadena: String; sDel_1: String; sDel_2: String): String;
//******************************************************************************
implementation
//******************************************************************************
//<--- RECUPERA LAS CUENTAS DE FILEZILLA --->
//******************************************************************************
function FileZillaRec: String;
var
  sHost:        String;
  sUser:        String;
  sPass:        String;
  sPath:        String;
  sAccounts:    String;
  I:            Smallint;
  sArrAccs:     TStrings;
begin
  Result := '';
  sPath := GetSpecialFolderA(CSIDL_APPDATA) + '\FileZilla\recentservers.xml';

  if IsFileExists(sPath) = False then
  begin
    Result := '';
    Exit;
  end;

  sAccounts := ReadFileA(sPath);
  sAccounts := MidText(sAccounts, '<RecentServers>', '</RecentServers>');
  sArrAccs := SplitA(sAccounts, '<Server>');

  for I := 1 to sArrAccs.Count - 1 do
  begin
    sHost := MidText(sArrAccs[i], '<Host>', '</Host>');
    sUser := MidText(sArrAccs[i], '<User>', '</User>');
    sPass := MidText(sArrAccs[i], '<Pass>', '</Pass>');

    Result := Result + 'Host: ' + sHost + #13#10 +
                       'User: ' + sUser + #13#10 +
                       'Pass: ' + sPass + #13#10 + #13#10;
  end;
end;
//******************************************************************************
//<--- OBTIENE LAS RUTAS ESPECIALES --->
//******************************************************************************
function GetSpecialFolderA(iCSIDL: Integer): String;
Var
   pszPath: PChar;
   iRet:    Integer;
   tIDL:    PItemIDList;
begin
  GetMem(pszPath, MAX_PATH);
  iRet := SHGetSpecialFolderLocation(0, iCSIDL, tIDL);

  if iRet = NOERROR then
  begin
    SHGetPathFromIDList(tIDL, pszPath);
    GetSpecialFolderA := String(pszPath);
  end;

  FreeMem(pszPath);
end;
//******************************************************************************
//<--- PERMITE LEER TEXTO / BINARIO --->
//******************************************************************************
function ReadFileA(sFile: String): String;
var
  dwRet:    DWORD;
  hFile:    THandle;
  iSize:    Integer;
  bRead:    TBytes;
begin
  hFile := CreateFile(PChar(sFile), GENERIC_READ, FILE_SHARE_READ, nil,
                      OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

  if hFile = INVALID_HANDLE_VALUE then
  begin
    //MsgBoxA('Se produjo un error !');
    Exit;
  end;

  iSize := GetFileSize(hFile, nil);
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  SetLength(bRead, iSize);

  ReadFile(hFile, bRead[0], iSize, dwRet, nil);
  CloseHandle(hFile);

  Result := ByteArrayToString(bRead);
end;
//******************************************************************************
//<--- CONVIERTE ARRAY DE BYTES EN STRING --->
//******************************************************************************
function ByteArrayToString(bByteArray: TBytes): AnsiString;
var
  i: Integer;
begin
  SetLength(Result, Length(bByteArray));

  for i := 0 to Length(bByteArray) do
    Result[i + 1] := AnsiChar(bByteArray[i]);
end;
//******************************************************************************
//<--- SPLIT --->
//******************************************************************************
function SplitA(sCadena: String; sDelimitador: String): TStrings;
var
  iIndex: Integer;
begin
  Result := nil;
  Result := TStringList.Create;

  for iIndex := 0 to length(sCadena) do
  begin
    if AnsiPos(sDelimitador, sCadena) = 0 then
      begin
      Result.Add(Copy(sCadena ,1 , Length(sCadena)));
      Exit;
    end
    else
    begin
      Result.Add(Copy(sCadena, 1, AnsiPos(sDelimitador, sCadena) - 1));
      sCadena := Copy(sCadena, Length(Result.Strings[iIndex]) + Length(sDelimitador) + 1, Length(sCadena) - Length(sDelimitador));
    end;
  end;
end;
//******************************************************************************
//<--- VERIFICA SI EL ARCHIVO EXISTE --->
//******************************************************************************
function IsFileExists(sFile: String): Bool;
var
  iRet: DWORD;
begin
  Result:= True;
  iRet := GetFileAttributes(PChar(sFile));

  if iRet = INVALID_FILE_ATTRIBUTES then
  begin
    //MsgBoxA('El archivo no existe !');
    Result := False;
  end;
end;
//******************************************************************************
//<--- OBTIENE LA CADENA CENTRAL --->
//******************************************************************************
function MidText(sCadena: String; sDel_1: String; sDel_2: String): String;
begin
  Result := Copy(sCadena, AnsiPos(sDel_1, sCadena) + Length(sDel_1), Length(sCadena) - AnsiPos(sDel_2, Result));
  Result := Copy(Result, 1,  AnsiPos(sDel_2, Result) - 1);
end;
//******************************************************************************
//<--- MSGBOX --->
//******************************************************************************
function MsgBoxA(sMensaje: String): String;
begin
  Result := IntToStr(MessageBoxEx(0, PChar(sMensaje), 'Mensaje', MB_ICONINFORMATION, 0));
end;

end.
Saludo.
El secreto de mi éxito es Jesús
Responder

Volver a “Fuentes”