nyuuzyou/wikis huggingface dataset:
Как узнать перечень таблиц базы и количество записей в них?

=== Как узнать перечень таблиц базы и количество записей в них? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 SL: TStrings;
 index: Integer;
begin
 SL := TStringList.Create;
 try
 ADOConnection1.GetTableNames(SL, False);
 for index := 0 to (SL.Count - 1) do
 begin
 Table1.Insert;
 Table1.FieldByName('Name').AsString := SL[index];
 ADOTable1.TableName := SL[index];
 ADOTable1.Open;
 Table1.FieldByName('Records').AsInteger := ADOTable1.RecordCount;
 Table1.Post;
 end;
 finally
 SL.Free;
 ADOTable1.Close;
 end;
end;
; Комментарий Vit: открытие больших таблиц, особенно на удалённых серверах баз данных может быть исключительно длительным процессом. ADO оптимизированно для работы через запросы, поэтому количество записей можно значительно быстрее узнать составляя query и выполняя её:'''
procedure TForm1.Button1Click(Sender: TObject);
var
 SL: TStrings;
 index: Integer;
begin
 SL := TStringList.Create;
 try
 ADOConnection1.GetTableNames(SL, False);
 for index := 0 to (SL.Count - 1) do
 begin
 Table1.Insert;
 Table1.FieldByName('Name').AsString := SL[index];
 ADOQuery1.sql.text := 'Select Count(*) From ' + SL[index];
 ADOQuery1.Open;
 Table1.FieldByName('Records').AsInteger := ADOQuery1.Fields[0].AsInteger;
 Table1.Post;
 ADOQuery1.Close;
 end;
 finally
 SL.Free;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02660
Как узнать производителя CD/DVD?

=== Как узнать производителя CD/DVD? ===
Как это сделать через WMI я вроде разобрался.
Только не нравиться мне, что приходится перебирать в цикле все свойства
Win32_CDROMDrive. Может кто знает как сразу к конкретному свойству обратиться, т.е.
избавиться от строки "while PropEnum.Next(1, TempObj, Value) = S_OK do"
Вот рабочий пример для D7.
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, WbemScripting_TLB, OleServer, ActiveX, StdCtrls, ExtCtrls,
 ComCtrls;
type
 TForm1 = class(TForm)
 ListBox1: TListBox;
 SWbemLocator1: TSWbemLocator;
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
 Service: ISWbemServices;
 ObjectSet: ISWbemObjectSet;
 SObject: ISWbemObject;
 PropSet: ISWbemPropertySet;
 SProp: ISWbemProperty;
 PropEnum, Enum: IEnumVariant;
 TempObj: OleVariant;
 Value: Cardinal;
 dr: string;
begin
 ListBox1.Clear;
 Service := SWbemLocator1.ConnectServer('.', 'root\CIMV2', , , ,, 0, nil);
 SObject := Service.Get('Win32_CDROMDrive', wbemFlagUseAmendedQualifiers, nil);
 ObjectSet := SObject.Instances_(0, nil);
 Enum := (ObjectSet._NewEnum) as IEnumVariant;
 dr := ;
 while (Enum.Next(1, TempObj, Value) = S_OK) do
 begin
 SObject := IUnknown(TempObj) as SWBemObject;
 PropSet := SObject.Properties_;
 PropEnum := (PropSet._NewEnum) as IEnumVariant;
 while PropEnum.Next(1, TempObj, Value) = S_OK do
 begin
 SProp := IUnknown(TempObj) as SWBemProperty;
 if SProp.Name = 'Drive' then
 dr := SProp.Get_Value;
 if SProp.Name = 'Name' then
 ListBox1.AddItem(dr + ' ' + SProp.Get_Value, nil);
 end;
 end;
end;
end.
Source: Взято из http://forum.sources.ru
ID: 01410
Как узнать путь базы данных и её имя?

=== Как узнать путь базы данных и её имя? ===
Делается это при помощи dbiGetDatabaseDesc:
uses BDE;
procedure ShowDatabaseDesc(DBName: string);
const
 DescStr = 'Driver Name: %s'#13#10'AliasName: %s'#13#10 +
 'Text: %s'#13#10'Physical Name/Path: %s';
var
 dbDes: DBDesc;
begin
 dbiGetDatabaseDesc(PChar(DBName), @dbDes);
 with dbDes do
 ShowMessage(Format(DescStr, [szDbType, szName, szText, szPhyName]));
end;
Source: Взято из http://forum.sources.ru
ID: 02540
Как узнать путь к браузеру по умолчанию?

uses
 Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
 Reg: TRegistry;
 KeyName: string;
 ValueStr: string;
begin
 Reg := TRegistry.Create;
 try
 Reg.RootKey := HKEY_CLASSES_ROOT;
 KeyName := 'htmlfile\shell\open\command';
 if Reg.OpenKey(KeyName, False) then
 begin
 ValueStr := Reg.ReadString();
 Reg.CloseKey;
 Label1.Caption := ValueStr;
 end
 else
 ShowMessage('No Default Webbrowser !');
 finally
 Reg.Free;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03500
Category:Связь
Category:WebBrowser
Как узнать путь к программе, известно ее имя

=== Как узнать путь к программе, известно ее имя ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
uses
 TlHelp32;
function GetExeFilePath(ExeFileName: string): string;
var
 hSnapshot, hSnapshot2: THandle;
 Proc: TProcessEntry32;
 m: TModuleEntry32;
begin
 Result := ;
 hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
 try
 proc.dwSize := SizeOf(proc);
 if Process32First(hSnapshot, proc) then
 repeat
 if AnsiSameText(proc.szExeFile, ExeFileName) then
 begin
 hSnapshot2 := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, proc.th32ProcessID);
 try
 m.dwSize := SizeOf(TModuleEntry32);
 if Module32First(hSnapshot2, m) then
 begin
 Result := m.szExePath;
 Exit;
 end;
 finally
 CloseHandle(hSnapshot2);
 end;
 end;
 until not Process32Next(hSnapshot, proc);
 finally
 CloseHandle(hSnapshot);
 end;
end;
Author: Rouse_, P.O.D.
Source: Взято из http://forum.sources.ru
ID: 02121
Как узнать размер файла в интернете?

uses wininet;
function GetUrlSize(const URL: string): Integer; // результат в байтах
var
 hSession, hFile: hInternet;
 dwBuffer: array[1..20] of Char;
 dwBufferLen, dwIndex: DWORD;
begin
 Result := 0;
 hSession := InternetOpen('GetUrlSize', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
 if Assigned(hSession) then
 begin
 hFile := InternetOpenURL(hSession, PChar(URL), nil, 0, INTERNET_FLAG_RELOAD, 0);
 dwIndex := 0;
 dwBufferLen := 20;
 if HttpQueryInfo(hFile, HTTP_QUERY_CONTENT_LENGTH, @dwBuffer, dwBufferLen, dwIndex) then
 Result := StrToInt(StrPas(@dwBuffer));
 if Assigned(hFile) then InternetCloseHandle(hFile);
 InternetCloseHandle(hsession);
 end;
end;
Author: P.O.D.
Source: http://forum.sources.ru
ID: 03582
Category:Связь
Category:Web
Как узнать размеры шрифтов в Windows?

=== Как узнать размеры шрифтов в Windows? ===
GetTextMetrics() 
Author: Song
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01920
----
=== Как определить, какой шрифт установлен в системе, большой или маленький ===
Следующуя функция возвращает True, если маленькие шрифты установлены в системе. Так же можно заменить строку
 Result := (GetDeviceCaps(DC, logpixelsx) = 96);
на
 Result := (GetDeviceCaps(DC, logpixelsx) = 120);
чтобы определять - установлены ли в системе крупные шрифты.
function UsesSmallFonts: boolean; 
var 
 DC: HDC; 
begin 
 DC := GetDC(0); 
 Result := (GetDeviceCaps(DC, logpixelsx) = 96); 
 ReleaseDC(0, DC); 
end;
Source: Взято из http://forum.sources.ru
ID: 01921
Как узнать расход памяти процессом?

Расход памяти можно прочитать из виртуального файла
 /proc/Pid/status
где Pid - номер процесса
function ReadProcData(Pid: string; var VmSize, VmLck, VmRSS, VmData, VmStk, VmExe, VmLib, ProcName: string): Boolean;
var
 f: TextFile;
 s, stat: string;
 i: Integer;
 function GetBefore(subStr, str: string): string;
 begin
 if Pos(subStr, str) > 0 then
 Result := Copy(str, 1, Pos(subStr, str)-1)
 else
 Result := ;
 end;
 function GetAfter(subStr, str: string): string;
 begin
 if Pos(subStr, str) > 0 then
 Result := Copy(str, Pos(subStr, str) + Length(subStr), Length(str))
 else
 Result := ;
 end;
begin
 Result := False;
 FileMode := 0;
 VmSize := '-1';
 VmLck := '-1';
 VmRSS := '-1';
 VmData := '-1';
 VmStk := '-1';
 VmExe := '-1';
 VmLib := '-1';
 ProcName := ;
 try
 try
 try
 AssignFile(f, '/proc/' + Pid + '/status');
 Reset(f);
 while not Eof(f) do
 begin
 ReadLn(f, s);
 if Pos('VmSize', s) > 0 then VmSize := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('VmLck', s) > 0 then VmLck := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('VmRSS', s) > 0 then VmRSS := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('VmData', s) > 0 then VmData := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('VmStk', s) > 0 then VmStk := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('VmExe', s) > 0 then VmExe := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('VmLib', s) > 0 then VmLib := GetBefore(' ', Trim(GetAfter(':', s)));
 if Pos('Name', s) > 0 then ProcName := Trim(GetAfter(':', s));
 end;
 finally
 CloseFile(f);
 end;
 finally
 FileMode := 2;
 end;
 Result := True;
 except
 end;
end;
Примечание - функция может и не сработать, какие-то мгновения файл недоступен по чтению, выход - повторить процедуру.
Более подробную информацию можно получить запустив в консоли:
 man proc
Author: Vit
ID: 04627
Category:Kylix
Category:Linux
Как узнать свободное место на диске?

В коде используется функция ExecCmdine из статьи: Как запустить консольное приложение и перехватить вывод?
function GetFreeSpace(Share: string): Integer; { in Kb }
var
 t: TStringList;
 i: Integer;
 temp: string;
 mesure: Char;
 multi: Integer;
 f: Real;
 function GetBefore(subStr, str: string): string;
 begin
 if Pos(subStr, str) > 0 then
 Result := Copy(str, 1, Pos(subStr, str)-1)
 else
 Result := ;
 end;
 function GetAfter(subStr, str: string): string;
 begin
 if Pos(subStr, str) > 0 then
 Result := Copy(str, Pos(subStr, str) + Length(subStr), Length(str))
 else
 Result := ;
 end;
begin
 Result := -1;
 t := TStringList.Create;
 try
 ExecCmdine('df -h', t);
 for i:=0 to t.Count-1 do
 begin
 if Pos(Share, t[i]) = 1 then
 begin
 temp := Trim(GetAfter(Share, t[i]));
 temp := Trim(GetAfter(' ', temp));
 temp := Trim(GetAfter(' ', temp));
 temp := Trim(GetBefore(' ', temp));
 if temp = then exit;
 mesure := temp[Length(temp)];
 case mesure of
 'G', 'g': multi := 1024*1024;
 'M', 'm': multi := 1024;
 'K', 'k': multi := 1;
 else
 multi := 0;
 end;
 try
 f := StrToFloat(Copy(temp, 1, Length(temp)-1));
 except
 f := 0;
 end;
 Result := Round(f * multi);
 end;
 end;
 finally
 t.Free();
 end;
end;
Использование:
 GetFreeSpace('/dev/hda5')
Примечание - под отладчиком Kylix код может не работать. Надо запускать приложение не под Kylix для того чтобы удостовериться что код работает.
Более подробную информацию можно получить запустив в консоли:
 man df
Author: Vit
ID: 04629
Category:Kylix
Category:Linux
Как узнать серийный номер аудио CD?

=== Как узнать серийный номер аудио CD? ===
CD может иметь или не иметь серийный номер и/или универсальный код продукта (Universal Product Code). MCI-расширение Windows предоставляет эту информации с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает уникальную ID-строку. 
Пример:
uses MMSystem, MPlayer;
procedure TForm1.Button1Click(Sender: TObject);
var
 mp: TMediaPlayer;
 msp: TMCI_INFO_PARMS;
 MediaString: array[0..255] of char;
 ret: LongInt;
begin
 mp := TMediaPlayer.Create(nil);
 mp.Visible := False;
 mp.Parent := Application.MainForm;
 mp.Shareable := True;
 mp.DeviceType := dtCDAudio;
 mp.FileName := 'D:';
 mp.Open;
 Application.ProcessMessages;
 FillChar(MediaString, sizeof(MediaString), #0);
 FillChar(msp, SizeOf(msp), #0);
 msp.lpstrReturn := @MediaString;
 msp.dwRetSize := 255;
 ret := mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY,
 LongInt(@msp));
 if Ret <> 0 then
 begin
 MciGetErrorString(ret, @MediaString, sizeof(MediaString));
 Memo1.Lines.Add(StrPas(MediaString));
 end
 else
 Memo1.Lines.Add(StrPas(MediaString));
 mp.Close;
 Application.ProcessMessages;
 mp.Free;
end;
end.
 DELPHI VCL FAQ Перевод с английского
 Подборку, перевод и адаптацию материала подготовил Aziz(JINX)
 специально для Королевства Дельфи
Source: Взято из 
ID: 01401
Как узнать состояние клавиши CAPS LOCK?

=== Как узнать состояние клавиши CAPS LOCK? ===
function IsCapsLockOn : Boolean; 
begin 
 Result := 0 <> (GetKeyState(VK_CAPITAL) and $01); 
end;
Source: Взято из http://forum.sources.ru
ID: 01497
----
procedure TForm1.AppOnIdle(Sender: TObject; var Done: Boolean);
begin
 CheckBox1.Checked := Odd(GetKeyState(VK_CAPITAL));
 CheckBox2.Checked := Odd(GetKeyState(VK_SHIFT));
 CheckBox3.Checked := Odd(GetKeyState(VK_NUMLOCK));
 CheckBox4.Checked := Odd(GetKeyState(VK_SCROLL));
 Done := False;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnIdle := AppOnIdle;
end;
Source: http://delphiworld.narod.ru/
ID: 01498
Как узнать состояние модема в Win32?

=== Как узнать состояние модема в Win32? ===
Следующий пример демонстрирует получение состояния управляющих регистров модема.
Пример:
procedure TForm1.Button1Click(Sender: TObject); 
var 
 CommPort: string; 
 hCommFile: THandle; 
 ModemStat: DWord; 
begin 
 CommPort := 'COM2'; 
 { Открываем com-порт } 
 hCommFile := CreateFile(PChar(CommPort), 
 GENERIC_READ, 
 0, 
 nil, 
 OPEN_EXISTING, 
 FILE_ATTRIBUTE_NORMAL, 
 0); 
 if hCommFile = INVALID_HANDLE_VALUE then 
 begin 
 ShowMessage('Unable to open '+ CommPort); 
 exit; 
 end; 
 { Получаем состояние модема } 
 if GetCommModemStatus(hCommFile, ModemStat) <> false then
 begin 
 if ModemStat and MS_CTS_ON <> 0 then 
 ShowMessage('The CTS (clear-to-send) is on.'); 
 if ModemStat and MS_DSR_ON <> 0 then 
 ShowMessage('The DSR (data-set-ready) is on.'); 
 if ModemStat and MS_RING_ON <> 0then 
 ShowMessage('The ring indicator is on.'); 
 if ModemStat and MS_RLSD_ON <> 0 then 
 ShowMessage('The RLSD (receive-line-signal-detect) is on.'); 
 end; 
 { Закрываем com-порт } 
 CloseHandle(hCommFile); 
end;
Source: Взято из http://forum.sources.ru
ID: 01462
Как узнать статус меню?

=== Как узнать статус меню? ===
В чём вопрос: как узнать, нажат ли сейчас именно нужный пункт меню? Чтобы я в таймере мог его опрашивать на состояние. 
До тех пор, пока какая-то часть главного меню "выпала" (то есть нажат итем "Файл", и видны New, Open, Save etc.) нужно чё-то делать раз в полсекунды. То есть надо отловить момент, когда это самое меню закроется, чтобы перестать чё-то делать.
: 1) Событие OnClick - срабатывает на пункте если мы по нему кликнули или если данный пункт имеет подменю(а точнее подпункты) и оно активировалось... как следствие - повесив обработчик на OnClick мы можем узнать что меню активировалось и какое енто меню, а также узнать информацию о подменю(и при необходимости что нить изменить ).
: 2) Из ходя из 1 пункта мы знаем что меню... активно. Но нам надо знать что меню закрылось... для ентого ловим сообщение WM_CAPTURECHANGED или его не видно WM_UNINITMENUPOPUP. 
Пример для первого и второго пункта:
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, ExtCtrls, Menus, StdCtrls, ComCtrls;
type
 TForm1 = class(TForm)
 MainMenu1: TMainMenu;
 N1231: TMenuItem; // Какой то пункт
 N23551: TMenuItem; // Какой то пункт
 N1231231: TMenuItem; // Какой то пункт
 N1231111: TMenuItem; // Какой то пункт
 Timer1: TTimer; // Какой то пункт
 N2341: TMenuItem; // Какой то пункт
 N2342: TMenuItem; // Какой то пункт
 N234541: TMenuItem; // Какой то пункт
 N23421: TMenuItem; // Какой то пункт
 ertert1: TMenuItem; // Какой то пункт
 N1: TMenuItem; // Какой то пункт
 N123121: TMenuItem; // Какой то пункт
 N1231232: TMenuItem; // Какой то пункт
 N2343: TMenuItem; // Какой то пункт
 procedure Timer1Timer(Sender: TObject);
 procedure WndProc(var Message: TMessage); override;
 procedure N1231Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
 f: Boolean = False; // флаг активности
implementation
{$R *.dfm}
procedure TForm1.WndProc(var Message: TMessage);
begin
 if f then
 begin
 if (Message.Msg = WM_UNINITMENUPOPUP) then
 Caption := 'Мдя... Че-то меня не видно! Но я активен!'
 else
 if (Message.Msg = WM_CAPTURECHANGED) then
 begin
 Caption := 'Ёпс!... ты че вышел?';
 f := False; // Сбрасываем флаг активности
 end
 else
 inherited;
 end
 else
 inherited;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 EndMenu; // закрываем меню
 Timer1.Enabled := False;
end;
// Вешаем на все пункты меню :)
procedure TForm1.N1231Click(Sender: TObject);
begin
 Caption := IntToStr(TMenuItem(Sender).MenuIndex);
 if (TMenuItem(Sender).Count > 0) then
 begin
 if f = false then
 begin
 Timer1.Interval := 10000; // Ставим таймер для автоматического закрытия
 Timer1.Enabled := True;
 Timer1.OnTimer := Timer1Timer;
 end;
 f := True; // меню активировано!
 end;
end;
end. 
Author: Girder 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01306
Как узнать существует ли страница (worksheet)?

WB := Excel.Workbooks[1];
for Idx := 1 to WB.Worksheets.Count do
 if WB.Worksheets[Idx].Name = 'first' then
 Showmessage('Found the worksheet');
Source: Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04386
Category:COM
Category:MS Office
Как узнать тип соединения с интернетом?

uses
 WinInet;
const
 MODEM = 1;
 LAN = 2;
 PROXY = 4;
 BUSY = 8;
function GetConnectionKind(var strKind: string): Boolean;
var
 flags: DWORD;
begin
 strKind := ;
 Result := InternetGetConnectedState(@flags, 0);
 if Result then
 begin
 if (flags and MODEM) = MODEM then strKind := 'Modem';
 if (flags and LAN) = LAN then strKind := 'LAN';
 if (flags and PROXY) = PROXY then strKind := 'Proxy';
 if (flags and BUSY) = BUSY then strKind := 'Modem Busy';
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 strKind: string;
begin
 if GetConnectionKind(strKind) then
 ShowMessage(strKind);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03574
Category:Связь
Как узнать установлен ли activeX на машине?

{ ... }
var
 strOLE: string;
begin
 strOLE = "YourCOMServer.Application" {your ProgID}
 if (CLSIDFromProgID(PWideChar(WideString(strOLE), ClassID) = S_OK) then
 begin
 { ... }
 end;
end;
ID: 04348
----
{ ... }
const
 cKEY = '\SOFTWARE\Classes\CLSID\%s\InprocServer32'
 var
 sKey: string;
 sComServer: string;
 exists: Boolean;
 Reg: TRegistry;
begin
 Reg := TRegistry.Create;
 try
 Reg.RootKey := HKEY_LOCAL_MACHINE;
 sKey := Format(cKEY, [GuidToString(ClassID)]);
 if Reg.OpenKey(sKey, False) then
 begin
 sComServer := Reg.ReadString();
 if FileExists(sComServer) then
 begin
 { ... }
 end;
 end;
 finally
 Reg.free;
 end;
end;
Source: http://www.baltsoft.com/
ID: 04349
Category:COM
Category:ActiveX
Как узнать физические координаты каретки в пикселях?

=== Как узнать физические координаты каретки в пикселях? ===
{ TRichEdit }
var
 pt: TPoint;
begin
 with richedit1 do
 begin
 Perform(messages.EM_POSFROMCHAR, WPARAM(@pt), selstart);
 label1.caption := Format('(%d, %d)', [pt.x, pt.y]);
 end;
end;
{ TMemo and TEdit }
var
 r: LongInt;
begin
 with memo1 do
 begin
 r := Perform(messages.EM_POSFROMCHAR, selstart, 0);
 if r >= 0 then
 begin
 label1.caption := IntToStr(HiWord(r));
 label2.caption := IntToStr(LoWord(r));
 end;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 00537
Как узнать физическое расположение локальной БД по Alias?

=== Как узнать физическое расположение локальной БД по Alias? ===
==== По Table(Query).Database ====
uses
 DbiProcs;
function GetDirByDatabase(Database: TDatabase): string;
var
 pszDir: PChar;
begin
 pszDir := StrAlloc(255);
 try
 DbiGetDirectory(Database.Handle, True, pszDir);
 Result := StrPas(pszDir);
 finally
 StrDispose(pszDir);
 end;
end;
==== По алиасу ====
function GetPhNameByAlias(sAlias: string): string;
var
 Database: TDatabase;
 pszDir: PChar;
begin
 Database := TDatabase.Create(nil); {allocate memory}
 pszDir := StrAlloc(255);
 try
 Database.AliasName := sAlias;
 Database.DatabaseName := 'TEMP'; {requires a name -- is ignored}
 Database.Connected := True; {connect without opening any table}
 DbiGetDirectory(Database.Handle, True, pszDir); {get the dir.}
 Database.Connected := False; {disconnect}
 Result := StrPas(pszDir); {convert to a string}
 finally
 Database.Free; {free memory}
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02538
=== См.также ===
* Как по Alias узнать физический путь к базе данных?
Как узнать форма активна или нет?

=== Как узнать форма активна или нет? ===
type
 //...
 private
 { Private declarations }
 procedure WMNCACTIVATE(var M: TWMNCACTIVATE); message WM_NCACTIVATE;
 end;
implementation
//...
procedure TForm1.WMNCACTIVATE(var M: TWMNCACTIVATE);
begin
 inherited;
 if M.Active then
 Caption := 'Form active'
 else
 Caption := 'Form not active';
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00424
Как узнать частоту обновления монитора?

=== Как узнать частоту обновления монитора? ===
function GetDisplayFrequency: Integer; 
var 
 DeviceMode: TDeviceMode; 
begin 
 EnumDisplaySettings(nil, Cardinal(-1), DeviceMode); 
 Result := DeviceMode.dmDisplayFrequency; 
end;
Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01458
Как узнать что MIDI форма изменила статус?

=== Как узнать что MIDI форма изменила статус? ===
 private
 procedure WMSize(var msg: TWMSize); message WM_SIZE;
implementation
procedure TChildForm.WMSize( Var msg: TWMSize );
begin
 inherited;
 if msg.SizeType = SIZE_MINIMIZED then
 {...}
end;
ID: 00503
Как узнать является ли окно Unicode?

=== Как узнать является ли окно Unicode? ===
{
 The IsWindowUnicode function
 determines whether the specified window is a native Unicode window
 The character set of a window is determined by the use of the RegisterClass function.
 If the window class was registered with the ANSI version of RegisterClass (RegisterClassA),
 the character set of the window is ANSI. If the window class was registered with the Unicode
 version of RegisterClass (RegisterClassW), the character set of the window is Unicode.
 The system does automatic two-way translation (Unicode to ANSI) for window messages.
 For example, if an ANSI window message is sent to a window that uses the Unicode character set,
 the system translates that message into a Unicode message before calling the window procedure.
 The system calls IsWindowUnicode to determine whether to translate the message.
}
procedure TForm1.Button1Click(Sender: TObject);
begin
 { determine if the window is a Unicode window }
 if (IsWindowUnicode(Form1.Handle)) then
 Button1.Caption := 'This window is a Unicode window'
 else
 Button1.Caption := 'This window is not a Unicode window'
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01971
Как указать максимальный размер текста для RichEdit Control?

=== Как указать максимальный размер текста для RichEdit Control? ===
У этого компонента есть свойство MaxLength, которое работает некорректно. Поэтому лучше пользоваться
 RichEdit.Perform(EM_LIMITTEXT, нужный размер, 0); 
Причем перед каждом открытии файла это действие необходимо повторять.
Maxim Liverovskiy (2:5030/254.38)
Если Вы передаете в качестве размера 0, то ОС ограничивает размер OS Specific Default Value. Реально, по результатам моих экспериментов, поставить можно размер, чуть меньший доступной виртуальной памяти. Я ограничился 90% от свободной виртуалки.
Для того, чтобы не повторять этот вызов (EM_LIMITTEXT), можно воспользоваться сообщением EM_EXLIMITTEXT.
Stas Mehanoshin
Author: StayAtHome
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00573
Как уменьшить дату в Paradox

=== Как уменьшить дату в Paradox ===
В Local SQL для Paradox имеется ошибка, вместо вычитания происходит сложение даты с константой.
-- Это добавляет единицу!
UPDATE SAMPLE.DB SET DT = DT - 1
-- а данное выражение даст правильный результат:
UPDATE SAMPLE.DB SET DT = DT + (-1)
Source: Взято с сайта http://www.delphifaq.com
ID: 02955
Category:Базы данных
Category:Paradox