|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,strutils, StdCtrls,Registry,comobj,autocad_tlb;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Function SearchCADversion(Location: String) :boolean;
Function openkeyr(Location: String) :boolean;
var
Form1: TForm1;
acadversion: Array[1..30] of String;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
vStringList: TStringList;
vnStringList: TStringList;
I: Integer;
pp:string;
begin
vStringList := TStringList.Create;
vnStringList := TStringList.Create;
with TRegistry.Create do try
RootKey := HKEY_LOCAL_MACHINE;
//for i=
if OpenKey('\Software\Autodesk\AutoCAD\R16.0\ACAD-201:804',false) then begin
GetKeyNames(vStringList);
GetKeyNames( vStringList);
GetValueNames (vnStringList);
for I := 0 to vStringList.Count - 1 do begin
// if (vStringList[I]='AcadLocation') then //'AUTO CAD'也许是其它
// ShowMessage(vnStringList[I])
// ShowMessage(vStringList[i]+' '+vnStringList[I])
//GetDataInfo('AcadLocation',&pp);
if ValueExists('AcadLocation') then pp:=readstring('AcadLocation');
ShowMessage (pp) end
end;
CloseKey;
showmessage(vnstringlist[i]);
finally
vStringList.Free;
vnStringList.Free;
Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
acad:acadapplication;
pp,acadProfile,mkey:string ;
aa :array[0..1000] of char;
i, popnum:integer;
amenugroup:acadmenugroup;
amenu:acadpopupmenu;
begin
// a:=tstrings.Create;
try
acad:=getactiveoleobject('AutoCAD.Application') as acadapplication;
except;
try
acad:=createoleobject('AutoCAD.Application') as acadapplication;
acad.WindowState:=acMin;
acad.visible:=true;
except
showmessage('no');
exit;
end
end ;
// acad.visible:=true;
if not DirectoryExists('d:\temp') then
if not CreateDir('d:\temp') then begin
raise Exception.Create('Cannot create d:\temp');
exit;
end;
pp:=(acad.Preferences.Files.SupportPath );
if strpos('d:\temp',pchar(pp))=nil then
begin
pp:=pp+';d:\temp';
acad.Preferences.Files.SupportPath:=pchar(pp)
end else
showmessage('pp');
acadProfile:=acad.Preferences.Profiles.ActiveProfile ;
try
//showmessage(inttostr( acad.Application.MenuGroups.Count));
for i:=0 to acad.Application.MenuGroups.Count-1 do
if acad.Application.MenuGroups.Item(i).Name='MYACAD' then begin
acad.Application.MenuGroups.Item(i).Unload;
break
end
// amenugroup.
except
end;
// acad.Quit;
//exit;
amenugroup:=acad.Application.MenuGroups.Load('c:\1.mns',false );
for i:=0 to acad.Application.MenuGroups.Count-1 do begin
popnum:=popnum+acad.Application.MenuGroups.Item(i).Menus.Count;
end;
amenu:=amenugroup.Menus.Item(0);
amenu.InsertInMenuBar(popnum+1);
acad.Quit;
exit;
i:=1;
for i:=1 to 30 do begin
if SearchCADversion( acadversion[i]) then begin
mkey:=acadversion[i]+'\Profiles\'+acad.Preferences.Profiles.ActiveProfile +'\Dialogs' ;
//if openkeyr('SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:804\Profiles\<<未命名配置>>\Dialogs\appload') then
if openkeyr(mkey) then
showmessage('okok');
end;
end;
// acad.Preferences.
// acad.Preferences
//acad.Quit;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
mkey:string;
begin
i:=1;
for i:=1 to 30 do begin
if SearchCADversion( acadversion[i]) then begin
// mkey:=acadversion[i]+'\'+acad.Preferences.Profiles.ActiveProfile +'\Dialogs' ;
// if openkeyr(mkey) then
showmessage('ok');
end;
end;
end;
Function SearchCADversion(Location: String) :boolean;
var
vStringList: TStringList;
vnStringList: TStringList;
I: Integer;
pp:string;
begin
SearchCADversion:=false;
vStringList := TStringList.Create;
vnStringList := TStringList.Create;
with TRegistry.Create do try
RootKey := HKEY_LOCAL_MACHINE;
//for i=
if Location='' then exit;
if OpenKey(Location,false) then begin
GetKeyNames(vStringList); //所有下级子健
GetKeyNames( vStringList);
GetValueNames (vnStringList); // 此健下面的所有项
for I := 0 to vStringList.Count - 1 do begin
// if (vStringList[I]='AcadLocation') then //'AUTO CAD'也许是其它
// ShowMessage(vnStringList[I])
// ShowMessage(vStringList[i]+' '+vnStringList[I])
//GetDataInfo('AcadLocation',&pp);
if ValueExists('AcadLocation') then pp:=readstring('AcadLocation');
SearchCADversion:=true;
end
end;
CloseKey;
finally
vStringList.Free;
vnStringList.Free;
Free;
end;
end ;
Function openkeyr(Location: String) :boolean;
var
vStringList: TStringList;
vnStringList: TStringList;
I,num: Integer;
pp:string;
begin
openkeyr:=false;
vStringList := TStringList.Create;
vnStringList := TStringList.Create;
with TRegistry.Create do try
RootKey := HKEY_CURRENT_USER;
//for i=
if Location='' then exit;
if OpenKey(Location,false) then begin
if not KeyExists ('appload') then begin
createkey('appload');
with TRegistry.Create do begin
RootKey := HKEY_CURRENT_USER;
if OpenKey(Location+'\appload',false) then begin
createkey('Startup');
with TRegistry.Create do begin
if OpenKey(Location+'\appload\Startup',false) then begin
writestring('1Startup','d:temp\pldy.dvb');
writestring('NumStartup','1');
end;
closekey;
end;
closekey;
end
end;
openkeyr:=true;
end else begin
try
with TRegistry.Create do begin
RootKey := HKEY_CURRENT_USER;
if OpenKey(Location+'\appload\Startup',false) then begin
GetValueNames(vStringList);
// pp:=readstring(vStringList[1]);
for i:=1 to vStringList.Count-1 do
if rightstr( readstring(vStringList[i]),length('PpldyJia1.dvb'))='PpldyJia1.dvb' then
begin
writestring(vStringList[i],'C:\Program Files\AutoCAD 2004\Support\PpldyJia.dvb');
exit;
end ;
// rightstr(
//if OpenKey(Location+'\appload\Startup',false) then
num:=strtoint(readstring('NumStartup'))+1;
writestring('NumStartup',inttostr(num));
closekey;
end;
end;
except
end;
end;
end ;
CloseKey;
finally
vStringList.Free;
vnStringList.Free;
Free;
end;
end ;
initialization
acadversion[1]:='SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:804'; //2000中文版
acadversion[2]:='SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:409' ;//2000英文版
acadversion[3]:='SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:804 ';//2002中文版
acadversion[4]:='SOFTWARE\Autodesk\AutoCAD\R15.0\ACAD-1:409';//2002英文版
acadversion[5]:='SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:804';//2004中文版
acadversion[6]:='SOFTWARE\Autodesk\AutoCAD\R16.0\ACAD-201:409';//2004英文版
acadversion[7]:='SOFTWARE\Autodesk\AutoCAD\R16.1\ACAD-301:804 ';//2005中文版
acadversion[8]:='SOFTWARE\Autodesk\AutoCAD\R16.1\ACAD-301:409 ';//2005英文版
acadversion[9]:='SOFTWARE\Autodesk\AutoCAD\R16.2\ACAD-4001:804 ';//2006中文版
acadversion[10]:='SOFTWARE\Autodesk\AutoCAD\R16.2\ACAD-4001:409 ';//2006英文版
acadversion[11]:='SOFTWARE\Autodesk\AutoCAD\R17.0\ACAD-5001:804 ';//2007中文版
acadversion[12]:='SOFTWARE\Autodesk\AutoCAD\R17.0\ACAD-5001:409 ';//2007英文版
acadversion[13]:='SOFTWARE\Autodesk\AutoCAD\R17.1\ACAD-6001:804 ';//2008中文版
acadversion[14]:='SOFTWARE\Autodesk\AutoCAD\R17.1\ACAD-6001:409 ';//2008英文版
acadversion[15]:='SOFTWARE\Autodesk\AutoCAD\R17.2\ACAD-7001:804';//2009中文版
acadversion[16]:='SOFTWARE\Autodesk\AutoCAD\R17.2\ACAD-7001:409 ';//2009英文版
end.
|
