Вверх ↑
Этот топик читают: Гость
Гость
Ответов: 17029
Рейтинг: 0
#1: 2009-08-04 13:40:52 правка | ЛС | профиль | цитата


Редактировалось 6 раз(а), последний 2021-06-24 07:39:43
карма: 0

0
Ответов: 1841
Рейтинг: 369
#2: 2009-08-04 13:41:44 ЛС | профиль | цитата
Блин, забыл залогиниться...
------------ Дoбавленo в 13.43:
упс, не в тот раздел...
PS. Если можно перенесите тему в "Делаем компоненты".
карма: 1
0
Администрация
Ответов: 15295
Рейтинг: 1519
#3: 2009-08-04 13:48:40 ЛС | профиль | цитата
текст из окна отладки?
карма: 27
0
Ответов: 1841
Рейтинг: 369
#4: 2009-08-04 13:53:12 ЛС | профиль | цитата
Dilma писал(а):
текст из окна отладки?



C:\Program Files\HiAsm\Elements\delphi\code\shortcut.pas(7) Error: ';', ')' or '=' expected but ',' found

C:\Program Files\HiAsm\Elements\delphi\code\shortcut.pas(80) Error: ';', ')' or '=' expected but ',' found

C:\Program Files\HiAsm\Elements\delphi\code\shortcut.pas(87) Error: Incompatible types: 'String' and 'PChar'

C:\Program Files\HiAsm\Elements\delphi\code\shortcut.pas(88) Error: Incompatible types: 'String' and 'PChar'

C:\Program Files\HiAsm\Elements\delphi\code\shortcut.pas(89) Error: Incompatible types: 'String' and 'PChar'

C:\Program Files\HiAsm\Elements\delphi\code\shortcut.pas(90) Error: Incompatible types: 'String' and 'PChar'

C:\Program Files\HiAsm\Elements\delphi\code\hiShortCut.pas(5) Fatal: Could not compile used unit 'shortcut.pas'
карма: 1
0
Администрация
Ответов: 15295
Рейтинг: 1519
#5: 2009-08-04 14:00:17 ЛС | профиль | цитата
вот это

#pas
procedure CreateLink(const Name, LinkName,wd,d,Param: string,icon: pchar);

заменить в обоих местах на это


#pas
procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);
карма: 27
1
Голосовали:CriDos
Главный модератор
Ответов: 2999
Рейтинг: 396
#6: 2009-08-04 14:05:02 ЛС | профиль | цитата
pe-shakht.donpac.ru писал(а):
PS. И кто нибудь дайте ссылку на Help в котором есть пункт "Разработка"!


Этапы разработки
Конфигурация элемента
Класс Custom
Установка компонента

карма: 6
Дорогу осилит идущий. Install/Update HiAsm.NET
0
Ответов: 1841
Рейтинг: 369
#7: 2009-08-04 14:32:36 ЛС | профиль | цитата
Вроде кампилится, щяс проверю работоспособность точки!
------------ Дoбавленo в 14.48:
Оо почемута поменялись местами все точки
------------ Дoбавленo в 14.51:
Например места Description стала Arguments
Вот
hiShortCut.pas

#pas
unit hiShortcut;

interface

uses Kol,Share,Debug,shortcut;

type
THIShortCut = class(TDebug)
private
public
_prop_FileName:string;
_prop_Arguments:string;
_prop_ShortcutName:string;
_prop_WorkingDirectory:string;
_prop_Description:string;
_prop_Icon:string;

_event_onCreate:THI_Event;

_data_FileName:THI_Event;
_data_Arguments:THI_Event;
_data_ShortcutName:THI_Event;
_data_WorkingDirectory:THI_Event;
_data_Description:THI_Event;
_data_Icon:THI_Event;

procedure _work_doCreate(var _Data:TData; Index:word);
end;

implementation

procedure THIShortCut._work_doCreate;
begin
CreateLink( PChar(ReadString(_Data,_data_FileName,_prop_FileName)),
PChar(ReadString(_Data,_data_Arguments,_prop_Arguments)),
PChar(ReadString(_Data,_data_ShortcutName,_prop_ShortcutName)),
PChar(ReadString(_Data,_data_WorkingDirectory,_prop_WorkingDirectory)),
PChar(ReadString(_Data,_data_Description,_prop_Description)),
PChar(ReadString(_Data,_data_Icon,_prop_Icon)));
_hi_onEvent(_event_onCreate);
end;

end.

shortcut.pas


#pas
unit shortcut;

interface

uses windows;

procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);

implementation

const
CLSID_ShellLink: TGUID = ( D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IShellLinkA: TGUID = ( D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));

type
_SHITEMID = record
cb: Word;
abID: array[0..0] of Byte;
end;
TSHItemID = _SHITEMID;
SHITEMID = _SHITEMID;
PItemIDList = ^TItemIDList;
_ITEMIDLIST = record
mkid: TSHItemID;
end;
TItemIDList = _ITEMIDLIST;

IShellLink = interface(IUnknown) { sl }
['{000214EE-0000-0000-C000-000000000046}']
function GetPath(pszFile: PAnsiChar; cchMaxPath: Integer;
var pfd: TWin32FindData; fFlags: DWORD): HResult; stdcall;
function GetIDList(var ppidl: PItemIDList): HResult; stdcall;
function SetIDList(pidl: PItemIDList): HResult; stdcall;
function GetDescription(pszName: PAnsiChar; cchMaxName: Integer): HResult;
stdcall;
function SetDescription(pszName: PAnsiChar): HResult; stdcall;
function GetWorkingDirectory(pszDir: PAnsiChar; cchMaxPath: Integer):
HResult; stdcall;
function SetWorkingDirectory(pszDir: PAnsiChar): HResult; stdcall;
function GetArguments(pszArgs: PAnsiChar; cchMaxPath: Integer): HResult;
stdcall;
function SetArguments(pszArgs: PAnsiChar): HResult; stdcall;
function GetHotkey(var pwHotkey: Word): HResult; stdcall;
function SetHotkey(wHotkey: Word): HResult; stdcall;
function GetShowCmd(out piShowCmd: Integer): HResult; stdcall;
function SetShowCmd(iShowCmd: Integer): HResult; stdcall;
function GetIconLocation(pszIconPath: PAnsiChar; cchIconPath: Integer;
out piIcon: Integer): HResult; stdcall;
function SetIconLocation(pszIconPath: PAnsiChar; iIcon: Integer): HResult;
stdcall;
function SetRelativePath(pszPathRel: PAnsiChar; dwReserved: DWORD): HResult;
stdcall;
function Resolve(Wnd: HWND; fFlags: DWORD): HResult; stdcall;
function SetPath(pszFile: PAnsiChar): HResult; stdcall;
end;

type
IPersist = interface(IUnknown)
['{0000010C-0000-0000-C000-000000000046}']
function GetClassID(out classID: TGUID): HResult; stdcall;
end;

IPersistFile = interface(IPersist)
['{0000010B-0000-0000-C000-000000000046}']
function IsDirty: HResult; stdcall;
function Load(pszFileName: PWideChar; dwMode: Longint): HResult;
stdcall;
function Save(pszFileName: PWideChar; fRemember: BOOL): HResult;
stdcall;
function SaveCompleted(pszFileName: PWideChar): HResult;
stdcall;
function GetCurFile(out pszFileName: PWideChar): HResult;
stdcall;
end;

procedure CoUninitialize; stdcall; external 'ole32.dll' name 'CoUninitialize';
function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll' name 'CoInitialize';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown; dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall; external 'ole32.dll' name 'CoCreateInstance';

procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);
var
Obj: IUnknown;
begin
Coinitialize(nil);
if CoCreateInstance(CLSID_ShellLink, nil, 1 or 4, IID_IShellLinkA, Obj) = 0 then
begin
(Obj as IShellLink).SetPath(Name);
(Obj as IShellLink).SetArguments(Param);
(Obj as IShellLink).SetWorkingDirectory(wd);
(Obj as IShellLink).SetDescription(d);
(Obj as IShellLink).SetIconLocation(Icon, 0);
(Obj as IPersistFile).Save(PWChar(WideString(LinkName)), FALSE);
end;
CoUninitialize;
end;

end.

Shortcut.ini

#ini
[About]
Version=1.1
Author=Amper
Mail=amper@xaker.ru

[Type]
Class=Element
Info=Создание ярлыков файлов
Tab=Files

[Property]
FileName=Имя файла для создания ярлыка|2|
Arguments=Параметры|2|
ShortcutName=Имя создаваемого ярлыка|2|
WorkingDirectory=Рабочая директория|2|
Description=Комментарий|2|
Icon=Иконка ярлыка|2|

[Methods]
doCreate=Создает ярлык|1|0
onCreate=Событие происходит при создании ярлыка|2|0
FileName=Имя файла для создания ярлыка|4|2
Arguments=Параметры|4|2
ShortcutName=Имя создаваемого ярлыка|4|2
WorkingDirectory=Рабочая директория|4|2
Description=Комментарий|4|2
*Icon=Иконка ярлыка|4|2
------------ Дoбавленo в 15.50:
Блин, не врублюсь почему он путает каменты с параметрами!
Уже переделал теперь все точки норм работают а эти 2 нефига!
Зато работаеют сами функции правда также на оборот...
Вот изменённый вариант.
ini (Shortcut.ini)

#ini
[About]
Version=1.1
Author=Amper
Mail=amper@xaker.ru

[Type]
Class=Element
Info=Создание ярлыков файлов
Tab=Files

[Property]
FileName=Имя файла для создания ярлыка|2|
ShortcutName=Имя создаваемого ярлыка|2|
WorkingDirectory=Рабочая директория|2|
Description=Комментарий|2|
Icon=Иконка ярлыка|2|
Param=Параметры запуска|2|

[Methods]
doCreate=Создает ярлык|1|0
onCreate=Событие происходит при создании ярлыка|2|0
FileName=Имя файла для создания ярлыка|4|2
ShortcutName=Имя создаваемого ярлыка|4|2
WorkingDirectory=Рабочая директория|4|2
Description=Комментарий|4|2
*Icon=Иконка ярлыка|4|2
Param=Параметры запуска|4|2

pas (shortcut.pas)

#pas
unit shortcut;

interface

uses windows;

procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);

implementation

const
CLSID_ShellLink: TGUID = ( D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IShellLinkA: TGUID = ( D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));

type
_SHITEMID = record
cb: Word;
abID: array[0..0] of Byte;
end;
TSHItemID = _SHITEMID;
SHITEMID = _SHITEMID;
PItemIDList = ^TItemIDList;
_ITEMIDLIST = record
mkid: TSHItemID;
end;
TItemIDList = _ITEMIDLIST;

IShellLink = interface(IUnknown) { sl }
['{000214EE-0000-0000-C000-000000000046}']
function GetPath(pszFile: PAnsiChar; cchMaxPath: Integer;
var pfd: TWin32FindData; fFlags: DWORD): HResult; stdcall;
function GetIDList(var ppidl: PItemIDList): HResult; stdcall;
function SetIDList(pidl: PItemIDList): HResult; stdcall;
function GetDescription(pszName: PAnsiChar; cchMaxName: Integer): HResult; stdcall;
function SetDescription(pszName: PAnsiChar): HResult; stdcall;
function GetWorkingDirectory(pszDir: PAnsiChar; cchMaxPath: Integer): HResult; stdcall;
function SetWorkingDirectory(pszDir: PAnsiChar): HResult; stdcall;
function GetArguments(pszArgs: PAnsiChar; cchMaxPath: Integer): HResult; stdcall;
function SetArguments(pszArgs: PAnsiChar): HResult; stdcall;
function GetHotkey(var pwHotkey: Word): HResult; stdcall;
function SetHotkey(wHotkey: Word): HResult; stdcall;
function GetShowCmd(out piShowCmd: Integer): HResult; stdcall;
function SetShowCmd(iShowCmd: Integer): HResult; stdcall;
function GetIconLocation(pszIconPath: PAnsiChar; cchIconPath: Integer;
out piIcon: Integer): HResult; stdcall;
function SetIconLocation(pszIconPath: PAnsiChar; iIcon: Integer): HResult; stdcall;
function SetRelativePath(pszPathRel: PAnsiChar; dwReserved: DWORD): HResult; stdcall;
function Resolve(Wnd: HWND; fFlags: DWORD): HResult; stdcall;
function SetPath(pszFile: PAnsiChar): HResult; stdcall;
end;

type
IPersist = interface(IUnknown)
['{0000010C-0000-0000-C000-000000000046}']
function GetClassID(out classID: TGUID): HResult; stdcall;
end;

IPersistFile = interface(IPersist)
['{0000010B-0000-0000-C000-000000000046}']
function IsDirty: HResult; stdcall;
function Load(pszFileName: PWideChar; dwMode: Longint): HResult;
stdcall;
function Save(pszFileName: PWideChar; fRemember: BOOL): HResult;
stdcall;
function SaveCompleted(pszFileName: PWideChar): HResult;
stdcall;
function GetCurFile(out pszFileName: PWideChar): HResult;
stdcall;
end;

procedure CoUninitialize; stdcall; external 'ole32.dll' name 'CoUninitialize';
function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll' name 'CoInitialize';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown; dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall; external 'ole32.dll' name 'CoCreateInstance';

procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);
var
Obj: IUnknown;
begin
Coinitialize(nil);
if CoCreateInstance(CLSID_ShellLink, nil, 1 or 4, IID_IShellLinkA, Obj) = 0 then
begin
(Obj as IShellLink).SetPath(Name);
(Obj as IShellLink).SetWorkingDirectory(wd);
(Obj as IShellLink).SetDescription(d);
(Obj as IShellLink).SetIconLocation(Icon, 0);
(Obj as IShellLink).SetArguments(Param);
(Obj as IPersistFile).Save(PWChar(WideString(LinkName)), FALSE);
end;
CoUninitialize;
end;

end.

pas (hiShortCut.pas)

#pas
unit hiShortcut;

interface

uses Kol,Share,Debug,shortcut;

type
THIShortCut = class(TDebug)
private
public
_prop_FileName:string;
_prop_ShortcutName:string;
_prop_WorkingDirectory:string;
_prop_Description:string;
_prop_Icon:string;
_prop_Param:string;

_event_onCreate:THI_Event;

_data_FileName:THI_Event;
_data_ShortcutName:THI_Event;
_data_WorkingDirectory:THI_Event;
_data_Description:THI_Event;
_data_Icon:THI_Event;
_data_Param:THI_Event;

procedure _work_doCreate(var _Data:TData; Index:word);
end;

implementation

procedure THIShortCut._work_doCreate;
begin
CreateLink( PChar(ReadString(_Data,_data_FileName,_prop_FileName)),
PChar(ReadString(_Data,_data_ShortcutName,_prop_ShortcutName)),
PChar(ReadString(_Data,_data_WorkingDirectory,_prop_WorkingDirectory)),
PChar(ReadString(_Data,_data_Param,_prop_Param)),
PChar(ReadString(_Data,_data_Description,_prop_Description)),
PChar(ReadString(_Data,_data_Icon,_prop_Icon)));
_hi_onEvent(_event_onCreate);
end;

end.

HELP!!!
------------ Дoбавленo в 17.19:
Всё, сделал!
Каму нада забираем!

Shortcut.ini

#ini
[About]
Version=1.1
Author=Amper
Mail=amper@xaker.ru

[Type]
Class=Element
Info=Создание ярлыков файлов
Tab=Files

[Property]
FileName=Имя файла для создания ярлыка|2|
Param=Параметры запуска|2|
ShortcutName=Имя создаваемого ярлыка|2|
WorkingDirectory=Рабочая директория|2|
Description=Комментарий|2|
Icon=Иконка ярлыка|2|

[Methods]
doCreate=Создает ярлык|1|0
onCreate=Событие происходит при создании ярлыка|2|0
FileName=Имя файла для создания ярлыка|4|2
Param=Параметры запуска|4|2
ShortcutName=Имя создаваемого ярлыка|4|2
WorkingDirectory=Рабочая директория|4|2
Description=Комментарий|4|2
*Icon=Иконка ярлыка|4|2

shortcut.pas

#pas

[/counit shortcut;

interface

uses windows;

procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);

implementation

const
CLSID_ShellLink: TGUID = ( D1:$00021401; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IShellLinkA: TGUID = ( D1:$000214EE; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));

type
_SHITEMID = record
cb: Word;
abID: array[0..0] of Byte;
end;
TSHItemID = _SHITEMID;
SHITEMID = _SHITEMID;
PItemIDList = ^TItemIDList;
_ITEMIDLIST = record
mkid: TSHItemID;
end;
TItemIDList = _ITEMIDLIST;

IShellLink = interface(IUnknown) { sl }
['{000214EE-0000-0000-C000-000000000046}']
function GetPath(pszFile: PAnsiChar; cchMaxPath: Integer;
var pfd: TWin32FindData; fFlags: DWORD): HResult; stdcall;
function GetIDList(var ppidl: PItemIDList): HResult; stdcall;
function SetIDList(pidl: PItemIDList): HResult; stdcall;
function GetDescription(pszName: PAnsiChar; cchMaxName: Integer): HResult; stdcall;
function SetDescription(pszName: PAnsiChar): HResult; stdcall;
function GetWorkingDirectory(pszDir: PAnsiChar; cchMaxPath: Integer): HResult; stdcall;
function SetWorkingDirectory(pszDir: PAnsiChar): HResult; stdcall;
function GetArguments(pszArgs: PAnsiChar; cchMaxPath: Integer): HResult; stdcall;
function SetArguments(pszArgs: PAnsiChar): HResult; stdcall;
function GetHotkey(var pwHotkey: Word): HResult; stdcall;
function SetHotkey(wHotkey: Word): HResult; stdcall;
function GetShowCmd(out piShowCmd: Integer): HResult; stdcall;
function SetShowCmd(iShowCmd: Integer): HResult; stdcall;
function GetIconLocation(pszIconPath: PAnsiChar; cchIconPath: Integer;
out piIcon: Integer): HResult; stdcall;
function SetIconLocation(pszIconPath: PAnsiChar; iIcon: Integer): HResult; stdcall;
function SetRelativePath(pszPathRel: PAnsiChar; dwReserved: DWORD): HResult; stdcall;
function Resolve(Wnd: HWND; fFlags: DWORD): HResult; stdcall;
function SetPath(pszFile: PAnsiChar): HResult; stdcall;
end;

type
IPersist = interface(IUnknown)
['{0000010C-0000-0000-C000-000000000046}']
function GetClassID(out classID: TGUID): HResult; stdcall;
end;

IPersistFile = interface(IPersist)
['{0000010B-0000-0000-C000-000000000046}']
function IsDirty: HResult; stdcall;
function Load(pszFileName: PWideChar; dwMode: Longint): HResult;
stdcall;
function Save(pszFileName: PWideChar; fRemember: BOOL): HResult;
stdcall;
function SaveCompleted(pszFileName: PWideChar): HResult;
stdcall;
function GetCurFile(out pszFileName: PWideChar): HResult;
stdcall;
end;

procedure CoUninitialize; stdcall; external 'ole32.dll' name 'CoUninitialize';
function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll' name 'CoInitialize';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown; dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall; external 'ole32.dll' name 'CoCreateInstance';

procedure CreateLink(const Name, LinkName,wd,d,Param,icon: pchar);
var
Obj: IUnknown;
begin
Coinitialize(nil);
if CoCreateInstance(CLSID_ShellLink, nil, 1 or 4, IID_IShellLinkA, Obj) = 0 then
begin
(Obj as IShellLink).SetPath(Name);
(Obj as IShellLink).SetArguments(Param);
(Obj as IShellLink).SetWorkingDirectory(wd);
(Obj as IShellLink).SetDescription(d);
(Obj as IShellLink).SetIconLocation(Icon, 0);
(Obj as IPersistFile).Save(PWChar(WideString(LinkName)), FALSE);
end;
CoUninitialize;
end;

end.

hiShortCut.pas

#pas
unit hiShortcut;

interface

uses Kol,Share,Debug,shortcut;

type
THIShortCut = class(TDebug)
private
public
_prop_FileName:string;
_prop_Param:string;
_prop_ShortcutName:string;
_prop_WorkingDirectory:string;
_prop_Description:string;
_prop_Icon:string;

_event_onCreate:THI_Event;

_data_FileName:THI_Event;
_data_Param:THI_Event;
_data_ShortcutName:THI_Event;
_data_WorkingDirectory:THI_Event;
_data_Description:THI_Event;
_data_Icon:THI_Event;

procedure _work_doCreate(var _Data:TData; Index:word);
end;

implementation

procedure THIShortCut._work_doCreate;
begin
CreateLink( PChar(ReadString(_Data,_data_FileName,_prop_FileName)),
PChar(ReadString(_Data,_data_ShortcutName,_prop_ShortcutName)),
PChar(ReadString(_Data,_data_WorkingDirectory,_prop_WorkingDirectory)),
PChar(ReadString(_Data,_data_Description,_prop_Description)),
PChar(ReadString(_Data,_data_Param,_prop_Param)),
PChar(ReadString(_Data,_data_Icon,_prop_Icon)));
_hi_onEvent(_event_onCreate);
end;

end.
------------ Дoбавленo в 22.49:
Dilma, спасибо за помощь!
карма: 1
0
7
Сообщение
...
Прикрепленные файлы
(файлы не залиты)