HiAsm

Форумы Новые компоненты Чё не так? (проблема с добовленимем точки SetArguments) ← Ctrl1Ctrl →

Ответов: 1841

Рейтинг: 369

#1: 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

Альтернативная сборка HiAsm 4.

Форумы Новые компоненты Чё не так? (проблема с добовленимем точки SetArguments) ← Ctrl1Ctrl →