Вот переписал функцию с СИ на Паскаль.
+ Еще много чего по проверке наличия Автокада.
"Мы выстояли, мы выдержали, мы победили".
Л.И. Брежнев
procedure TForm1.Button2Click(Sender: TObject);
var
hwnd1: HWND;
WndHandle: THandle;
sp:string;
Cl:string;
i:integer;
function GetAcadHWND: HWND;
function EnumCBFun(h: HWND; parm: integer): BOOL; cdecl;
var wt: array[0..511] of char;
begin
ZeroMemory(@wt, sizeof(wt));
Result:=not (GetWindowText(h, @wt[0], ((sizeof(wt)-1) div (sizeof(char))))<>0);
if not Result
then Result:=not(AnsiCompareStr(wt, acCAPT)=0);
if Result
then acHWND:=0
else acHWND:=h;
end;
begin
try
//Проверка запуска АКАДА
Acad:=GetActiveOleObject('AutoCAD.Application.15') as IAcadApplication;
except
try
//При False запуск АКАДА
Acad:=CreateOleObject('AutoCAD.Application.15') as IAcadApplication;
except
ShowMessage('AutoCAD не может быть запущен !');
exit;
end;
end;
//Видимость АКАДА
////Acad.visible:=true;
AcadApp := IDispatch(Acad) as IAcadApplication;
///acCAPT:=acadApp.Caption;
EnumWindows(@EnumCBFun, 0);
Result:=acHWND;
end;
function EnumWindowsProc(hwnd2:HWND; lParam:LPARAM):boolean;stdcall;
var
buf:string[255];
spec:cardinal;
a:string;
begin
// Находим имя окна
GetWindowText(hwnd2, @buf, sizeof(buf)-1);
a:=buf;
a:=(copy(a,1,8));
if AnsiCompareText(a, 'eadlands')=0 then begin
hCommandLine:= hwnd2; // Сохраняем ее HWND в глобальной переменной
result:=false;
exit;
end;
result:=true;
end;
function IsOLEObjectInstalled(Name: String): boolean;
var
ClassID: TCLSID;
Rez : HRESULT;
begin
// Ищем CLSID OLE-объекта
Rez := CLSIDFromProgID(PWideChar(WideString(Name)), ClassID);
if Rez = S_OK then // Объект найден
Result := true
else
Result := false;
end;
function GetOrCreateObject(const ClassName: string): IDispatch;
var
ClassID: TGUID;
Unknown: IUnknown;
begin
try
ClassID:=ProgIDToClassID (ClassName);
if SUCCEEDED(GetActiveObject(ClassID,nil,Unknown))
then OleCheck(Unknown.QueryInterface(IDispatch,Result))
else Result:=CreateOleObject (ClassName);
except
MessageDlg('На данном компьютере AutoCAD не установлен!!!', mtError, [mbOK], 0);
end;
end;
function CreateAutoCAD: Variant;
begin
if Not IsOLEObjectInstalled('AutoCAD.Application.15') then
begin
MessageDlg('На данном компьютере AutoCAD 2002 не установлен!!!', mtError, [mbOK],0);
Result := Null;
end;
Result := GetOrCreateObject('AutoCAD.Application.15');
end;
begin
if (IsOLEObjectInstalled('AutoCAD.Application.15')=true) then
CreateAutoCAD else
begin
ShowMessage('Не найден AutoCAD');
exit;
end;
hwnd1:=0;
try
Acad:=GetActiveOleObject('AutoCAD.Application.15') as IAcadApplication;
except
//При False запуск АКАДА
Acad:=CreateOleObject('AutoCAD.Application.15') as IAcadApplication;
end;
//Видимость АКАДА
////Acad.visible:=true;
AcadApp := IDispatch(Acad) as IAcadApplication;
HWND1:=FindWindow(nil, 'AutoCAD 2002');
i:=1;
if (HWND1=0) then begin
while (HWND1=0) and (i<300) do
begin
HWND1:=FindWindow(nil, pansichar('AutoCAD 2002 - [Drawing'+inttostr(i)+'.dwg]'));
i:=i+1;
end;
end;
if (HWND1=0) and (i=300) then begin
ShowMessage('Чертеж не найден !');
exit;
end;
if HWND1<>0 then begin
{GetClassName(HWND1, Cs, 255);
ShowMessage(inttostr(HWND1));
ShowMessage(Cs);
HWND1:=FindWindow(Cs, nil);
ShowMessage(inttostr(HWND1)); }
end;
if HWND1=0 then
begin
ShowMessage('AutoCAD не обнаружен !');
exit;
end;
EnumChildWindows(hwnd1,@EnumWindowsProc,0);
if hCommandLine=0 then begin
EnumChildWindows(hwnd1,@EnumWindowsProc,0);
end;
if hCommandLine<>0 then begin
PostMessage(hCommandLine,WM_KEYUP,VK_ESCAPE,0); // Дважды посылаем ESC
PostMessage(hCommandLine,WM_KEYUP,VK_ESCAPE,0); // в командную строку
///Acad.visible:=true;
end
else begin
ShowMessage('AutoCAD не зарегистрирован!');
end;
end;