nyuuzyou/wikis huggingface dataset:
Не устанавливается цвет панели

=== Не устанавливается цвет панели ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, XPMan;
type
 TForm1 = class(TForm)
 Panel1: TPanel;
 XPManifest: TXPManifest;
 procedure FormCreate(Sender: TObject);
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
uses
 Themes;
type
 TMyPanel = class(TPanel)
 public
 constructor Create(AOwner: TComponent); override;
 end;
{ TMyPanel }
constructor TMyPanel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 if ThemeServices.ThemesEnabled then
 ControlStyle := ControlStyle - [csParentBackground] + [csOpaque];
end;
procedure TForm1.FormCreate(Sender: TObject);
var
 R: TRect;
begin
 with TMyPanel.Create(Self) do
 begin
 Parent := Self;
 Color := clGreen;
 R := Panel1.BoundsRect;
 R.Left := R.Left + 300;
 R.Right := R.Right + 300;
 BoundsRect := R;
 end;
end;
end.
Author: Smike
Source: Взято из http://forum.sources.ru
----
Можно отключать стили XP и для отдельных контролов (темы должны быть включены и манифест лежать на форме):
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, StdCtrls, ComCtrls, XPMan;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 Button3: TButton;
 Button4: TButton;
 Button5: TButton;
 XPManifest1: TXPManifest;
 procedure FormCreate(Sender: TObject);
 private
 procedure Unload2Themes(var M:TMSG); message WM_USER+1;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function SetWindowTheme(hwnd: HWND; pszSubAppName: LPCWSTR;
 pszSubIdList: LPCWSTR): HRESULT; stdcall; external 'uxtheme.dll';
procedure TForm1.Unload2Themes(var M: TMSG);
begin
 SetWindowTheme(Button4.Handle, ' ', ' ');
 SetWindowTheme(Button5.Handle, ' ', ' ');
 SetWindowTheme(Form1.Handle, ' ', ' ');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 PostMessage(Handle,WM_USER+1, 0, 0)
end;
end.
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 00590
Не читаются русские буквы в Database Desktop

=== Не читаются русские буквы в Database Desktop ===
Для DBD 7.0 нужно исправить реестр: ключ
 HKCU\Software\Borland\DBD\7.0\Preferences\Properties\
 SystemFont="Fixedsys"
Если такой ключ не существует, его следует создать.
или
 [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage]
 "1252"="c_1251.nls"
Author: Pegas
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02493
----
Подскажите пожалуйста, у меня вот какая проблема:
Загружаю Database Desktop, открываю таблицу имеющую в полях русский текст, а отображается не русский текст а не понятно что.
О: MANka
Для DBD 5.0 в файл c:\windows\pdoxwin.ini вставить в секцию
 [Properties]
 SystemFont=Arial Cyr
Для DBD 7.0 нужно исправить реестр: ключ
 HKCU\Software\Borland\DBD\7.0\Preferences\Properties\
 SystemFont="Fixedsys"
Если такой ключ не существует, его следует создать. Впрочем, для просмотра таблиц
все равно можно порекомендовать rx Database Explorer - у него это получается очень хорошо.
Author: Alexey Mahotkin 1997-1999
ID: 02495
----
О: Sergey V. Baldin
Это - проблема русских .dbf и Desktop'а. Надо установить шрифт по умолчанию не Arial Cyr, а Fixedsys или System. копать примерно так:
1. находишь производителя Desktop:
Например, если это Borland Desktop 7.0, то находишь строку в реестре
 HKEY_CURRENT_USER\SOFTWARE\BORLAND\DBD\7.0\Preferences\Properties\SystemFont
и меняешь Arial Cyr на стандартные для Windows: Fixedsys или System
(писать название шрифта с большой буквы).
2. И в стандартном драйвере BDE, например DBASE, ставишь русский драйвер dBASE RUS cp866. Открываешь BDE configurator(administrator), ярлык на 32-BDE находится в панели управления. И в строке
 Drivers->Native->DBASE->Langdriver->ставишь dBASE RUS cp866.
После этого все заиграет
Source: Взято с сайта http://blackman.wp-club.net/
ID: 02494
Негатив картинки

var
 Line: PByteArray;
 i, j: Integer;
begin
 // считываем высоту картинки
 for i := 0 to Image1.Picture.Bitmap.Height - 1 do
 begin
 // сканируем по линиям рисунок
 Line := Image1.Picture.Bitmap.ScanLine[i];
 for j := 0 to Image1.Picture.Bitmap.Width * 3 - 1 do
 // меняем цвет на обратный исходя из RGB
 Line^[j] := 255 - Line^[j];
 end;
 Image1.Refresh;
end;
Source: http://delphiworld.narod.ru
ID: 03868
Category:Графика
Category:Bitmap
Category:Цвета и палитры
Недоступная закладка в компоненте TabbedNotebook

=== Недоступная закладка в компоненте TabbedNotebook ===
Есть ли возможность в компоненте Tabbednotebook сделать какую-либо страницу недоступной? То есть не позволять пользователю щелкать на ней и видеть ее содержимое? 
Да, такая возможность существует. Самый простой путь - удалить страницу, например так: 
with TabbedNotebook do
 Pages.Delete(PageIndex);
и снова включить ее (при необходимости), перегрузив форму. 
Блокировка (а не удаление) немного мудренее, поскольку необходима организация цикла в процедуре создания формы, присваивающая имена закладкам компонента TabbedNotebook. Например так: 
J := 0;
with TabbedNotebook do
 for I := 0 to ComponentCount - 1 do
 if Components[I].ClassName = 'TTabButton' then
 begin
 Components[I].Name := ValidIdentifier(TTabbedNotebook(
 Components[I].Owner).Pages[J]) + 'Tab';
 Inc(J);
 end;
где ValidIdentifier ValidIdentifier - функция, которая возвращает правильный Pascal-идентификатор, производный от строки 'Tab': 
function ValidIdentifier(theString: str63): str63;
{--------------------------------------------------------}
{ Конвертирует строку в правильный Pascal-идентификатор, }
{ удаляя все неправильные символы и добавляя символ '_', }
{ если первый символ - цифра }
{--------------------------------------------------------}
var
 I, Len: Integer;
begin
 Len := Length(theString);
 for I := Len downto 1 do
 if not (theString[I] in LettersUnderscoreAndDigits) then
 Delete(theString, I, 1);
 if not (theString[1] in LettersAndUnderscore) then
 theString := '_' + theString;
 ValidIdentifier := theString;
end;
Затем мы можем сделать закладку компонента TabbedNotebook недоступной: 
with TabbedNotebook do
begin
 TabIdent := ValidIdentifier(Pages[PageIndex]) + 'Tab';
 TControl(FindComponent(TabIdent)).Enabled := False;
 { Переключаемся на первую доступную страницу: }
 for I := 0 to Pages.Count - 1 do
 begin
 TabIdent := ValidIdentifier(Pages[I]) + 'Tab';
 if TControl(FindComponent(TabIdent)).Enabled then
 begin
 PageIndex := I;
 Exit;
 end;
 end;
end;
следующий код восстанавливает доступность страницы: 
with TabbedNotebook do
 for I := 0 to Pages.Count - 1 do
 begin
 TabIdent := ValidIdentifier(Pages[I]) + 'Tab';
 if not TControl(FindComponent(TabIdent)).Enabled then
 TControl(FindComponent(TabIdent)).Enabled := True;
 end;
Source: Взято с http://delphiworld.narod.ru
ID: 01162
Необходимо, чтобы дочерняя форма не активизировала родительское окно

=== Необходимо, чтобы дочерняя форма не активизировала родительское окно ===
Сделайте родительским окном рабочий стол. 
procedure TForm2.CreateParams(var Params: TCreateParams); 
begin 
 inherited CreateParams(Params); 
 Params.WndParent := GetDesktopWindow; 
end; 
ID: 00440
Несколько колонок в TComboBox

=== Несколько колонок в TComboBox ===
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; 
 Index: Integer; Rect: TRect; State: TOwnerDrawState); 
var 
 strVal, strAll: string; 
 pos1, pos2: Integer; 
 rc: TRect; 
 arrWidth: array [0..3] of Integer; 
begin 
 Combobox1.Canvas.Brush.Style := bsSolid; 
 Combobox1.Canvas.FillRect(Rect); 
 // the columns must be separated by ';' 
 strAll := Combobox1.Items[Index]; 
 arrWidth[0] := 0; 
 arrWidth[1] := 100; // Width of column 1 
 arrWidth[2] := 200; // Width of column 2 
 arrWidth[3] := 300; // Width of colimn 3 
 // Drawingrange for first column 
 rc.Left := Rect.Left + arrWidth[0] + 2; 
 rc.Right := Rect.Left + arrWidth[1] - 2; 
 rc.Top := Rect.Top; 
 rc.Bottom := Rect.Bottom; 
 // Get text for first column 
 pos1 := Pos(';', strAll); 
 strVal := Copy(strAll, 1, pos1 - 1); 
 // Draw Text 
 Combobox1.Canvas.TextRect(rc, rc.Left, rc.Top, strVal); 
 // Draw separating line betwenn columns 
 Combobox1.Canvas.MoveTo(rc.Right, rc.Top); 
 Combobox1.Canvas.LineTo(rc.Right, rc.Bottom); 
 // Drawingrange for second column 
 rc.Left := Rect.Left + arrWidth[1] + 2; 
 rc.Right := Rect.Left + arrWidth[2] - 2; 
 // Text fur zweite Spalte ausfiltern 
 // Get text for second column 
 strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1); 
 pos1 := Pos(';', strAll); 
 strVal := Copy(strAll, 1, pos1 - 1); 
 // Text ausgeben 
 // Draw Text 
 Combobox1.Canvas.TextRect(rc, rc.Left, rc.Top, strVal); 
 // Trennlinie zwischen Spalten zeichnen 
 // Draw separating line betwenn columns 
 Combobox1.Canvas.MoveTo(rc.Right, rc.Top); 
 Combobox1.Canvas.LineTo(rc.Right, rc.Bottom); 
 // Drawingrange for third column 
 rc.Left := Rect.Left + arrWidth[2] + 2; 
 rc.Right := Rect.Left + arrWidth[3] - 2; 
 // Get text for third column 
 strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1); 
 pos1 := Pos(';', strAll); 
 strVal := Copy(strAll, 1, pos1 - 1); 
 // Draw Text 
 Combobox1.Canvas.TextRect(rc, rc.Left, rc.Top, strVal); 
 // Draw separating line betwenn columns 
 Combobox1.Canvas.MoveTo(rc.Right, rc.Top); 
 Combobox1.Canvas.LineTo(rc.Right, rc.Bottom); 
 strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1); 
end; 
// Example/ Beispiel: 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 with Combobox1.Items do 
 begin 
 Add('first;second;third;'); 
 Add('column1;column2;column3;'); 
 end; 
end; 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
 //Oder im Objekt Inspektor einstellen 
 //Or set this Property in the Object Inspector 
 Combobox1.Style := csOwnerDrawFixed; 
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00669
Несколько расширенных функций по определению позиции

=== Несколько расширенных функций по определению позиции ===
// Get the Position of a string, starting at the end 
// Ruckwartiges Vorkommen einer Zeichenkette innerhalb eines strings, Position von hinten 
function LastPos(SearchStr, Str: string): Integer;
 var
 i: Integer;
 TempStr: string;
 begin
 Result := Pos(SearchStr, Str);
 if Result = 0 then Exit;
 if (Length(Str) > 0) and (Length(SearchStr) > 0) then
 begin
 for i := Length(Str) + Length(SearchStr) - 1 downto Result do
 begin
 TempStr := Copy(Str, i, Length(Str));
 if Pos(SearchStr, TempStr) > 0 then
 begin
 Result := i;
 break;
 end;
 end;
 end;
 end;
 // Search for the next occurence of a string from a certain Position 
// Nachstes Vorkommen einer Zeichenkette ab einer frei definierbaren Stelle im string 
function NextPos(SearchStr, Str: string; Position: Integer): Integer;
 begin
 Delete(Str, 1, Position - 1);
 Result := Pos(SearchStr, upperCase(Str));
 if Result = 0 then Exit;
 if (Length(Str) > 0) and (Length(SearchStr) > 0) then
 Result := Result + Position + 1;
 end;
 // Get the number of characters from a certain Position to the string to be searched 
// Anzahl der Zeichen von einer definierbaren Position zur gesuchten Zeichenkette 
function NextPosRel(SearchStr, Str: string; Position: Integer): Integer;
 begin
 Delete(Str, 1, Position - 1);
 Result := Pos(SearchStr, UpperCase(Str)) - 1;
 end;
 // simple replacement for strings 
// einfaches Ersetzen von Zeichenketten 
function ReplaceStr(Str, SearchStr, ReplaceStr: string): string;
 begin
 while Pos(SearchStr, Str) <> 0 do
 begin
 Insert(ReplaceStr, Str, Pos(SearchStr, Str));
 Delete(Str, Pos(SearchStr, Str), Length(SearchStr));
 end;
 Result := Str;
 end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00856
Нужна база данных, работающая без каких-либо драйверов, Без ODBC/BDE/ADO/DAO etc

=== Нужна база данных, работающая без каких-либо драйверов, Без ODBC/BDE/ADO/DAO etc ===
Компонент называемый VolgaDB: www.volgadb.com
Author: Автор: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято из http://forum.sources.ru
ID: 02410
О DelphiX

DelphiX - плагин под Дельфи, но не простой, а... нет, и не золотой, он очень нужный! Нужнее DelphiX'а есть только один другой плагин - RX Library, но о нем в другой секции. Но что же это за плагин такой? ДельфиИкс - маленький модуль для Дельфей, который позволяет работать с DirectX под Delphi. С названием разобрались, теперь надо разобраться с тем, как он работает. В состав ДельфИкса входят: DXDraw, DXDib, DXImagelist, DX3D, DXSound, DXWave, DXWaveList, DXInput, DXPlay, DXSpriteEngine, DXTimer, DXPaintBox. Теперь расскажу о каждом понемногу:
* DXDraw - основной компонент ДельфИкса, это его "рабочий стол", на котором отображается все остальное.
* DXDib - абсолютно ненужный компонент, не знаю зачем он здесь...
* DXImagelist - компонент для работы с файлами графики, контейнер, куда пихают все картинки
* DX3D - комментарии излишни...
* DXSound - компонент для доступа к библиотеке DirectX dxsound.dll
* DXWave - то же, что и DXDib
* DXWaveList - то же, что и DXImageList, но для звука
* DXInput - Этот компонент должен служить для ввода данных с клавиатуры, мышки и джойстика
* DXPlay - компонент для создания мультиплеера
* DXSpriteEngine - то же, что и DXSound, но для графики
* DXTimer - обычный таймер. но с немного расширенными возможностями
* DXPaintBox - ???
Скачать ДельфИкс вы сможете на сайте http://instrumentari.narod.ru
Source: http://delphiworld.narod.ru
ID: 03928
Category:Графика
Category:DirectX
О переносе проекта в другую папку

=== О переносе проекта в другую папку ===
Если вы захотите перенести проект в другую папку и при этом сохранить его работоспособность, вам нужно сначала с помощью опции file|save project as скопировать в эту папку файл проекта, а затем с помощью опции file|save as перенести туда все связанные с проектом модули: только тогда delphi сумеет внести необходимые коррекции в файл проекта. Но если все файлы хранятся в единственной папке, то в предложении uses не указываются маршруты доступа, и поэтому вы сможете безболезненно скопировать разом все файлы в другую папку. 
Настроечный файл .dsk, в котором среда сохраняет информацию о состоянии экрана в момент выхода из delphi, также содержит полные маршруты доступа к открытым файлам. При переносе проекта этот файл копировать не следует.
Source: http://www.delphi.h5.ru/ 
ID: 00088
О пользе типа ShortString при использовании WinAPI

=== О пользе типа ShortString при использовании WinAPI ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> О пользе типа shortstring при использовании WinAPI
Довольно значительное количество функций WinAPI принимают как параметры
указатель на заполняемый ими массив символов и размер этого массива, а
возвращают количество помещенных ими символов. Если мы работаем в ANSI (не
Unicode), здесь удобно пользоваться короткими строками и "убивать двух зайцев"
за один раз.
Зависимости: windows
Автор: Павел Озерский, pavel@insect.mail.iephb.ru, Санкт-Петербург
Copyright: собственная разработка автора (Павел Озерский)
Дата: 26 апреля 2002 г.
***************************************************** }
// пример:
function ClassName(hwnd: tHandle): shortstring;
begin
 byte(Result[0]) := GetClassName(hwnd, pChar(@Result[1]), 255);
end;
Source: http://delphibase.endimus.com
ID: 00857
Об авторских правах

=== Об авторских правах ===
Все исходники с настоящего документа являются открытыми для использования с любой целью, т.е. Вы можете их копировать и использовать в своих приложениях вне зависимости от того будет это приложение коммерческим или нет. Однако публикация данных ответов, кодов и особенно статей в интернете, на других форумах, FAQ, usenet и т.п. обязана осуществляться с ссылкой на первоисточник (в тех случаях, когда автором ответа являюсь я (Vit) вы можете использовать ответ вообще без всяких ограничений!). 
Я старался везде, где это только было возможно указывать источник информации. Но форум есть форум, и конечно же никто не может гарантировать, что какие-то коды не были присланы участниками форума без согласования с авторами и ссылок на первоисточник. Кроме того, коды и ответы в сети зачастую стали уже безымянными, они цитируются с незначительными исправлениями во многих FAQ, статьях, сайтах и форумах (так я уже встречал свои коды в чужих FAQ, например мой код MD5 стал чуть ли не стандартом de facto в рунете и цитируется подавляющим большинством faq, сайтов и форумов. Я лично не имею ничего против). Поэтому, я допускаю что выпуском этого FAQ я мог (естественно не специально и без злого умысла) нарушить чьи-то авторские права. Если такое произошло, сообщите мне по адресу: nevzorov@yahoo.com и я постараюсь изъять такие материалы так быстро, как это возможно или (по согласованию с автором) предоставить полную информацию об авторских правах на тот или иной код.
Обмен значениями элементов TListView

=== Обмен значениями элементов TListView ===
Today I want to describe how you may exchange some items in standard TListView.
For example, you have 5 items and want to swap
positions for first and third items
Problem that standard TListView component havent
such method and you must realize it yourself.
We remember that the standard way from old Pascal times (for numbers) is:
 procedure Swap(X, Y: Integer);
 var
 s: Integer;
 begin
 s := X;
 X := Y;
 Y := X
 end;
Something similar we can do with TListItem too.
But just to save all strings (caption+sub items) somewhere is not enough because TListItem class have a lot of other information (image indexes, pointer as Data, etc)
So correct way is to use Assign method:
 procedure ExchangeItems(lv: TListView; const i, j: Integer);
 var
 tempLI: TListItem;
 begin
 lv.Items.BeginUpdate;
 try
 tempLI := TListItem.Create(lv.Items);
 tempLI.Assign(lv.Items.Item[i]);
 lv.Items.Item[i].Assign(lv.Items.Item[j]);
 lv.Items.Item[j].Assign(tempLI);
 tempLI.Free;
 finally
 lv.Items.EndUpdate
 end;
 end;
So structure is a same as in our sample for Integer. All what we added are
BeginUpdate and EndUpdate (just allow to reduce a flickering)
So if you want to exchange items in any ListView, just call this procedure... 
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01134
Обмен информацией между приложениями Win32 - Win16

=== Обмен информацией между приложениями Win32 - Win16 ===
Пользуйтесь сообщением WM_COPYDATA. 
Для Win16 константа определена как $004A, в Win32 смотрите в WinAPI Help. 
#define WM_COPYDATA 0x004A 
/* 
 * lParam of WM_COPYDATA message points to... 
 */ 
typedef struct tagCOPYDATASTRUCT { 
 DWORD dwData; 
 DWORD cbData; 
 PVOID lpData; 
} COPYDATASTRUCT, *PCOPYDATASTRUCT; 
ID: 02008
Обмен строк TStringGrid

=== Обмен строк TStringGrid ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Обмен строк StringGrid
Обмен содержимого указанных строк StringGrid.
Варианты без копирования связанных с ячейками объектов и вместе с ними.
Зависимости: Grids
Copyright: MBo
Дата: 27 апреля 2002 г.
***************************************************** }
procedure SGExchangeRows(SG: TStringGrid; Row1, Row2: Integer);
var
 TempString: string;
begin
 if (Row1 in [0..SG.RowCount - 1]) and (Row2 in [0..SG.RowCount - 1]) then
 begin
 TempString := SG.Rows[Row1].Text;
 SG.Rows[Row1].Assign(SG.Rows[Row2]);
 SG.Rows[Row2].Text := TempString;
 end;
end;
procedure SGExchRowsWithObj(SG: TStringGrid; Row1, Row2: Integer);
var
 TempList: TStringList;
begin
 with SG do
 if (Row1 in [0..RowCount - 1]) and (Row2 in [0..RowCount - 1]) then
 begin
 TempList := TStringList.Create;
 TempList.Assign(Rows[Row1]);
 Rows[Row1].Assign(Rows[Row2]);
 Rows[Row2].Assign(TempList);
 TempList.Free;
 end;
end;
Source: http://delphibase.endimus.com
ID: 01063
Обнаружение прокрутки TMemo

=== Обнаружение прокрутки TMemo ===
Создайте потомок TMemo, перехватывающий сообщения WM_HSCROLL и WM_VSCROLL:
type
 TSMemo = class(TMemo)
 procedure WM_HScroll(var Msg: TWMHScroll); message WM_HSCROLL;
 procedure WM_VScroll(var Msg: TWMVScroll); message WM_VSCROLL;
 end;
implementation
procedure TSMemo.WM_HScroll(var Msg: TWMHScroll);
begin
 ShowMessage('HScroll');
end;
procedure TSMemo.WM_VScroll(var Msg: TWMVScroll);
begin
 ShowMessage('VScroll');
end;
Source: http://delphiworld.narod.ru/
ID: 00999
Обновление вычисляемых полей

=== Обновление вычисляемых полей ===
Разместите строчку типа нижеприведенной в конце кода обработчика события OnCalcFields:
{ предположим, что вы используете DBGrid1 }
if DBGrid1.Showing then
 DBGrid1.Invalidate;
Author: (Borland) OAmiry
Source: http://delphiworld.narod.ru/
ID: 02623
Обновление картинки в ячейке

=== Обновление картинки в ячейке ===
Если в таблице вы используете событие OnDrawCell для помещения в ячейку рисунка, причем различного, в зависимости, например, от соответствующего значения в двумерном массиве, и вам надо, чтобы после изменения значения в массиве обновилось изображение (Refresh не подходит, т.к. будет мелькать), то измените значение у ячейки (DrawGrid не годится):
StringGrid1.Cells[i, j] := ; 
или
StringGrid1.Cells[i, j] := StringGrid1.Cells[i, j]; 
если там что-то хранится 
Source: http://delphiworld.narod.ru/
ID: 01081
Обновление файла после перезагрузки системы

{ **** UBPFD *********** by kladovka.net.ru ****
>> Обновление файла после перезагрузки системы
Данная процедура настраивает систему для обновления файлов после перезагрузки.
TargetFileName - имя файла, содержимое которого при перезагрузке будет
заменено на содержимое файла, имя которого укзаывается в параметре SourceFileName.
Если первый аргумент процедуры представляет собой пустую строку, при
перезагрузке файл SourceFileName будет удалён.
Зависимости: Windows
Copyright: Dimka Maslov
Дата: 18 ноября 2002 г.
********************************************** }
procedure BootReplaceFile(TargetFileName, SourceFileName: string)
var
 WinInitName: string;
 P: PChar;
procedure InternalGetShortPathName(var S: string);
begin
 UniqueString(S);
 GetShortPathName(PChar(S), PChar(S), Length(S));
 SetLength(S, StrLen(@S[1]));
 CharToOEM(PChar(S), PChar(S));
end;
begin
 if Win32Platform = VER_PLATFORM_WIN32_NT then
 begin
 if TargetFileName <> then
 P := PChar(TargetFileName)
 else
 P := nil;
 MoveFileEx(PChar(SourceFileName), P,
 MOVEFILE_DELAY_UNTIL_REBOOT or MOVEFILE_REPLACE_EXISTING);
 end
 else
 begin
 SetLength(WinInitName, MAX_PATH);
 GetWindowsDirectory(@WinInitName[1], MAX_PATH);
 SetLength(WinInitName, StrLen(@WinInitName[1]));
 WinInitName:=IncludeTrailingBackslash(WinInitName) + 'WININIT.INI';
 if TargetFileName = then
 TargetFileName := 'NUL'
 else
 InternalGetShortPathName(TargetFileName);
 InternalGetShortPathName(SourceFileName);
 WritePrivateProfileString('Rename', PChar(TargetFileName),
 PChar(SourceFileName), PChar(WinInit));
 end;
end;
Пример использования:
BootReplaceFile('c:\Program Files\proga.exe', 'c:\temp\proga.exe'); // После перезагрузки содержимое первого файла будет заменено на содержимое второго файла, а второй файл будет удалён
BootReplaceFile(, 'c:\temp\proga.exe'); // Указанный файл будет удалён после перезагрузки
Author: Dimka Maslov
ID: 03179
Category:Файловая система