Utilizamos cookies propias y de terceros. Al navegar entendemos que aceptas el uso de cookies. +Info.
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Usuario
· Wiki

Registrar un fichero OCX/DLL con Delphi simulando el comando regsvr32 de Windows - Delphi
Lenguaje de programación Borland Delphi



A continuación os mostramos el código fuente/source code en Delphi para registrar un fichero OCX ó DLL (ejecuntando la utilidad que Windows incluye para ello: regsvr32):

unit UnidadMenuPrincipal;

interface

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

type
  TformMenuPrincipal = class(TForm)
    bRegistrar: TButton;
    txtFichero: TEdit;
    LWEB: TLabel;
    bSel: TButton;
    dlAbrir: TOpenDialog;
    procedure LWEBClick(Sender: TObject);
    procedure bSelClick(Sender: TObject);
    procedure bRegistrarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

implementation

{$R *.dfm}

function ExecAndWait(const ExecuteFile, ParamString : string): boolean;
var
  SEInfo: TShellExecuteInfo;
  ExitCode: DWORD;
begin
  FillChar(SEInfo, SizeOf(SEInfo), 0);
  SEInfo.cbSize := SizeOf(TShellExecuteInfo);
  with SEInfo do begin
    fMask := SEE_MASK_NOCLOSEPROCESS;
    Wnd := Application.Handle;
    lpFile := PChar(ExecuteFile);
    lpParameters := PChar(ParamString);
    nShow := SW_HIDE;
  end;
  if ShellExecuteEx(@SEInfo) then
  begin
    repeat
      Application.ProcessMessages;
      GetExitCodeProcess(SEInfo.hProcess, ExitCode);
    until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
    Result:=True;
  end
  else Result:=False;
end;


procedure registrarOCX (fichero : string);
type
  TRegFunc = function : HResult; stdcall;
var
  ARegFunc : TRegFunc;
  aHandle  : THandle;
begin
 try
  aHandle := LoadLibrary(PChar(fichero));
  if aHandle <> 0 then
  begin
    ARegFunc := GetProcAddress(aHandle,'DllRegisterServer');
    if Assigned(ARegFunc) then
    begin
      ExecAndWait('regsvr32','/s ' + fichero);
    end;
    FreeLibrary(aHandle);
  end;
  MessageDlg(Format('El fichero: %s se ha registrado correctamente.', [fichero]),
      mtInformation, [mbok], 0);
 except
  MessageDlg(Format('No se ha podido registrar: %s', [fichero]),
      mtWarning, [mbok], 0);
 end;
end;

procedure TformMenuPrincipal.LWEBClick(Sender: TObject);
begin
  ShellExecute(Handle, Nil, PChar(LWEB.CAPTION),
      Nil, Nil, SW_SHOWNORMAL);
end;

procedure TformMenuPrincipal.bSelClick(Sender: TObject);
begin
  if dlAbrir.Execute then
    txtFichero.Text := dlAbrir.FileName;
end;

procedure TformMenuPrincipal.bRegistrarClick(Sender: TObject);
begin
  if FileExists(txtFichero.Text) then
    registrarOCX(txtFichero.Text)
  else
    MessageDlg('El fichero ' + txtFichero.Text + ' no existe.', mtWarning, [mbok], 0);
end;

end.




Publicado el: 2005-08-27

Este sitio web NO CONTIENE malware, todos los programas con código fuente aquí. Autor: Alonso Javier Pérez Díaz Google+ Síguenos en Google+