nyuuzyou/wikis huggingface dataset:
Обработать момент вставки и вытаскивания CD

=== Обработать момент вставки и вытаскивания CD ===
{
 Some applications need to know when the user inserts or
 removes a compact disc or DVD from a CD-ROM drive without
 polling for media changes. Windows provide a way to notify these
 applications through the WM_DEVICECHANGE message.
}
type
 TForm1 = class(TForm)
 private
 procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
 public
 end;
implementation
{$R *.DFM}
procedure TForm1.WMDeviceChange(var Msg: TMessage);
const
 DBT_DEVICEARRIVAL = $8000; // system detected a new device
 DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
var
 myMsg: string;
begin
 inherited;
 case Msg.wParam of
 DBT_DEVICEARRIVAL: myMsg := 'CD inserted!';
 DBT_DEVICEREMOVECOMPLETE: myMsg := 'CD removed!';
 end;
 ShowMessage(myMsg);
end;
{*********************************************}
// Advanced Code:
// When the device is of type volume, then we can get some device specific
// information, namely specific information about a logical volume.
// by Juergen Kantz
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 label1: TLabel;
 private
 procedure WMDeviceChange(var Msg: TMessage); message WM_DeviceChange;
 { Private declarations }
 public
 { Public declarations }
 end;
const
 DBT_DeviceArrival = $8000;
 DBT_DeviceRemoveComplete = $8004;
 DBTF_Media = $0001;
 DBT_DevTyp_Volume = $0002;
type
 PDevBroadcastHdr = ^TDevBroadcastHdr;
 TDevBroadcastHdr = packed record
 dbcd_size: DWORD;
 dbcd_devicetype: DWORD;
 dbcd_reserved: DWORD;
 end;
type
 PDevBroadcastVolume = ^TDevBroadcastVolume;
 TDevBroadcastVolume = packed record
 dbcv_size: DWORD;
 dbcv_devicetype: DWORD;
 dbcv_reserved: DWORD;
 dbcv_unitmask: DWORD;
 dbcv_flags: Word;
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
 i: Byte;
 Maske: DWORD;
begin
 if (pDBVol^.dbcv_flags and DBTF_Media) = DBTF_Media then
 begin
 Maske := pDBVol^.dbcv_unitmask;
 for i := 0 to 25 do
 begin
 if (Maske and 1) = 1 then
 Result := Char(i + Ord('A')) + ':';
 Maske := Maske shr 1;
 end;
 end;
end;
procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
 Drive: string;
begin
 case Msg.wParam of
 DBT_DeviceArrival:
 if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
 begin
 Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
 label1.Caption := 'CD inserted in Drive ' + Drive;
 end;
 DBT_DeviceRemoveComplete:
 if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
 begin
 Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
 label1.Caption := 'CD removed from Drive ' + Drive;
 end;
 end;
end;
end.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01413
Обработка исключения index not found

=== Обработка исключения index not found ===
Как мне открыть таблицу dBASE без требуемого MDX-файла? Я постоянно получаю исключение "Index not found..." (индекс не найден).
Во время создания таблицы dBASE с production-индексом (MDX) в заголовке DBF-файла устанавливается специальный байт. При последующем открытии таблицы, dBASE-драйвер читает этот специальный байт и, если он установлен, он также пытается открыть файл MDX. Если попытка открыть файл MDX заканчивается неудачей, возникает исключительная ситуация.
Для решения этой проблемы вам необходимо обнулить этот байт (28-й десятичный байт) в файле DBF, избавляющий таблицу от зависимости MDX-файла.
Нижеприведенным модуль является простым примером того, как можно обработать исключение при открытии таблицы, обнулив этот байт в DBF-файле и вновь открыв таблицу.
unit Fixit;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
 Controls, Forms, Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids;
type
 TForm1 = class(TForm)
 Table1: TTable;
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
const
 TheTableDir = 'c:\temp\';
 TheTableName = 'animals.dbf';
{ Данная процедура использует в качестве параметра имя файла DBF }
{ и исправляет его заголовок для того, чтобы не требовать MDX-файл }
procedure RemoveMDXByte(dbFile: string);
const
 Value: Byte = 0;
var
 F: file of byte;
begin
 AssignFile(F, dbFile);
 Reset(F);
 Seek(F, 28);
 Write(F, Value);
 CloseFile(F);
end;
{ Данная процедура вызывается в ответ на нажатие кнопки. Она }
{ пытается открыть таблицу и, если файл .MDX не найден, }
{ DBF-файл исправляется и управление вновь передается данной }
{ процедуре для повторного открытия таблицы, но уже без MDX }
procedure TForm1.Button1Click(Sender: TObject);
begin
 try
 { устанавливаем каталог таблицы }
 Table1.DatabaseName := ThheTableDir;
 { устанавливаем имя таблицы }
 Table1.TableName := TheTableName;
 { пытаемся открыть таблицу }
 Table1.Open;
 except
 on E: EDBEngineError do
 { Нижеследующее сообщение указывает на то, что файл MDX не найден: }
 if Pos('Index does not exist. File', E.Message) > 0 then
 begin
 { Сообщаем пользователю о наличии проблемы. }
 MessageDlg('Файл MDX не найден. Попытка открытия
 без индекса.', mtWarning, [mbOk], 0);
 { удаляем байт MDX из заголовка таблицы }
 RemoveMDXByte(TheTableDir + TheTableName);
 { Посылаем кнопке сообщение для эмуляции ее нажатия. }
 { Этот трюк заставит данную процедуру выполниться }
 { повторно, и таблица будет открыта без файла MDX }
 PostMessage(Button1.Handle, cn_Command, bn_Clicked, 0);
 end;
 end;
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 02582
Обратный поиск строки в TRichEdit

=== Обратный поиск строки в TRichEdit ===
{+------------------------------------------------------------ 
| Function FindTextBackwards
|
| Parameters :
| findWhat: text to find
| inString: string to find it in
| startAt : character index to start at (1-based)
| caseSensitive: determines whether search is case-sensitive
| words : if true the characters immediately surrounding
| a found location must not be alphanumeric
| Returns :
| character index (1-based) of first character of a found
| location, or 0, if the text was not found.
| Description:
| Performs a simple sequential search for a string in a larger
| string, starting at the specified position and working towards
| the start of the string.
| Error Conditions: none
| Created: 27.02.99 by P. Below
+------------------------------------------------------------}
function FindTextBackwards(findWhat, inString: string;
 startAt: integer;
 caseSensitive, words: boolean): integer;
var
 i, patternlen, findpos: integer;
 lastchar, firstchar: char;
begin
 Result := 0; { assume failure }
 patternlen := Length(findWhat);
 { Do a few sanity checks on the parameters }
 if (patternlen = 0)
 or (startAt < patternlen)
 or (Length(inString) < patternlen) then
 Exit;
 if not caseSensitive then
 begin
 { convert both strings to lower case }
 findWhat := AnsiLowercase(findWhat);
 inString := AnsiLowercase(inString);
 end;
 i := startAt;
 lastchar := findWhat[patternlen];
 firstchar := findWhat[1];
 while (Result = 0) and (i >= patternlen) do
 begin
 if inString[i] = lastchar then
 begin
 findPos := i - patternlen + 1;
 if inString[findPos] = firstchar then
 begin
 { We have a candidate. Compare the substring of length
 patternlen starting at findPos with findWhat. With
 AnsiStrLComp we can do that without having to copy
 the substring to a temp string first. }
 if AnsiStrLComp(@findWhat[1], @inString[findPos],
 patternlen) = 0 then
 begin
 { We have a match! }
 Result := findPos;
 if words then
 begin
 { Check the characters surrounding the hit. For the hit
 to constitute a word they must not be alphanumeric. }
 if (findPos > 1)
 and IsCharAlphanumeric(inString[findPos - 1]) then
 begin
 { Not a match after all, <sigh>. }
 Result := 0;
 end
 else
 begin
 if (i < Length(inString))
 and IsCharAlphanumeric(inString[i + 1]) then
 begin
 { Not a match after all, <sigh>. }
 Result := 0;
 end;
 end;
 end;
 end;
 end;
 end;
 Dec(i);
 end;
end;
procedure TForm1.Button1Click(Sender : TObject);
var
 findPos: integer;
begin
 findPos := FindTextBackwards(findEdit.Text,
 richedit1.Text,
 richedit1.selstart + 1,
 caseCheckbox.Checked,
 wordsCheckbox.Checked);
 if findPos > 0 then
 begin
 with richedit1 do
 begin
 selstart := findPos - 1;
 sellength := findEdit.GetTextLen;
 Perform(em_scrollcaret, 0, 0);
 SetFocus;
 end;
 end
 else
 ShowMessage('Text not found');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01023
Обращение через свойство Controls

=== Обращение через свойство Controls ===
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
var
 I: Integer;
 ChildControl: TControl;
begin
 for I:= 0 to GroupBox1.ControlCount -1 do
 begin
 ChildControl := GroupBox1.Controls[I];
 ChildControl.Top := ChildControl.Top + 15;
 end;
end;
Проверить тип контрола надо оператором is:
 if (edit1 is TEdit) then ....
Затем доступ ко всем свойствам путем приведения класса:
 (edit1 as TEdit).Text := ; 
Author: Kiber_rat
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00357
Обрезание строки по длине

=== Обрезание строки по длине ===
// Обрезание строки по длине
function TfmDW6Main.BeautyStr(s: string; iLength: integer): string;
var
 bm: TBitmap;
 sResult: string;
 iStrLen: integer;
 bAdd: boolean;
begin
 Result := s;
 if Trim(s) = then
 exit;
 bAdd := false;
 sResult := s;
 bm := TBitmap.Create;
 bm.Width := 100;
 bm.Height := 100;
 iStrLen := bm.Canvas.TextWidth(sResult);
 while iStrLen > iLength do
 begin
 if Length(sResult) < 4 then
 break;
 Delete(sResult, Length(sResult) - 2, 3);
 bAdd := true;
 iStrLen := bm.Canvas.TextWidth(sResult);
 end;
 if (iStrLen <= iLength) and bAdd then
 sResult := sResult + '...';
 bm.Free;
 Result := sResult;
end;
Source: http://delphiworld.narod.ru
ID: 00858
Объединение двух иконок

=== Объединение двух иконок ===
{
 I want to combine 2 icons like Windows does with
 the links (the small arrow).
 Can anyone tell me how that works?
}
function CombineIcons(FrontIcon, BackIcon: HIcon): HIcon;
var
 WinDC: HDC;
 FrontInfo: TIconInfo;
 FrontDC: HDC;
 FrontSv: HBITMAP;
 BackInfo: TIconInfo;
 BackDC: HDC;
 BackSv: HBITMAP;
 BmpObj: tagBitmap;
begin
 WinDC := GetDC(0);
 GetIconInfo(FrontIcon, FrontInfo);
 FrontDC := CreateCompatibleDC(WinDC);
 FrontSv := SelectObject(FrontDC, FrontInfo.hbmMask);
 GetIconInfo(BackIcon, BackInfo);
 BackDC := CreateCompatibleDC(WinDC);
 BackSv := SelectObject(BackDC, BackInfo.hbmMask);
 GetObject(FrontInfo.hbmMask, SizeOf(BmpObj), @BmpObj);
 BitBlt(BackDC, 0,0,BmpObj.bmWidth, BmpObj.bmHeight, FrontDC, 0,0,SRCAND);
 SelectObject(BackDC, BackInfo.hbmColor);
 DrawIconEx(BackDC, 0,0,FrontIcon, 0,0,0,0,DI_NORMAL);
 Result := CreateIconIndirect(BackInfo);
 SelectObject(FrontDC, FrontSv);
 DeleteDC(FrontDC);
 SelectObject(BackDC, BackSv);
 DeleteDC(BackDC);
 ReleaseDC(0,WinDC);
 DeleteObject(FrontInfo.hbmColor);
 DeleteObject(FrontInfo.hbmMask);
 DeleteObject(BackInfo.hbmColor);
 DeleteObject(BackInfo.hbmMask);
end;
// Remember: The icon created with this function must be destroyed with
// DestroyIcon() function when finished using it.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02371
Объединить 2 файла

procedure ConCatFiles(const TargetName: string;
 const SourceNames: array of string);
var
 i: Integer;
 target, source: TFileStream;
begin
 target := TFileStream.Create(TargetName, fmCreate);
 try
 for i := Low(Sourcenames) to High(Sourcenames) do
 begin
 source := TFileStream.Create(SourceNames[i], fmOpenread or fmShareDenyNone);
 try
 target.CopyFrom(source, 0);
 finally
 source.Free;
 end;
 end;
 finally
 target.Free;
 end;
end;
Использование:
 chDir(ExtractFileDir(Application.Exename));
 ConcatFiles('sum.txt', ['project1.dpr', 'unit1.pas', 'unit2.pas']);
ID: 03178
Category:Файловая система
Оглавление файлов помощи (Help Files Contents)

Используйте HELP_FINDER, если "текущая закладка" не является закладкой 'Index' или 'Find'. HELP_FINDER открывает окно Help Topics, но не меняет закладку с оглавлением (Contents), если текущая закладка - 'Index' или 'Find'.
Попробуйте следующий код:
function L1InvokeHelpMacro(const i_strMacro: String; const i_bForceFile: Boolean): Boolean;
begin
 if i_bForceFile then
 Application.HelpCommand(HELP_FORCEFILE, 0);
 Result := Application.HelpCommand(HELP_COMMAND,
 Longint(PChar(i_strMacro))); // Приведение типа PChar здесь необязательно.
end;
Ищем ассоциированный файл помощи, открываем его (если не открыт) и переходим на закладку 'Index':
L1InvokeHelpMacro('Search()', True);
Ищем ассоциированный файл помощи, открываем его (если не открыт) и переходим на закладку 'Contents':
L1InvokeHelpMacro('Contents()', True);
Ищем ассоциированный файл помощи, открываем его (если не открыт) и переходим на закладку 'Find' (только для WinHelp 4):
L1InvokeHelpMacro('Find()', True);
Source: http://delphiworld.narod.ru
ID: 04554
Category:Разработка приложений
Category:Справочная система
Ограничение ввода в текстовое поле

=== Ограничение ввода в текстовое поле ===
{ 
 In this exemple, the only keys allowed are the 
 same allowed in e-mail adresses. 
}
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
const
 AllowedChars: string = 'abcdefghijklmnopq' +
 'rstuvwxyz01234567_.@';
var
 i: Integer;
 Ok: Boolean;
begin
 i := 0;
 Ok := False;
 { If you erase next line, user won't be able to type backspace }
 if Key = #8 then Ok := True;
 repeat
 i := i + 1;
 if Key = AllowedChars[i] then Ok := True;
 until (Ok) or (i = Length(AllowedChars));
 if not Ok then Key := #0;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00972
Ограничение длины и количества строк компонента Memo

=== Ограничение длины и количества строк компонента Memo ===
unit Unit1;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 StdCtrls, ExtCtrls, Forms;
type
 TForm1 = class(TForm)
 Memo1: TMemo;
 procedure FormCreate(Sender: TObject);
 procedure Memo1KeyPress(Sender: TObject; var Key: Char);
 public
 MaxCharsPerLine, MaxLines: Integer;
 function MemoLine: Integer;
 function LineLen(r: Integer): Integer;
 function NRows: Integer;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.NRows: Integer;
begin
 with Memo1 do
 Result := 1 + SendMessage(Handle, EM_LINEFROMCHAR, GetTextLen - 1, 0);
end;
function TForm1.LineLen(r: Integer): Integer;
var
 r1, r2: Integer;
begin
 with Memo1 do
 begin
 r1 := SendMessage(Handle, EM_LINEINDEX, r, 0);
 if (r > NRows - 1) then
 r2 := SendMessage(Handle, EM_LINEINDEX, r + 1, 0) - 2 { -CR/LF }
 else
 r2 := GetTextLen;
 end;
 Result := r2 - r1;
end;
function TForm1.MemoLine: Integer;
begin
 with Memo1 do
 Result := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 MaxCharsPerLine := 8;
 MaxLines := 4;
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
 with Memo1 do
 begin
 case Key of
 ' '..#255: if (LineLen(MemoLine) >= MaxCharsPerLine) then
 Key := #0;
 #10, #13: if (NRows >= MaxLines) then
 Key := #0;
 #8: if (SelStart = SendMessage(Handle, EM_LINEINDEX, MemoLine, 0)) then
 Key := #0;
 end;
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01000
----
procedure TForm1.Memo1Change(Sender: TObject);
const
 MaxLineCount = 5;
begin
 if Memo1.Lines.Count > MaxLineCount then
 // undo the last change 
 // letze Дnderung rьckgдngig machen 
 Memo1.Perform(EM_UNDO, 0, 0);
 // The EM_EMPTYUNDOBUFFER message clears the undo flag, 
 // which means that you can no longer undo your last change 
 // to the edit control. 
 // Die Message EM_EMPTYUNDOBUFFER lцscht das UnDo Flag, 
 // damit kann die letzte Дnderung nicht Rьckgдngig gemacht werden. 
 Memo1.Perform(EM_EMPTYUNDOBUFFER, 0, 0);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01001
Ограничение длины поля TStringGrid

=== Ограничение длины поля TStringGrid ===
Вероятно, это не очень эффективное решение, но оно будет работать: поместите следующий код в обработчик события onKeyPress:
if key <> #8 then 
begin
 { допускаем backspace/Del }
 len := Length(Grid.Cells[Grid.Col, Grid.Row]);
 if len >= { ваша желаемая максимальная длина } then 
 begin
 MessageBeep(0);
 key := #0;
 end;
end;
После получения вышеуказанным кодом строки s проверяется условие и,
 if Length(s) > maxlengthoffield then exit;
Source: http://delphiworld.narod.ru/
ID: 01098
Ограничения Foxpro

=== Ограничения Foxpro ===
 Table and Index Files
Max. # of records per table 	1 billion*
Max. # of chars per record 	65,000
Max. # of fields per record 	255
Max. # of open DBFs 	225
Max. # of chars per field 	254
Max. # of chars per index key (IDX) 	100
Max. # of chars per index key (CDX) 	240
Max. # of open index files per table 	unlimited**
Max. # of open index files in all work areas	unlimited**
 * The actual file size (in bytes) cannot exceed 2 gigabytes for single-user or exclusively opened multi-user tables. Shared tables with no indexes or .IDX indexes cannot exceed 1 gigabyte. Shared tables with structural .CDX indexes cannot exceed 2 gigabytes.
 
 ** Limited by memory. In FoxPro for MS-DOS and FoxPro for Windows, also limited by available MS-DOS file handles. Each .CDX file uses only 1 file handle. The number of MS-DOS file handles is determined by the CONFIG.SYS FILES parameter.
 Field Characteristics
Max. size of character fields 	254
Max. size of numeric fields 	20
Max. # of chars in field names 	10
Digits of precision in numeric computations	16
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02933
Category:Базы данных
Category:FoxPro
Ограничения Paradox

=== Ограничения Paradox ===
 Table and Index Files
127 	Tables open per system
64 	Record locks on one table (16Bit) per session
255 	Record locks on one table (32Bit) per session
255 	Records in transactions on a table (32 Bit)
512 	Open physical files (DB, PX, MB, X??, Y??, VAL, TV)
300 	Users in one PDOXUSRS.NET file
255 	Number of fields per table
255 	Size of character fields
2 	Billion records in a table
2 	Billion bytes in .DB (Table) file
10800	Bytes per record for indexed tables
32750	Bytes per record for non-indexed tables
127 	Number of secondary indexes per table
16 	Number of fields in an index
255 	Concurrent users per table
256 	Megabytes of data per BLOB field
100 	Passwords per session
15 	Password length
63 	Passwords per table
159 	Fields with validity checks (32 Bit)
63 	Fields with validity checks (16 Bit)
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02943
Category:Базы данных
Category:Paradox
Ограничить подвижность формы

=== Ограничить подвижность формы ===
For some reason messages.pas declares no message record for this message
interface
type
 TWmMoving = record
 Msg: Cardinal;
 fwSide: Cardinal;
 lpRect: PRect;
 Result: Integer;
 end;
 // Add a handler to your forms private section:
 TFormX = class(TForm)
 private
 procedure WMMoving(var msg: TWMMoving); message WM_MOVING;
implementation
procedure TFormX.WMMoving(var msg: TWMMoving);
var
 r: TRect;
begin
 r := Screen.WorkareaRect;
 // compare the new form bounds in msg.lpRect^ with r and modify it if
 // necessary
 if msg.lprect^.left < r.left then
 OffsetRect(msg.lprect^, r.left - msg.lprect^.left, 0);
 if msg.lprect^.top < r.top then
 OffsetRect(msg.lprect^, 0, r.top - msg.lprect^.top);
 if msg.lprect^.right > r.right then
 OffsetRect(msg.lprect^, r.right - msg.lprect^.right, 0);
 if msg.lprect^.bottom > r.bottom then
 OffsetRect(msg.lprect^, 0, r.bottom - msg.lprect^.bottom);
 inherited;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00512
Огромные LCK-файлы (Lock File Has Grown Too Large)

=== Огромные LCK-файлы (Lock File Has Grown Too Large) ===
Если .EXE-файл расположен в том же каталоге, что и таблица Paradox, и флажок Local Share установлен в TRUE, .LCK-файл с каждым запросом растет как на дрожжах. Другая условие - вы имеете соединение посредством DbiOpenTable или TTable.Open.
РЕШЕНИЕ:
* Установите частный (private) каталог в какое-нибудь другое место
* Переместите .EXE-файл в каталог, отличный от каталога с файлами таблиц
* Установите Local Share в FALSE
Сборник Kuliba
Author: Scott Frolich
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02580
----
Эта проблема специфична для таблиц формата Paradox, относится как 16 битным, так и 32 битным версиям BDE, и может встречается при выполнении одного из следующих условий:
# Исполняемый файл приложения находится в той же папке, что и таблица.
# Некорректно установлен (не установлен) параметр Private Directory.
# Открытая в TTable таблица Paradox участвует в запросах TQuery.
# Параметр LOCAL SHARE установлен в True (BDE Administrator, закладка "System")
Для решения проблемы необходимо выполнить следующие шаги:
:1. В папке с исполняемым файлом приложения создайте три новых папки: TABLES, PRIV и NET (длина пути NetDir не должна превышать 31 символа). Поместите все таблицы приложения в папку Tables
:2. Во время исполнения Ваше приложение должно устанавливать значения:
 Session.PrivateDir := ExtractFilePath(ParamStr(0)) + 'PRIV'; Session.NetFileDir := ExtractFilePath(ParamStr(0)) + 'NET';
:3. Убедитесь, что значение LOCAL SHARE установлено в False (BDE Administrator, закладка "System")
Эти рекомендации позволяют избежать ошибки "Lock File Too Large".
Примечание: данные рекомендации справедливы для локальных баз, в случае сетевых баз и/или размещения программы на сетевом устройстве или при доступе из нескольких программ, можно поступись следующим образом:
# Не размещайте базу и программу в одной папке, тем более, что программу желательно поместить в защищенную от записи папку.
# Приватный каталог надо разместить в персональной папке, желательно для каждой запущенной копии приложения отдельный, подходящее место персональная папка TEMP\SessionID\
# Сетевой каталог NETDIR - выделить отдельную папку на сети исключительно только для этой цели и единую для всех приложений BDE
# LOCAL SHARE - TRUE, можно попробовать и FALSE, если это не будет приводить к порче индексов.
Source: Взято с http://delphiworld.narod.ru
ID: 02581
Округление времени

=== Округление времени ===
function RoundTime(ADate: string; Rounding: Integer; bRound: Boolean): string;
 var
 Year, Month, Day, Hour, Min, Sec, MSec: Word;
 tmpDate: TDateTime;
 Res, Diff: string;
 M: integer;
 begin
 tmpDate := StrToDateTime(ADate);
 DecodeTime(tmpDate, Hour, Min, Sec, MSec);
 if (Rounding > 0) and (bRound = True) then
 begin
 if Min mod Rounding = 0 then
 Res := IntToStr(Min)
 else
 Res := IntToStr(Round(Min / Rounding) * Rounding);
 M := StrToInt(Copy(ADate, Length(ADate) - 1, 2));
 Diff := IntToStr(StrToInt(Res) - M);
 if Copy(Diff, 1, 1) = '-' then
 begin
 Diff := Copy(Diff, 2, Length(Diff) - 1);
 Result := FormatDateTime('dd.mm.yy hh:mm', (tmpDate - StrToTime('00:00' + Diff)));
 end
 else
 Result := FormatDateTime('dd.mm.yy hh:mm', (tmpDate + StrToTime('00:00' + Diff)));
 end
 else
 Result := ADate;
 end;
// Example: 
procedure TForm1.Button1Click(Sender: TObject);
 begin
 Edit1.Text := FormatDateTime('dd.mm.yy hh:mm', Now);
 Edit2.Text := RountTime(Edit1.Text, SpinEdit1.Value, Checkbox1.Checked);
 // Example: RoundTime('07.08.02 10:41', '15', True) -- > 07.08.02 10:45 
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00766
Определение адреса во всех открытых Explorer

=== Определение адреса во всех открытых Explorer ===
uses SHDocVw;
procedure TForm1.Button1Click(Sender: TObject);
var
 I: Integer;
 Explorer: IShellWindows;
begin
 Explorer := CoShellWindows.Create;
 for I := 0 to Explorer.Count - 1 do
 Listbox1.Items.Add((Explorer.Item(I) as IWebbrowser2).LocationUrl);
end;
Author: Александр (Rouse_) Багель
Source: Взято из http://forum.sources.ru
ID: 02392