Vitalonic - исходники

главная >> исходники >> ответы на вопросы

последнее обновление 21.01.04

Ссылки		Вопросы
Написать мне письмо Гостевая книга		Пожалуйста, учтите, что приводимый код написан под библиотеку KOL и, как правило, не может быть использован в стандартных программах Delphi (т.е. программ под VCL) без некоторой переделки (подробнее об этом на главной странице). Все ссылки на первоисточники по возможности сохранены. Как программно создать ярлык? Как узнать местонахождение папок "Рабочий стол" и "Пуск" Windows? Как поместить в ресурс программы какие-нибудь файлы, а потом извлечь их во время выполнения? Как пролистать многострочный редактор к нужному месту?

Ответы

Как программно создать ярлык?

Покопавшись в интернете, понял, что лучше всего это делать с использованием библиотеки ShlObj, которая к тому же просит подключить еще и ActiveX (источник здесь, я только немного подредактировал эту функцию). Однако, эти две библиотеки не сильно увеличивают размер программы, потому привожу здесь саму процедуру, создающую ярлык в указанной папке.


uses ShlObj, ActiveX;

procedure CreateLnk(FilePath, Folder, ShortCut, Description: PChar);
var
  ShellLink: IShellLink;
  hRes: HRESULT;
  PersistFile: IPersistFile;
const
IID_IPersistFile: TGUID = (
  D1:$0000010B;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
begin
  CoInitialize(nil);
  hRes := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLinkA, ShellLink);
  if SUCCEEDED(hRes) then
  begin
    ShellLink.SetPath(FilePath);
    ShellLink.SetDescription(Description);
    hRes := ShellLink.QueryInterface(IID_IPersistFile, PersistFile);
    if SUCCEEDED(hRes) then
    begin
      PersistFile.Save(PWideChar(WideString(string(Folder) + ShortCut)), True);
      PersistFile := nil;
    end;
    ShellLink := nil;
  end;
  CoUninitialize;
end;

Исходник программы, демонстрирующий все описанное, забирайте здесь

наверх

Как узнать местонахождение папок "Рабочий стол" и "Пуск" Windows?

Полазив по реестру, можно найти эти ключи, общие для систем 98/2000/XP (за остальные не ручаюсь). Кусочек кода приведен здесь:


var  Key:HKey;
       Desktop_Location:string;
begin
   Key:=RegKeyOpenRead(HKEY_CURRENT_USER, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders');
   Desktop_Location:=RegKeyGetStr(Key,'Desktop');
   RegKeyClose(Key);
end;

Соответсвенно, для получения местонахождения папки "Пуск" нужно заменить одну строчку на эту:


Start_location:=RegKeyGetStr(Key,'Programs');

наверх

Как поместить в ресурс программы какие-нибудь файлы, а потом извлечь их во время выполнения?

Этот вопрос из области написания инсталляторов, как и два предыдущих.
Сначала надо эти файлы в ресурс запихнуть. Делается это так: нужно создать файл с расширением *.rc, написать в нем что-то типа:
NAME1 RCDATA "FileName1"
NAME2 RCDATA "FileName2"
...
где NAME - то, как файл будет называться в ресурсе (с расширением!), а FileName1 - собственно сам файл
Потом нужно откомпилировать с помощью утилиты brc32.exe, которая лежит где-то в каталоге Delphi, выполнив команду
>brc32.exe Имя_файла.rc
Если все прошло удачно, на диске появится файл Имя_файла.res, который собственно и нужно прописать в ресурсе (идем Project|View Source и делаем там такую строчку)
{$R Имя_файла.res}
Осталось только написать кусок программы, который будет это вытаскивать из ресурса.


Var
   MyStream:PStream;
begin
  MyStream := NewWriteFileStream(GetStartDir+'FileName1');
  Resource2Stream(PicStream,HInstance,'Name1',RT_RCDATA);
  MyStream.free;
end;

В приведенном примере первый файл помещается в папку, из которой запущена программа. Аналогично можно вытянуть второй и последующие файлы.
Однако, чтобы не увеличивать зря размер программы, гораздо интереснее файлы сначала упаковать, воспользовавшись библиотечкой типа ZLib, а потом распаковать при записи на диск. В этом случае в ресурс нужно помещать уже запакованные файлы. Сама процедура распаковки потребует некоторых усложнений:


uses KOLZLib;
function StreamCopy (Dest, Source: PStream; Count: DWord): DWord;
const
  MAXBUFSIZE = $80000;
var
  BufSize: DWord;
  Readed: DWord;
  Buffer: PChar;
  Need: DWord;
begin
  If Count=0 then begin
    Source.Position:=0;
    Count:=Source.Size;
  end;
  Result:=0;
  If Count>MAXBUFSIZE then BufSize:=MAXBUFSIZE else BufSize:=Count;
  GetMem(Buffer, BufSize);
  try 
    repeat
      If Count>BufSize then Need:=BufSize else Need:=Count;
      Readed:=Source.Read (Buffer^, Need);
      If Readed=STRM_ERROR then Exit;
      If Dest.Write (Buffer^, Readed)=STRM_ERROR then Exit;
      Dec(Count, Readed);
      Inc (Result, Readed);
    until (Count=0) or (Readed=0) or (Readed=STRM_ERROR);
  finally  
    FreeMem(Buffer, BufSize);
  end;
end;

procedure unpack(Dir:string);
const
  STRM_ERROR = DWord (-1);
var
  Source: PStream;
  Dest: PStream;
  Zipper: PStream;
  Size: DWord;
begin  
 Source := NewMemoryStream;
 Resource2Stream(Source,HInstance,'Name1',RT_RCDATA);
 Source.Position:=0;
 Dest:=NewWriteFileStream (Dir+'FileName1');
 Source.Read(Size, 4);
 NewZLibDStream (Zipper, Source, nil);
 StreamCopy (Dest, Zipper, Size);
 Zipper.Free;
 Dest.Free;
 Source.Free;
end;

Здесь FileName1 - это имя уже распакованного файла, т.е. так, как он должен выглядеть на диске
Эту функцию я почти целиком списал с примера, который идет вместе с библиотекой KOLZlib, убрав только обработку исключений (если она нужна, можно легко ее вернуть).

наверх

Как пролистать многострочный редактор к нужному месту?

Допустим, в редакторе типа Memo находится большой кусок текста, так что весь он не умещается в окне редактора и нужно пользоваться скролингом. А как программно прокрутить редактор к нужному месту? Придется немного повозиться с WindowsAPI:

Memo.Perform(WM_VSCROLL, Memo.Perform(EM_LINEFROMCHAR,symbol,0)*65536+SB_THUMBPOSITION,0);

Здесь symbol - номер символа, к которому осуществляется прокрутка. В этом примере использованы две вложенные API-функции: внутренняя определяет строчку, в которой находится соответсвующий символ, а внешняя прокручивает редактор к этой строчке.

наверх