install.pas

一个可以注册ocx控件的程序

unit install;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  const
  strDllFileName= 'iehelper.dll';

var
  Form1: TForm1;
  DllRegisterServer:function:HResult;
  DllUnregisterServer:function:HResult;

  DllAllpath:string;
  LibMir2Dll: THandle;

implementation

{$R *.dfm}

function MyGetWindowsDirectory: string;
var Buf: array[0..MAX_PATH] of char;
begin
  GetWindowsDirectory(Buf, MAX_PATH);
  Result := Buf;
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

function ExtractFilePath(APath: string): string;
var
  LI, LJ: Integer;
begin
  if (Length(APath) <> 0) and (Pos('\', APath) > 0) then
  begin
    LJ := 0;
    for LI := Length(APath) downto 1 do
      if APath[LI] = '\' then
      begin
        LJ := LI;
        Break;
      end;
    Result := Copy(APath, 1, LJ);
  end else Result := '';
end;

function RandomFilename(aFilename: string): string;
var
  Path, Filename, Ext: string;
begin
  Result := aFilename;
  Path := ExtractFilepath(aFilename);
  Ext := ExtractFileExt(aFilename);
  Filename := ExtractFilename(aFilename);
  if Length(Ext) > 0 then
    Filename := Copy(Filename, 1, Length(Filename) - Length(Ext));
  repeat
    Result := Path + Filename + inttoStr(Random(9999)) + Ext;
  until not FileExists(Result);
end;

function FileSetAttr(const FileName: string; Attr: Integer): Integer;
begin
  Result := 0;
  if not SetFileAttributes(PChar(FileName), Attr) then
    Result := GetLastError;
end;


procedure ExtractRes(ResType, ResName, ResNewName: string);
var
  HResInfo: THandle;
  HGlobal: THandle;
  FMemory: Pointer;
  FSize: Longint;
  handle: THandle;
  Wsize: longword;
  procedure SetPointer(Ptr: Pointer; Size: Longint);
  begin
    FMemory := Ptr;
    FSize := Size;
  end;
  function Initialize(Instance: THandle; Name, ResType: PChar): boolean;
  begin
    result := false;
    HResInfo := FindResource(Instance, Name, ResType);
    if HResInfo = 0 then Exit;
    HGlobal := LoadResource(Instance, HResInfo);
    if HGlobal = 0 then Exit;
    SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
    result := true;
  end;
begin
  if not Initialize(hInstance, PChar(ResName), PChar(ResType)) then exit;
  if fileexists(ResNewName) then Deletefile(pchar(ResNewName));
  try
    handle := Integer(CreateFile(PChar(ResNewName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
    WriteFile(Handle, FMemory^, FSize, Wsize, nil);
    CloseHandle(handle);
  except
  end;
  UnlockResource(HGlobal);
  FreeResource(HGlobal);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    DllAllpath := MyGetWindowsDirectory + strDllFileName;
    try
      FilesetAttr(DllAllpath, 0);
      DeleteFile(Pchar(DllAllpath)); {删除现有的DLL文件}
    except
    end;
    if FileExists(DllAllpath) then {如果删除失败，则改名}
    begin
      DllAllpath := RandomFilename(DllAllpath);
    end;
{$R Dll.Res}
    ExtractRes('DllFile', 'Mir2Dll', DllAllpath); {生成新的DLL插入文件}



end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   DllAllpath := MyGetWindowsDirectory + strDllFileName;
   LibMir2Dll := LoadLibrary(Pchar(DllAllpath));
   //  showmessage(dllallpath);
    try
      if LibMir2Dll <> 0 then
      begin
        @DllRegisterServer := GetProcAddress(LibMir2Dll, PChar('DllRegisterServer'));

      end;
    except
      FreeLibrary(LibMir2Dll);
      Halt;
    end;
   showmessage(inttostr(DllRegisterServer));

end;

procedure TForm1.Button3Click(Sender: TObject);
begin

  DllAllpath := MyGetWindowsDirectory + strDllFileName;
  LibMir2Dll := LoadLibrary(Pchar(DllAllpath));

    try
      if LibMir2Dll <> 0 then
      begin
        @DllUnregisterServer := GetProcAddress(LibMir2Dll, PChar('DllUnregisterServer'));

      end;
    except
      FreeLibrary(LibMir2Dll);
      Halt;
    end;

   showmessage(inttostr(DllUnregisterServer));
end;

end.