Indetectables

Código: Seleccionar todo

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
      TmiFun = function :string;stdcall;
var
  Form1: TForm1;
  dir:string;
implementation

{$R *.dfm}
  
function dirwow64:string;

var
   sysdir: array [0..MAX_PATH] of char;

begin
GetSystemDirectory(sysdir, MAX_PATH);
 dir:=(ExtractFileDrive(sysdir)+ '\windows\sysWOW64\');
 result:=dir;
end;
//extraido from internet
function Is64BitOS: Boolean;
type
  TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
  hKernel32 : Integer;
  IsWow64Process : TIsWow64Process;
  IsWow64 : BOOL;
begin
  // We can check if the operating system is 64-bit by checking whether
  // we are running under Wow64 (we are 32-bit code). We must check if this
  // function is implemented before we call it, because some older 32-bit 
  // versions of kernel32.dll (eg. Windows 2000) don't know about it.
  // See "IsWow64Process", http://msdn.microsoft.com/en-us/library/ms684139.aspx
  Result := False;
  hKernel32 := LoadLibrary('kernel32.dll');
  if hKernel32 = 0 then RaiseLastOSError;
  try
    @IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
    if Assigned(IsWow64Process) then begin
      if (IsWow64Process(GetCurrentProcess, IsWow64)) then begin
        Result := IsWow64;
      end
      else RaiseLastOSError;
    end;
  finally
    FreeLibrary(hKernel32);
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dir:string;
begin
dir:=dirwow64;
if Is64BitOS then begin
 if ForceDirectories(dir+'midll')then begin
ShowMessage('se creo carpeta midll ');
if copyfile(pchar(getcurrentdir+'\32a64.dll'),pchar( dir+'midll\32a64.dll'),false)then
  ShowMessage('se copio dll a directorio ');
end
  else begin
   ShowMessage('no se pudo crear la carpeta : '+
                   IntToStr(GetLastError));
  end;
   end
     else begin
     showmessage('tu windows corre a 32 bits'+#13#10+'nada que hacer.... salimos');

end;
  end;
procedure TForm1.Button2Click(Sender: TObject);

var
 Handle: THandle;
 saludar : TmiFun;
begin
    dir:=  dirwow64;
  // Load the library
  Handle := LoadLibrary(pchar(dir+'midll\32a64.dll'));

  // If succesful ...
  if Handle <> 0 then
  begin
   // Assign function Max from the DLL to the
    // function variable mmax
    @saludar := GetProcAddress(Handle, 'saludar');
    // If successful
    if @saludar <> nil then
    begin
       saludar;
    end;

    // Unload library
    FreeLibrary(Handle);
  end;
   end;


procedure TForm1.Button3Click(Sender: TObject);
var
  Result: TSearchRec;
begin
dir:=dirwow64;
  if FindFirst((dir+'midll')+ '\*', faAnyFile, Result) = 0 then
  begin
    Try
      repeat
        if (Result.Attr and faDirectory) = faDirectory then
        begin
          if (Result.Name <> '.') and (Result.Name <> '..') then
            Removedir((dir+'midll')+ '\' + Result.Name)
        end
        else if not DeleteFile((dir+'midll')+ '\' + Result.Name) then
          RaiseLastOSError;
      until FindNext(Result) <> 0;
    Finally
      FindClose(Result);
    End;
  end;
  if not RemoveDir((dir+'midll')) then
    RaiseLastOSError;

end;

end.