nyuuzyou/wikis huggingface dataset:
Как выяснить номер версии Oracle?

=== Как выяснить номер версии Oracle? ===
This function gets the connected Oracle version. It returns the version info in 3 OUT parameters.
 VerNum: double eg. 7.23
 VerStrShort: string eg. '7.2.3.0.0'
 VerStrLong: string eg. 'Oracle7 Server Release 7.2.3.0.0 - Production Release'
I have tested it with Oracle 7.2 and 8.17. I assume it should work for the others (not too sure about Oracle 9 though). Any feedback and fixes for different versions would be appreciated.
The TQuery parameter that it recieves is a TQuery component that is connected to an open database connection.
Example : 
var
 VNum: double;
 VShort: string;
 VLong: string;
begin
 GetOraVersion(MySql, VNum, VShort, VLong);
 Label1.Caption := FloatToStr(VNum);
 Label2.Caption := VShort;
 Label3.Caption := VLong;
end;
procedure GetOraVersion(Query: TQuery;
 out VerNum: double;
 out VerStrShort: string;
 out VerStrLong: string);
var
 sTmp: string;
 cKey: char;
 i: integer;
begin
 Query.SQL.Text := 'select banner from v$version ' +
 'where banner like ' + QuotedStr('Oracle%');
 Query.Open;
 if not Query.Eof then
 VerStrLong := Query.Fields[0].AsString
 else
 begin
 // Don't know this version
 VerStrLong := '?';
 VerNum := 0.0;
 VerStrShort := '?.?.?.?';
 end;
 Query.Close;
 if VerStrLong <> '?' then
 begin
 cKey := VerStrLong[7]; // eg. Oracle7 or Oracle8i
 VerStrLong[7] := 'X'; // Mask it out
 sTmp := copy(VerStrLong, pos(cKey, VerStrLong), 1024);
 VerStrShort := copy(sTmp, 1, pos(' ', sTmp) - 1);
 sTmp := copy(VerStrShort, 1, pos('.', VerStrShort));
 for i := length(sTmp) + 1 to length(VerStrShort) do
 begin
 if VerStrShort[i] <> '.' then
 sTmp := sTmp + VerStrShort[i];
 end;
 VerNum := StrToFloat(sTmp);
 VerStrLong[7] := cKey; // Put correct character back
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02723
Как выяснить установлены ли в системе шрифты TrueType

=== Как выяснить установлены ли в системе шрифты TrueType ===
function IsTrueTypeInstalled: bool;
var
 {$IFDEF WIN32}
 rs: TRasterizerStatus;
 {$ELSE}
 rs: TRasterizer_Status;
 {$ENDIF}
begin
 Result := False;
 if not GetRasterizerCaps(rs, SizeOf(rs)) then
 exit;
 if (rs.WFlags and TT_AVAILABLE) <> TT_AVAILABLE then
 exit;
 if (rs.WFlags and TT_ENABLED) <> TT_ENABLED then
 exit;
 Result := True;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01923
Как гарантированно сделать backup?

=== Как гарантированно сделать backup? ===
Как гарантированно сделать backup/restore БД InterBase с опцией 'Replace existing database' и записями протоколов в файлы с гарантированным отстрелом пользователей?
Att.bat:
 at 01:00 /INTERACTIVE "e:\IB_DATA\BR.BAT"
BR.bat:
 del e:\IB_DATA\b.txt
 del e:\IB_DATA\r.txt
 del e:\ib_data\AR_IB.PRV
 del e:\IB_DATA\AR_IB.GBK
 d:\ib_42\bin\gfix -shut -force 1 e:\ib_data\AR_IB.GDB -user "SYSDBA" -password "oooo"
 net stop "InterBase Server"
 copy e:\ib_data\AR_IB.GDB e:\ib_data\AR_IB.PRV
 net start "InterBase Server"
 d:\ib_42\bin\gbak e:\ib_data\AR_IB.GDB e:\ib_data\AR_IB.GBK -user "SYSDBA" -password "oooo" -B -L -Y "e:\IB_DATA\b.txt"
 d:\ib_42\bin\gbak e:\ib_data\AR_IB.GBK e:\ib_data\AR_IB.GDB -user "SYSDBA" -password "oooo" -P 4096 -V -R -Y "e:\IB_DATA\r.txt"
Author: Sergey Klochkovski
Source: Взято с http://delphiworld.narod.ru
ID: 02910
Category:Базы данных
Category:Interbase
Как глобально перехватить нажатие кнопки PrintScreen?

=== Как глобально перехватить нажатие кнопки PrintScreen? ===
В примере для глобального перехвата нажатия клавиши print screen регистрируется горячая клавиша (hot key). 
type
 TForm1 = class(TForm)
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 { Private declarations }
 procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
const id_SnapShot = 101;
procedure TForm1.WMHotKey (var Msg: TWMHotKey);
begin
 if Msg.HotKey = id_SnapShot then
 ShowMessage('GotIt');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 RegisterHotKey(Form1.Handle, id_SnapShot, 0, VK_SNAPSHOT);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 UnRegisterHotKey (Form1.Handle, id_SnapShot);
end;
 
ID: 01506
Как динамически прочитать информацию о классе

=== Как динамически прочитать информацию о классе ===
procedure TForm1.FormCreate(Sender: TObject);
begin
 { This only works for classes registered using RegisterClass }
 RegisterClasses([TButton, TForm]);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 CRef: TPersistentClass;
 PTI: PTypeInfo;
 AControl: TControl;
begin
 CRef := GetClass('TButton');
 if CRef <> nil then
 begin
 AControl := TControl(TControlClass(CRef).Create(Self));
 with AControl do
 begin
 Parent := Self;
 Width := 50;
 Height := 30;
 end;
 Inc(Id);
 end
 else
 MessageDlg('No such class', mtWarning, [mbOk], 0);
end;
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00288
Как добавить Cookies?

Пример демонстрирует создание cookie посредствам стандартного компонента Delphi
procedure TwebDispatcher.WebAction(Sender: TObject; Request: TWebRequest;
 Response: TWebResponse; var Handled: Boolean);
begin
 with (Response.Cookies.Add) do
 begin
 Name := 'TESTNAME';
 Value := 'TESTVALUE';
 Secure := False;
 Expires := Now;
 Response.Cookies.WebResponse.SendResponse;
 end;
end;
Source: http://forum.sources.ru
ID: 03507
Category:Связь
Category:Web
Как добавить TCheckBox в TStringGrid?

=== Как добавить TCheckBox в TStringGrid? ===
Пример демонстрирует добавление любого количества чекбоксов в StringGrid. В этом примере необходимо добавить TPanel, а в саму панель включить TstringGrid. Так же необходимо добавить невидимый TcheckBox на форму. Затем добавьте 5 колонок и 4 строки в объект StringGrid.
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
 ShowMessage('There it is!!');
end;
// Заполняем заголовок StringGrid
procedure TForm1.FormCreate(Sender: TObject);
begin
 StringGrid1.Cells[0, 0] := 'A Simple';
 StringGrid1.Cells[1, 0] := 'Way';
 StringGrid1.Cells[2, 0] := 'To';
 StringGrid1.Cells[3, 0] := 'Do It';
 StringGrid1.Cells[4, 0] := 'Check !!';
 AddCheckBoxes; // добавляем чекбоксы...
end;
procedure TForm1.AddCheckBoxes;
var
 i: Integer;
 NewCheckBox: TCheckBox;
begin
 clean_previus_buffer; // очищаем неиспользуемые чекбоксы...
 for i := 1 to 4 do
 begin
 StringGrid1.Cells[0, i] := 'a';
 StringGrid1.Cells[1, i] := 'b';
 StringGrid1.Cells[2, i] := 'c';
 StringGrid1.Cells[3, i] := 'd';
 NewCheckBox := TCheckBox.Create(Application);
 NewCheckBox.Width := 0;
 NewCheckBox.Visible := False;
 NewCheckBox.Caption := 'OK';
 NewCheckBox.Color := clWindow;
 NewCheckBox.Tag := i;
 NewCheckBox.OnClick := CheckBox1.OnClick; // Связываем предыдущее событие OnClick
 // с существующим TCheckBox
 NewCheckBox.Parent := Panel1;
 StringGrid1.Objects[4, i] := NewCheckBox;
 StringGrid1.RowCount := i;
 end;
 set_checkbox_alignment; // расположение чекбоксов в ячейках таблицы...
end;
procedure TForm1.clean_previus_buffer;
var
 NewCheckBox: TCheckBox;
 i: Integer;
begin
 for i := 1 to StringGrid1.RowCount do
 begin
 NewCheckBox := (StringGrid1.Objects[4, i] as TCheckBox);
 if NewCheckBox <> nil then
 begin
 NewCheckBox.Visible := False;
 StringGrid1.Objects[4, i] := nil;
 end;
 end;
end;
procedure TForm1.set_checkbox_alignment;
var
 NewCheckBox: TCheckBox;
 Rect: TRect;
 i: Integer;
begin
 for i := 1 to StringGrid1.RowCount do
 begin
 NewCheckBox := (StringGrid1.Objects[4,i] as TCheckBox);
 if NewCheckBox <> nil then
 begin
 Rect := StringGrid1.CellRect(4,i); // получаем размер ячейки для чекбокса
 NewCheckBox.Left := StringGrid1.Left + Rect.Left+2;
 NewCheckBox.Top := StringGrid1.Top + Rect.Top+2;
 NewCheckBox.Width := Rect.Right - Rect.Left;
 NewCheckBox.Height := Rect.Bottom - Rect.Top;
 NewCheckBox.Visible := True;
 end;
 end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
begin
 if not (gdFixed in State) then set_checkbox_alignment;
end;
Source: Взято из http://forum.sources.ru
ID: 00381
Как добавить True Type шрифт в систему?

=== Как добавить True Type шрифт в систему? ===
Чтобы установить шрифт в систему, необходимо скопировать файл шрифта в 'Windows\Fonts' и добавить ключ в реестр: 
 Software\Microsoft\Windows\CurrentVersion\Fonts
Этот ключ указывает на файл шрифта. Далее запускаем API функцию 'AddFontRecource'. В заключении нужно уведомить систему широковещательным сообщением. 
uses Registry; 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 hReg: TRegistry; 
 hBool : bool; 
begin 
 CopyFile('C:\DOWNLOAD\FP000100.TTF', 
 'C:\WINDOWS\FONTS\FP000100.TTF', hBool); 
 hReg := TRegistry.Create; 
 hReg.RootKey := HKEY_LOCAL_MACHINE; 
 hReg.LazyWrite := false; 
 hReg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Fonts', 
 false); 
 hReg.WriteString('TESTMICR (TrueType)','FP000100.TTF'); 
 hReg.CloseKey; 
 hReg.free; 
 // Добавляем ресурс шрифта
 AddFontResource('c:\windows\fonts\FP000100.TTF'); 
 SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); 
 // Убираем блокировку ресурса
 RemoveFontResource('c:\windows\fonts\FP000100.TTF'); 
 SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); 
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01922
Как добавить альтернативный текст картинки в WebBrowser?

{ Alternative Text for a image of a TWebBrowser }
procedure TForm1.Button1Click(Sender: TObject);
var
 HTMLDocument2Ifc: IHTMLDocument2;
 HTMLSelectionObjectIfc: IHTMLSelectionObject;
 HTMLTxtRangeIfc: IHTMLTxtRange;
begin
 HTMLDocument2Ifc := WebBrowser1.Document as IHTMLDocument2;
 HTMLDocument2Ifc.execCommand('InsertImage', False, );
 HTMLSelectionObjectIfc := HTMLDocument2Ifc.selection;
 if HTMLSelectionObjectIfc.type_ = 'Control' then HTMLSelectionObjectIfc.Clear;
 HTMLTxtRangeIfc := HTMLSelectionObjectIfc.createRange as IHTMLTxtRange;
 HTMLTxtRangeIfc.pasteHTML('<image alt="Hello" src="c:\test.gif"> ');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03494
Category:Связь
Category:WebBrowser
Как добавить горизонтальную полосу прокрутки (scrollbar) в TListBox?

=== Как добавить горизонтальную полосу прокрутки (scrollbar) в TListBox? ===
В Delphi компонент TListBox автоматически включает в себя вертикальный scrollbar. Полоска прокрутки появляется в том случае, если все элементы списка не помещаются в видимую область списка. Однако, list box не показывает горизонтального скролбара, когда ширина элементов превышает ширину списка. Конечно же существует способ добавить горизонтальную полосу прокрутки.
Добавьте следующий код в событие Вашей формы OnCreate.
procedure TForm1.FormCreate(Sender: TObject); 
var 
 i, MaxWidth: integer; 
begin 
 MaxWidth := 0; 
 for i := 0 to LB1.Items.Count - 1 do 
 if MaxWidth < LB1.Canvas.TextWidth(LB1.Items.Strings[i]) then 
 MaxWidth := LB1.Canvas.TextWidth(LB1.Items.Strings[i]); 
 SendMessage(LB1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0); 
end; 
Приведённый код определяет ширину в пикселях самой длинной строки списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT, чтобы установить ширину горизонтального скролбара в пикселях. Два дополнительных пикселя добавленные к MaxWidth служат для стрелки в правом углу list box-а.
Source: Взято из http://forum.sources.ru
ID: 00647
Как добавить группу в Program Manager

interface
procedure CreateGroup;
implementation
{ Для установки группы в Program Manager используем компонент TProgMan }
procedure TSetupForm.CreateGroup;
var
 ItemList: TStringList;
 GroupName: string;
 ItemName: string;
 i: word;
begin
 { Получаем из INI-файла строку GroupName }
 GroupName := IniFile.ReadString('General', 'PMGroup', );
 { Если один есть, устанавливаем группу }
 if GroupName <> then
 begin
 ItemList := TStringList.Create;
 try
 { читаем элементы для установки }
 IniFile.ReadSectionValues('PMGroup', ItemList);
 with TProgMan.Create(Self) do
 try
 CreateGroup(GroupName);
 for i := 0 to ItemList.Count - 1 do
 begin
 { получаем имя файла }
 ItemName := Copy(ItemList.Strings[i], 1, Pos('=', ItemList.Strings[i]) - 1);
 { прибавляем путь к имени файла и добавляем элемент }
 AddItem(GetTarget(ItemList.Values[ItemName][1]) + ItemName, ItemName);
 end;
 finally
 Free;
 end;
 finally
 ItemList.Free;
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 04500
Category:DDE
Как добавить документ в меню Пуск → Документы?

=== Как добавить документ в меню Пуск -> Документы? ===
Используйте функцию SHAddToRecentDocs.
uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
var
 s: string;
begin
 s := 'C:\DownLoad\ntkfaq.html';
 SHAddToRecentDocs(SHARD_PATH, PChar(s));
end;
Source: Взято из http://forum.sources.ru
ID: 01664
Как добавить кнопку?

=== Как добавить кнопку? ===
type
 TConnType = (COM_OBJECT, EXPLORER_BAR, SCRIPT, EXECUTABLE);
function AddBandToolbarBtn(Visible: Boolean; ConnType: TConnType;
 BtnText, HotIcon, Icon, GuidOrPath: string): string;
var
 GUID: TGUID;
 Reg: TRegistry;
 ID: string;
begin
 CreateGuid(GUID);
 ID := GuidToString(GUID);
 Reg := TRegistry.Create;
 with Reg do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('\Software\Microsoft\Internet Explorer\Extensions\' + ID, True);
 if Visible then
 WriteString('Default Visible', 'Yes')
 else
 WriteString('Default Visible', 'No');
 WriteString('ButtonText', BtnText);
 WriteString('HotIcon', HotIcon);
 WriteString('Icon', Icon);
 case ConnType of
 COM_OBJECT:
 begin
 WriteString('CLSID', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
 WriteString('ClsidExtension', GuidOrPath);
 end;
 EXPLORER_BAR:
 begin
 WriteString('CLSID', '{E0DD6CAB-2D10-11D2-8F1A-0000F87ABD16}');
 WriteString('BandCLSID', GuidOrPath);
 end;
 EXECUTABLE:
 begin
 WriteString('CLSID', '{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
 WriteString('Exec', GuidOrPath);
 end;
 SCRIPT:
 begin
 WriteString('CLSID', '{1FBA04EE-3024-11D2-8F1F-0000F87ABD16}');
 WriteString('Script', GuidOrPath);
 end;
 end;
 CloseKey;
 OpenKey('\Software\IE5Tools\ToolBar Buttons\', True);
 WriteString(BtnText, ID);
 CloseKey;
 finally
 Free;
 end;
 Result := ID;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02388
Как добавить кнопку в панель инструментов IE?

:1. ButtonText = Всплывающая подсказка к кнопке
:2. MenuText = Текст, который будет использован для пункта в меню "Сервис"
:3. MenuStatusbar = *Ignore*
:4. CLSID = Ваш уникальный classID. Для создания нового CLSID (для каждой кнопки) можно использовать GUIDTOSTRING.
:5. Default Visible := Показать ей.
:6. Exec := Путь к Вашей программе.
:7. Hoticon := иконка из shell32.dll когда мышка находится над кнопкой
:8. Icon := иконка из shell32.dll
procedure CreateExplorerButton;
const
 TagID = '\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\';
var
 Reg: TRegistry;
ProgramPath: string;
 RegKeyPath: string;
begin
 ProgramPath := 'c:\folder\exename.exe';
 Reg := TRegistry.Create;
 try
 with Reg do
 begin
 RootKey := HKEY_LOCAL_MACHINE;
 RegKeyPath := 'Software\Microsoft\Internet Explorer\Extensions';
 OpenKey(RegKeyPath + TagID, True);
 WriteString('ButtonText', 'Your program Button text');
 WriteString('MenuText', 'Your program Menu text');
 WriteString('MenuStatusBar', 'Run Script');
 WriteString('ClSid', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
 WriteString('Default Visible', 'Yes');
 WriteString('Exec', ProgramPath);
 WriteString('HotIcon', ',4');
 WriteString('Icon', ',4');
 end;
 finally
 Reg.CloseKey;
 Reg.Free;
 end;
end;
После выполнения этого кода достаточно просто запустить IE.
Source: http://forum.sources.ru
ID: 03499
Category:Связь
Category:WebBrowser
Как добавить копию текущей записи?

=== Как добавить копию текущей записи? ===
Следующая функция добавит в конец данных точную копию текущей записи.
procedure AppendCurrent(Dataset: TDataset);
var
 aField: Variant ;
 i: Integer ;
begin
 // Создаём массив
 aField := VarArrayCreate([0, DataSet.Fieldcount-1], VarVariant);
 // считываем значения в массив
 for i := 0 to (DataSet.Fieldcount-1) do
 aField[i] := DataSet.fields[i].Value ;
 DataSet.Append ;
 // помещаем значения массива в новую запись
 for i := 0 to (DataSet.Fieldcount-1) do
 DataSet.Fields[i].Value := aField[i] ;
end;
Примечания Vit:
* Если таблица имеет ключевые поля или уникальные индексы данный код приведёт к ошибке "Key violation"
Source: Взято из http://forum.sources.ru
ID: 02550
Как добавить нужный язык в систему

=== Как добавить нужный язык в систему ===
Для этого необходимо изменить некоторые ключи в реестре. Например, необходимо добавить Туркменский язык. Конечно, Вам необходимо иметь файл KBD с раскладкой клавиатуры (Turkmen.kbd). 
procedure TTMKBD.OkClick(Sender: TObject);
var
 reg: TRegistry;
 srs, dst: string;
begin
 Reg := TRegistry.Create;
 with Reg do
 try
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('\System\CurrentControlSet\Control\keyboard layouts\00000405', True);
 WriteString('layout file', 'Turkmen.kbd');
 WriteString('layout text', 'Turkmen');
 OpenKey('\System\CurrentControlSet\Control\Nls\Locale', True);
 WriteString('00000405', 'Turkmen');
 CloseKey;
 finally
 Free;
 end;
 srs := 'Turkmen.kbd';
 dst := 'c:\windows\system\Turkmen.kbd';
 FileCopy(srs, dst);
 ShowMessage('Well Done it all');
 Close;
end;
Source: http://delphiworld.narod.ru/
ID: 01977
Как добавить пароль к таблице

=== Как добавить пароль к таблице ===
uses
 Bde, SysUtils, dbtables, windows;
function StrToOem(const AnsiStr: string): string;
begin
 SetLength(Result, Length(AnsiStr));
 if Length(Result) 0 then
 CharToOem(PChar(AnsiStr), PChar(Result));
end;
function TablePasswort(var Table: TTable; password: string): Boolean;
var
 pTblDesc: pCRTblDesc;
 hDb: hDBIDb;
begin
 Result := False;
 with Table do
 begin
 if Active and (not Exclusive) then Close;
 if (not Exclusive) then Exclusive := True;
 if (not Active) then Open;
 hDB := DBHandle;
 Close;
 end;
 GetMem(pTblDesc, SizeOf(CRTblDesc));
 FillChar(pTblDesc^, SizeOf(CRTblDesc), 0);
 with pTblDesc^ do
 begin
 StrPCopy(szTblName, StrToOem(Table.TableName));
 szTblType := szParadox;
 StrPCopy(szPassword, StrToOem(Password));
 bPack := True;
 bProtected := True;
 end;
 if DbiDoRestructure(hDb, 1, pTblDesc, nil, nil, nil, False) DBIERR_NONE then Exit;
 if pTblDesc nil then FreeMem(pTblDesc, SizeOf(CRTblDesc));
 Result := True;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02961
Category:Базы данных
Category:Paradox
Как добавить пункт в контекстное меню IE?

В реестре по адресу:
 HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\MenuExt
два параметра, посмотришь на другие-поймешь что они означают.
Author: Mikel 
Source: Vingrad.ru http://forum.vingrad.ru
ID: 03498
Category:Связь
Category:WebBrowser
Как добавить пункт меню?

=== Как добавить пункт меню? ===
procedure AddItemsM(vAction: TAction; vMenu: TMainMenu);
var
 index: integer
 vItems :TMenuItem;
begin
 index := vMenu.Items.IndexOf(nmWindow);
 vItems := TMenuItem.Create(vMenu);
 vItems.Action := vAction;
 vMenu.Items.Items[index].Add(vItems);
end;
nmWindow - это Name пункта меню "Окна"
(этот код я писал для добавления открытых окон в пункт меню "Окна", главного меню своего приложения) 
Author: Pegas
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01310
Как добавить свой пункт меню?

=== Как добавить свой пункт меню? ===
function AddMenuItem(ConnType: TconnType; MenuText, StatusBarText,
 GuidOrPath: string; HelpMenu: Boolean): string;
var
 GUID: TGUID;
 ID: string;
 Reg: TRegistry;
begin
 CreateGuid(GUID);
 ID := GuidToString(GUID);
 Reg := TRegistry.Create;
 with Reg do
 begin
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('\Software\Microsoft\Internet Explorer\Extensions\' + ID, True);
 if HelpMenu then
 WriteString('MenuCostumize', 'help');
 WriteString('CLSID', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
 WriteString('MenuText', MenuText);
 WriteString('MenuStatusBar', StatusBarText);
 case ConnType of
 EXECUTABLE: WriteString('Exec', GuidOrPath);
 COM_OBJECT: WriteString('ClsidExtension', GuidOrPath);
 SCRIPT: WriteString('Script', GuidOrPath);
 end;
 CloseKey;
 OpenKey('\Software\IE5Tools\Menu Items\', True);
 WriteString(MenuText, ID);
 CloseKey;
 Free;
 end;
 Result := ID;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02387
Как добавить собственную панель?

=== Как добавить собственную панель? ===
function AddExplorerBar(BarTitle, Url: string; BarSize: Int64; Horizontal:
 Boolean): string;
const
 EXPLORERBAR_ID = '{4D5C8C2A-D075-11d0-B416-00C04FB90376}';
 VERTICAL_BAR = '{00021493-0000-0000-C000-000000000046}';
 HORIZONTAL_BAR = '{00021494-0000-0000-C000-000000000046}';
var
 GUID: TGUID;
 SysDir, ID: string;
 Reg: TRegistry;
begin
 CreateGuid(GUID);
 ID := GuidToString(GUID);
 Reg := TRegistry.Create;
 with Reg do
 try
 RootKey := HKEY_CLASSES_ROOT;
 OpenKey('\CLSID\' + ID, True);
 WriteString(, 'BarTitle');
 CloseKey;
 CreateKey('\CLSID\' + ID + '\Implemented Categories');
 if HORIZONTAL then
 CreateKey('\CLSID\' + ID + '\Implemented Categories\' + HORIZONTAL_BAR)
 else
 CreateKey('\CLSID\' + ID + '\Implemented Categories\' + VERTICAL_BAR);
 SetLength(SysDir, 255);
 GetSysDirectory(PChar(SysDir), 255);
 SysDir := PChar(SysDir) + '\SHDOCVW.DLL';
 OpenKey('\CLSID\' + ID + '\InProcServer32', True);
 Writestring(, SysDir);
 WriteString('Threadingmodel', 'Apartment');
 CloseKey;
 OpenKey('\CLSID\' + ID + '\Instance', True);
 WriteString('CLSID', EXPLORERBAR_ID);
 CloseKey;
 OpenKey('\CLSID\' + ID + '\Instance\InitPropertyBag', True);
 WriteString('Url', URL);
 CloseKey;
 RootKey := HKEY_LOCAL_MACHINE;
 OpenKey('Software\Microsoft\Internet Explorer\Explorer Bars\' + ID, True);
 WriteBinaryData('BarSize', BarSize, SizeOf(BarSize));
 CloseKey;
 OpenKey('\Software\IE5Tools\Explorer Bars\', True);
 WriteString(BarTitle, ID);
 CloseKey;
 OpenKey('\Software\Microsoft\Internet Explorer\Toolbar', True);
 WriteString(ID, );
 CloseKey;
 finally
 Free;
 end;
 Result := ID;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02386