乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 31|回复: 1

发个Delphi版的安装源码(arx随cad自动启动,可动态设定)

[复制链接]

1

主题

1

帖子

1

银币

初来乍到

Rank: 1

铜币
5
发表于 2012-3-11 23:51:00 | 显示全部楼层 |阅读模式
首先感谢各位前辈的付出。我整合了一下。
使用方法:
1.将Setup.exe和Setup.ini放到你的arx目录.
2.修改[Applications]下的内容,如果您有多个dll,则加入多条
[Applications]
xx=xx.dll
yy=yy.dll
3.如果您有更新版本的cad,则修改[Version]下的内容.请自行参数已设定的参数
pas
-----
unit fFrmMain;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, IniFiles, ExtCtrls, Registry;
type
  TFrmMain = class(TForm)
    lstVersion: TCheckListBox;
    Panel1: TPanel;
    btnInstall: TButton;
    btnUnInstall: TButton;
    btnExit: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnInstallClick(Sender: TObject);
    procedure btnUnInstallClick(Sender: TObject);
  private
    { Private declarations }
    FIni: TIniFile;
    FReg: TRegistry;
    function AcadExists(VerCode: String): Boolean;
    function Install(VerCode, Name, Path: String): Boolean;
    function UnInstall(VerCode, Name, Path: String): Boolean;   
  public
    { Public declarations }
  end;
var
  FrmMain: TFrmMain;
const
  Key = 'Software\Autodesk\AutoCAD\';
  HKLM = HKEY_LOCAL_MACHINE;
  HKCU = HKEY_CURRENT_USER;
implementation
{$R *.dfm}
function TFrmMain.AcadExists(VerCode: String): Boolean;
begin
  FReg.RootKey := HKCU;
  Result := FReg.OpenKey(AutoCADKey + VerCode, False);
  FReg.CloseKey;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
var
  i: Integer;
  VerCode: String;
  list: TStringList;
begin
  if not FileExists(ExtractFilePath(Application.ExeName)+'Setup.ini') then begin
    Application.MessageBox('Can`t find Setup.ini File!', 'Error', MB_OK+MB_ICONERROR);
    Application.Terminate;
    Abort;
  end;
  FIni := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Setup.ini');
  //
  FReg := TRegistry.Create;  
  //
  list := TStringList.Create;
  try
    FIni.ReadSection('Version', list);
    for i:=0 to list.Count-1 do begin
      lstVersion.Items.Add(list);
      VerCode := FIni.ReadString('Version', list, '');
      lstVersion.ItemEnabled := AcadExists(VerCode);
    end;
  finally
    list.Free;
  end;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  FReg.Free;
  FIni.Free;
end;
procedure TFrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;
function TFrmMain.Install(VerCode, Name, Path: String): Boolean;
var
  CurVer: String;
begin
  Result := False;
  FReg.RootKey := HKCU;
  if not FReg.OpenKey(AutoCADKey + VerCode, False) then exit;
  CurVer := FReg.ReadString('CurVer');
  FReg.CloseKey;
  CurVer := AutoCADKey + VerCode + '\' + CurVer + '\Applications';
  if FReg.KeyExists(CurVer) then
    FReg.OpenKey(CurVer + '\' + Name, True);
  FReg.WriteInteger('LOADCTRLS', 2);  //LOADCTRLS
  FReg.WriteString('LOADER', Path);  //LOADER
  FReg.WriteInteger('MANAGED', 1);  //MANAGED
  FReg.CloseKey;
end;
function TFrmMain.UnInstall(VerCode, Name, Path: String): Boolean;
var
  CurVer: String;
begin
  Result := False;
  FReg.RootKey := HKCU;
  if not FReg.OpenKey(AutoCADKey + VerCode, False) then exit;
  CurVer := FReg.ReadString('CurVer');
  FReg.CloseKey;
  CurVer := AutoCADKey + VerCode + '\' + CurVer + '\Applications';
  if FReg.KeyExists(CurVer) then
    FReg.DeleteKey(CurVer + '\' + Name);
  FReg.CloseKey;
end;
procedure TFrmMain.btnInstallClick(Sender: TObject);
var
  i, j: Integer;
  VerCode, Name, Path: String;
  list: TStringList;
begin
  list := TStringList.Create;
  try
    FIni.ReadSection('Applications', list);
    for i:=0 to list.Count-1 do begin
      Name := list;
      Path := FIni.ReadString('Applications', Name, '');
      Path := ExtractFilePath(Application.ExeName) + Path;
      for j:=0 to lstVersion.Count-1 do begin
        if lstVersion.Checked[j] then begin
          VerCode := FIni.ReadString('Version', lstVersion.Items[j], '');
          Install(VerCode, Name, Path);
        end;
      end;
    end;
    Application.MessageBox('Install success!', 'Install', MB_OK+MB_ICONINFORMATION);
  finally
    list.Free;
  end;
end;
procedure TFrmMain.btnUnInstallClick(Sender: TObject);
var
  i, j: Integer;
  VerCode, Name, Path: String;
  list: TStringList;
begin
  list := TStringList.Create;
  try
    FIni.ReadSection('Applications', list);
    for i:=0 to list.Count-1 do begin
      Name := list;
      Path := FIni.ReadString('Applications', Name, '');
      Path := ExtractFilePath(Application.ExeName) + Path;
      for j:=0 to lstVersion.Count-1 do begin
        if lstVersion.Checked[j] then begin
          VerCode := FIni.ReadString('Version', lstVersion.Items[j], '');
          UnInstall(VerCode, Name, Path);
        end;
      end;
    end;
    Application.MessageBox('UnInstall success!', 'UnInstall', MB_OK+MB_ICONINFORMATION);
  finally
    list.Free;
  end;
end;
end.
ini
-----
[Version]
AutoCAD 2000=R15.0
AutoCAD 2002=R15.0
AutoCAD 2004=R16.0
AutoCAD 2005=R16.1
AutoCAD 2006=R16.2
AutoCAD 2007=R17.0
AutoCAD 2008=R17.1
AutoCAD 2009=R17.2
[Applications]
mcad=mcad.dll

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

0

主题

1

帖子

1

银币

初来乍到

Rank: 1

铜币
1
发表于 2012-3-12 08:48:00 | 显示全部楼层
这个很强大,学习一下
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 21:16 , Processed in 0.596826 second(s), 61 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表