nyuuzyou/wikis huggingface dataset:
Имитировать события мыши

=== Имитировать события мыши ===
В этом примере курсор мыши сам встает на кнопку и нажимает на нее.
procedure TForm1.Timer1Timer(Sender: TObject);
var
 p: TPoint;
begin
 p := Point(Button1.Left + Button1.Width div 2, Button1.Top + Button1.Height div 2);
 p := Form1.ClientToScreen(p);
 SetCursorPos(p.x, p.y);
 p := Point(Round(p.x * 65535 / Screen.Width),
 Round(p.y * 65535 / Screen.Height));
 Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, p.x, p.y, 0, 0);
 Application.ProcessMessages;
 Sleep(100);
 Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, p.x, p.y, 0, 0);
 Application.ProcessMessages;
 Sleep(300);
 Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, p.x, p.y, 0, 0);
end;
 e-mail: delphi4all@narod.ru
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: Алексей Денисов
ID: 01587
Импорт CSV ASCII

=== Импорт CSV ASCII ===
unit Cdbascii;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, DbiErrs, DbiTypes, DbiProcs, DB, DBTables;
type
 TAsciiDelimTable = class(TTable)
 private
{ Private declarations }
 fQuote: Char;
 fDelim: Char;
 protected
{ Protected declarations }
 function CreateHandle: HDBICur; override;
 procedure SetQuote(newValue: Char);
 procedure SetDelim(newValue: Char);
 public
{ Public declarations }
 constructor Create(AOwner: TComponent); override;
 destructor Destroy; override;
{ Эти свойства не должны больше публиковаться }
 property IndexFieldNames;
 property IndexName;
 property MasterFields;
 property MasterSource;
 property UpdateMode;
 published
{ Published declarations }
 property Quote: Char read fQuote write setQuote default '"';
 property Delim: Char read fDelim write setDelim default ',';
 end;
procedure Register;
implementation
uses DBConsts;
procedure Register;
begin
 RegisterComponents('Data Access', [TAsciiDelimTable]);
end;
constructor TAsciiDelimTable.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 Exclusive := True;
 TableType := ttASCII;
 fQuote := '"';
 fDelim := ',';
end;
destructor TAsciiDelimTable.Destroy;
begin
 inherited Destroy;
end;
{ Рабочий код }
function CheckOpen(Status: DBIResult): Boolean;
begin
 case Status of
 DBIERR_NONE:
 Result := True;
 DBIERR_NOTSUFFTABLERIGHTS:
 begin
 if not Session.GetPassword then DbiError(Status);
 Result := False;
 end;
 else
 DbiError(Status);
 end;
end;
function TAsciiDelimTable.CreateHandle: HDBICur;
const
 OpenModes: array[Boolean] of DbiOpenMode = (dbiReadWrite, dbiReadOnly);
 ShareModes: array[Boolean] of DbiShareMode = (dbiOpenShared, dbiOpenExcl);
var
 STableName: array[0..SizeOf(TFileName) - 1] of Char;
 SDriverType: array[0..12] of Char;
begin
 if TableName = then DBError(SNoTableName);
 AnsiToNative(DBLocale, TableName, STableName, SizeOf(STableName) - 1);
 StrPCopy(SDriverType, 'ASCIIDRV-' + Quote + '-' + Delim);
 Result := nil;
 while not CheckOpen(DbiOpenTable(DBHandle, STableName, SDriverType,
 nil, nil, 0, OpenModes[ReadOnly], ShareModes[Exclusive],
 xltField, False, nil, Result)) do {Повтор}
 ;
end;
procedure TAsciiDelimTable.SetQuote(newValue: Char);
begin
 if Active then
{ DBError(SInvalidBatchMove); };
 fQuote := newValue;
end;
procedure TAsciiDelimTable.SetDelim(newValue: Char);
begin
 if Active then
{ DBError(SInvalidBatchMove); };
 fDelim := newValue;
end;
end.
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02967
Category:Базы данных
Category:CSV
Импорт активного документа Word

{ **** UBPFD *********** by kladovka.net.ru ****
>> Импорт активного документа Word
Импортирует текст активного документа Word в объект класса TStrings (без форматирования). Если при открытом Worde результат отрицательный - рекомендуется перезапустить приложение, поскольку дальнейшие вызовы функции в подавляющем большинстве случаев будут приводить к ошибке
Зависимости: OleServer, Word97
Автор: Dimka Maslov, mainbox@endimus.com, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 6 февраля 2004 г.
********************************************** }
function ImportWordActiveDocument(Strings: TStrings): Boolean;
var
 Word: TWordApplication;
 Start, End_: Integer;
begin
 Result := True;
 try
 Word := TWordApplication.Create(nil);
 try
 Word.AutoConnect := False;
 Word.AutoQuit := False;
 Word.ConnectKind := ckRunningInstance;
 Word.Connect;
 Start := Word.Selection.Get_Start;
 End_ := Word.Selection.Get_End_;
 Word.Selection.SetRange(0, $7FFFFFFF);
 Strings.Text := Word.Selection.Text;
 Word.Selection.SetRange(Start, End_);
 Word.Disconnect;
 finally
 Word.Free;
 end;
 except
 Result := False;
 end;
end;
Пример использования:
if not ImportWordActiveDocument(Memo1.Lines) then
 ShowMessage('Error');
Author: Dimka Maslov
ID: 04438
Category:COM
Category:MS Office
Импорт большого CSV файла

=== Импорт большого CSV файла ===
var
 s: string;
 f: TextFile;
begin
 AssignFile(f, 'D:\\INPUT.TXT');
 Reset(f);
 while not EOF(f) do
 begin
 ReadLn(s, f);
 ShowMessage(GetField(s, 1)); {The first field\}
 ShowMessage(GetField(s, 6)); {The sixth field\}
 ShowMessage(GetField(s, 25)); {will return if no 25 column...\}
 end;
 CloseFile(f);
end;
{ ==== This function will return a field from a delimited string. ==== \}
function GetField(InpString: string; fieldpos: Integer): string;
var
 c: Char;
 curpos, i: Integer;
begin
 curpos := 1;
 for i := 1 to fieldpos do
 begin
 Result := ;
 if curpos > Length(InpString) then Break;
 repeat
 c := InpString[curpos];
 Inc(curpos, 1);
 if (c = '"') or (c = #13) or (c = #10) then c := ' ';
 if c <> ',' then Result := Result + c;
 until (c = ',') or (curpos > Length(InpString))
 end;
 if (curpos > Length(InpString)) and (i < fieldpos) then Result := ;
 Result := Trim(Result);
end;
{ ==== This function will trim a string removing spaces etc. ==== \}
function Trim(inp_str: string): string;
var
 i: Integer;
begin
 for i := 1 to Length(inp_str) do
 if inp_str[i] <> ' ' then Break;
 if i > 1 then Delete(inp_str, 1, i - 1);
 for i := Length(inp_str) downto 1 do
 if inp_str[i] <> ' ' then Break;
 if i < Length(inp_str) then
 Delete(inp_str, i + 1, Length(inp_str));
 result := inp_str;
 if result = ' ' then result := ;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02969
Category:Базы данных
Category:CSV
Имя класса компонента и модуля

=== Имя класса компонента и модуля ===
Мне необходима функция, которая возвращала бы имя класса компонента и имя модуля, где определен данный класс. 
Например: xxx('TPanel') возвращала бы 'ExtCtrls' 
Также мне необходима функция, возвращающая список имен страниц палитры компонентов.
Uses TypInfo;
Function ObjectsUnit (Obj: TClass): String; 
Begin
 Result := GetTypeData(PTypeInfo(Obj.ClassInfo))^.UnitName
end;
Для создания описанной вами функции "Какой модуль" могут использоваться описанные в TOOLINTF.INT методы GetModuleCount, GetModuleName, GetComponentCount и GetComponentName. 
Для получения представления о формате палитры компонентов обратитесь к файлу DELPHI.INI.
Source: Взято с http://delphiworld.narod.ru
ID: 00287
Имя пользователя Paradox

=== Имя пользователя Paradox ===
Вы можете выполнить эту задачу, непосредственно обращаясь к BDE. Включите следующие модули в секцию Uses вашего модуля: DBIPROCS, DBIERRS, DBITYPES
Ниже приведена функция с именем ID, возвращающая сетевое имя входа:
function ID: string;
var
 rslt: DBIResult;
 szErrMsg: DBIMSG;
 pszUserName: PChar;
begin
 try
 Result := ;
 pszUserName := nil;
 GetMem(pszUserName, SizeOf(Char) * DBIMAXXBUSERNAMELEN);
 rslt := DbiGetNetUserName(pszUserName);
 if rslt = DBIERR_NONE then
 Result := StrPas(pszUserName)
 else
 begin
 DbiGetErrorString(rslt, szErrMsg);
 raise Exception.Create(StrPas(szErrMsg));
 end;
 FreeMem(pszUserName, SizeOf(Char) * DBIMAXXBUSERNAMELEN);
 pszUserName := nil;
 except
 on E: EOutOfMemory do ShowMessage('Ошибка. ' + E.Message);
 on E: Exception do ShowMessage(E.Message);
 end;
 if pszUserName <> nil then FreeMem(pszUserName, SizeOf(Char) * DBIMAXXBUSERNAMELEN);
end;
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02945
Category:Базы данных
Category:Paradox
Инверсия всех цветов в TBitmap

function InvertBitmap(Bmp: TBitmap): TBitmap;
var
 x, y: integer;
 ByteArray: PByteArray;
begin
 Bmp.PixelFormat := pf24Bit;
 for y := 0 to Bmp.Height - 1 do
 begin
 ByteArray := Bmp.ScanLine[y];
 for x := 0 to Bmp.Width * 3 - 1 do
 begin
 ByteArray[x] := 255 - ByteArray[x];
 end;
 end;
 Result := Bmp;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Image1.Picture.Bitmap := InvertBitmap(Image1.Picture.Bitmap);
end;
Author: Song
Source: http://forum.sources.ru
ID: 03865
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Инверсия всех цветов Bitmap
Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
procedure InvertBitmap(Bitmap: TBitmap);
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y: Integer;
 Dest: pRGB;
begin
 Bitmap.PixelFormat := pf24Bit;
 for y := 0 to Bitmap.Height - 1 do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to Bitmap.Width - 1 do
 begin
 with Dest^ do
 begin
 R := 255 - R;
 G := 255 - G;
 B := 255 - B;
 end;
 Inc(Dest);
 end;
 end;
end;
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03866
Category:Графика
Category:Bitmap
Category:Цвета и палитры
Инверсия цветов

function InvertBitmap(Bmp: TBitmap): TBitmap;
var
 x, y: integer;
 ByteArray: PByteArray;
begin
 Bmp.PixelFormat := pf24Bit;
 for y := 0 to Bmp.Height - 1 do
 begin
 ByteArray := Bmp.ScanLine[y];
 for x := 0 to Bmp.Width * 3 - 1 do
 begin
 ByteArray[x] := 255 - ByteArray[x];
 end;
 end;
 Result := Bmp;
end;
ПРИМЕР ИСПОЛЬЗОВАНИЯ:
procedure TForm1.Button1Click(Sender: TObject);
begin
 Image1.Picture.Bitmap := InvertBitmap(Image1.Picture.Bitmap);
end;
Author: Song
Source: http://forum.sources.ru
ID: 03712
Category:Графика
Category:Цвета и палитры
Индекс БД в другом каталоге

=== Индекс БД в другом каталоге ===
Подскажите как работать c dbf под Delphi 5 , когда индексы расположены в другом каталоге?
Serg (10.01.01 19:54) можно сделать следующее:
Vnhead_Cdx := TStringList.Create;
Vnhead_Cdx.Add('c:\parus\bumi1\idx\vnhead.cdx');
Vnhead.IndexFiles := Vnhead_Cdx;
при это сам dbf находится в c:\parus\bumi1\dbf
Source: Взято с сайта http://blackman.wp-club.net/
ID: 02628
Инкрементальный поиск в ListBox

=== Инкрементальный поиск в ListBox ===
Я видел приложение, в котором ListBox позволял осуществлять инкрементальный поиск. При вводе очередного символа он позиционирует вас к первой ячейке, начало значения которой совпадает с введенным пользователем текстом, или выделяет все строки с текстом, содержащим введенный текст. 
Как это осуществить на Delphi? 
Здесь придется немного воспользоваться Win API. Установите свойство формы KeyPreview в True и сделайте примерно следующее:
unit LbxSrch;
interface
uses
 Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;
type
 TFrmLbxSrch = class(TForm)
 Edit1: TEdit;
 Edit2: TEdit;
 ListBox1: TListBox;
 Label1: TLabel;
 procedure FormKeyPress(Sender: TObject; var Key: Char);
 procedure ListBox1Enter(Sender: TObject);
 private { Private declarations }
 FPrefix: array[0..255] of char;
 public
 { Public declarations }
 end;
var
 FrmLbxSrch: TFrmLbxSrch;
implementation
{$R *.DFM}
{ Помните о том, что свойство KeyPreview должно быть установлено в True }
procedure TFrmLbxSrch.FormKeyPress(Sender: TObject; var Key: Char);
var
 curKey: array[0..1] of char;
 ndx: integer;
begin
 if ActiveControl = ListBox1 then
 begin
 if key = #8 then // Backspace (клавиша возврата)
 begin
 if FPrefix[0] <> #0 then
 begin
 FPrefix[StrLen(FPrefix) - 1] := #0;
 end
 end
 else
 begin
 curKey[0] := Key;
 curKey[1] := #0;
 StrCat(FPrefix, curKey);
 ndx := SendMessage(ListBox1.Handle, LB_FINDSTRING, -1, longint(@FPrefix));
 if ndx <> LB_ERR then
 ListBox1.ItemIndex := ndx;
 end;
 Label1.Caption := StrPas(FPrefix);
 Key := #0;
 end;
end;
procedure TFrmLbxSrch.ListBox1Enter(Sender: TObject);
begin
 FPrefix[0] := #0;
 Label1.Caption := StrPas(FPrefix);
end;
end.
Author: Ralph Friedman 
Source: Взято с http://delphiworld.narod.ru
ID: 00660
----
Предположим, что ListBox сортируется, это не трудно. Вы должны разместить компонент Edit выше ListBox и создать следующий обработчик его случая OnChange:
procedure TForm1.Edit1Change(Sender: TObject);
var
 Ndx: Word;
begin
 with Sender as TEdit do
 begin
 Ndx := ListBox1.Items.Add(Text);
 ListBox1.Items.Delete(Ndx);
 if CompareText(Text, Copy(ListBox1.Items[Ndx], 1, Length(Text))) = 0 then
 ListBox1.ItemIndex := Ndx
 else
 ListBox1.ItemIndex := -1;
 end;
end;
Пытаясь вставить часть текста, вы просто просматриваете список на предмет его наличия. Если актуальный элемент в этой позиции содержит "частичный" текст, мы выводим его, в противном случае делаем так, чтобы ListBox не имел выделенного (ItemIndex) элемента.
Source: Взято с http://delphiworld.narod.ru
ID: 00661
Инкрементация строкового поля

=== Инкрементация строкового поля ===
Свойства text элемента управления является строкой, в свою очередь являющейся массивом символом. Вы не можете осуществить преобразование символа в строку. Тем не менее, вы можете получить доступ ко всем символам строки через их индекс. 
Попробуйте это:
var
 s: string;
begin
 s := RevField.text;
 s[1] := chr(ord(s[1]) + 1);
 RevField.text := s;
end;
Здесь кроется 2 проблемы:
Для увеличения значения вам необходимо извлекать символы из строки. 
Хотя вы можете получить доступ к отдельным символам через выделение подстроки, данный метод не срабатывает у некоторых свойств, таких как, например, свойство TStringField Text. 
Лучшим решением, по-видимому, будет написание специфической функции. Например, в случае, если revision-символ всегда является конечным символом строки, функция могла бы выглядеть следующим образом:
function IncrementTrailingVersionLetter(Str: string): string;
begin 
 Str[Length(Str)] := Char(Ord(Str[Length(Str)]) + 1);
 IncrementTrailingVersionLetter := Str;
end;
и использовать ее следующим образом:
with RevField do
 Text := IncrementTrailingVersionLetter(Text);
Source: Взято с http://delphiworld.narod.ru
ID: 00167
Инсталляция Screen Saver

=== Инсталляция Screen Saver ===
uses
 shellapi;
procedure InstallScreenSaver(const FileName: string);
begin
 { Set this screensaver as default screensaver and open the properties dialog}
 ShellExecute(Application.Handle, 'open', PChar('rundll32.exe'),
 PChar('desk.cpl,InstallScreenSaver ' + FileName), nil, SW_SHOWNORMAL);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 InstallScreenSaver('c:\YourScreenSaverFile.scr');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02381
Интерактивные SQL-запросы

=== Интерактивные SQL-запросы ===
Как мне передать значение переменной в SQL-запросе? К примеру, в обработчике onClick клавиши вывести все записи с величиной поля большей, чем задал пользователь. Можно ли в Delphi создать что-либо подобное механизму запросов, реализованному в Paradox for Windows?
Решение этой задачи в Delphi подобно созданию и выполнению строки запроса SQL в Paradox.
Pdoxwin код:
method pushButton(var eventInfo Event)
var
s string
q query
d database
endvar
d.open( "MYALIAS" )
s = "select * from mytable where somefield=\"" + entryField.value + "\""
q.readFromString( s )
q.executeSQL( d )
endmethod
Delphi код:
procedure TForm1.Button1Click(Sender: TObject);
begin
 MyQuery.Active := false;
 MyQuery.SQL.clear;
 MyQuery.SQL.add('select * from mytable where somefield="' +
 EntryField.Text + '"');
 MyQuery.Active := true;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03101
Category:Базы данных
Category:Paradox
Интерфейс OLE AutoServer

Я пытаюсь создать in-process oleserver с возможностью обратного вызова (callback). Я хочу передавать мой ole-объект MS C++ dll так, чтобы DLL могла бы вызываться из сервера. Проблема в том, что dll "вылетает", если мой сервер - Delphi 2.0, но работает в VB 4.0
Проблема в том, что вы передаете со стороны Delphi Variant, но на стороне C++ "ожидают" IUnknown. Измените прототип функции Delphi следующим образом:
function SmtOleLink(OleCallBack: IUnknown; ...) ...;
Для получения доступа к типу IUnknown необходимо добавить "Ole2" к списку используемых модулей. Теперь измените вызов со стороны Delphi:
SmtOleLink(VarToInterface(MyObject), 16, 0);
Функция "VarToInterface" (определенная в модуле OleAuto) извлекает указатель IDispatch из Variant (или возбуждает исключение, если Variant не содержит ссылки на объект OLE Automation).
Это должно сработать.
Author: Anders Hejlsberg 
Source: http://delphiworld.narod.ru
ID: 04324
Category:COM
Информационная система

=== Информационная система ===
Информационная система вообще - это некий механизм для хранения, поиска, извлечения и модификации некоторой информации. Прообразом современных информационных систем могут служить мудрецы и летописцы, им на смену пришли архивы и библиотечное дело. Современные информационные системы базируются на компьютерной технологиях. Задачи информационных систем остались, тем не менее, прежними.
Классический пример информационной системы - это система резервирования авиабилетов. В ней хранится информация о рейсах, о том, сколько и какого класса места есть на каждом рейсе, сколько билетов продано и сколько зарезервировано и т.д.
Оператор, работая с такой системой, ничего не знает про то, как хранится и обновляется информация, про то, как вообще сделана эта система. Оператор знает как работать с этой системой - для бронирования авиабилета он выбирает кнопку с названием "Забронировать место", а не "добавить такие-то данные в такой-то файл". Тем не менее, нажатие этой кнопки приводит именно к некоторым изменениям в данных, отражающих факт резервирования билета на какой-то рейс. А другой оператор, попытающийся зарезервировать билеты на этот же самый рейс, должен увидеть на одно свободное место меньше.
Информационная система - это комплексная система, включающая организационную часть, аппаратное и программное обеспечение и, собственно, информацию. В той же системе резервирования авиабилетов есть и терминалы для работы операторов, и компьютеры, в которых хранится вся эта информация, и специальная служба, которая отвечает за установку новых рабочих мест и т.д. Для занесения информации о новых рейсах существует специальная методика и есть люди, отвечающие за своевременное обновление такой информации.
Author: Грачев А.Ю.
Source: Введение в СУБД Informix
ID: 02443
Category:Базы данных
Category:Статьи
Информация о BMP-файлах

{
 This tip show, how to get the filesize, width, height, bitcount and color used
 from a bitmap.
 Dieses Beispiel zeigt, wie man Dateigrosse, breite, hohe, Farbtiefe und Farbanzahl
 von einem Bitmap ausliest.
}
procedure TForm1.Button1Click(Sender: TObject);
var
 FileHeader: TBitmapFileHeader;
 InfoHeader: TBitmapInfoHeader;
 s: TFileStream;
begin
 s := TFileStream.Create('c:\YourBitmap.bmp', fmOpenRead);
 try
 s.Read(FileHeader, SizeOf(FileHeader));
 s.Read(InfoHeader, SizeOf(InfoHeader));
 finally
 s.Free;
 end;
 ListBox1.Items.Clear;
 ListBox1.Items.Add('Filesize: ' + IntToStr(FileHeader.bfSize));
 ListBox1.Items.Add('Width: ' + IntToStr(InfoHeader.biWidth));
 ListBox1.Items.Add('Height: ' + IntToStr(InfoHeader.biHeight));
 ListBox1.Items.Add('BitCount: ' + IntToStr(InfoHeader.biBitCount));
 ListBox1.Items.Add('Used: ' + IntToStr(InfoHeader.biClrUsed));
end;
{
 BitCount:
 1 = black/white
 4 = 16 colors
 8 = 256 colors
}
ID: 03781
Category:Графика
Category:Bitmap
Информация о TClass

=== Информация о TClass ===
TObject - "корневой" объект.
TClass определен как Class of TObject. Переменная Class НЕ является указателем на экземпляр объекта. Это указатель на ТИП объекта Class.
var
 Obj1: TWinControl;
 Class1: class of TWinControl;
Class1 := TWinControl - правильное присваивание. Мы не распределяем память, у нас нет экземпляра TWinControl, мы не можем вызвать Class1.OnClick.
Class1 - это тип TWinControl с тем же контекстом использования, что и "TWinControl".
Поскольку мы можем использовать TWinControl.Create, то также мы можем использовать и Class1.Create, при этом создавая новый экземпляр TWinControl.
С тех пор как TEdit - наследник TWinControl, Class1 := TEdit правильное присваивание и Class1.Create создает экземпляр TEdit.
Если у меня имеется переменная Obj2: TWinControl, и даже если я присвоил экземпляр TListbox Obj2, я не могу ссылаться на Obj2.Items, поскольку Obj2 определен как TWinControl, а TWinControl не имеет свойства Items.
Те же характеристики верны и для Class1. Class1 определен как Class of TWinControl, поэтому они имеют общий конструктор, определенный в классе TWinControl.
Это не пугает меня при создании дополнительных типов:
TMyObj1 = class(TEdit)
 constructor CreateMagic; virtual;
end;
TMyObj2 = class(TMyObj1)
 constructor CreateMagic; override;
end;
TMyClass = class of TMyObj;
var
 MyObj1: TMyObj1;
 MyObj2: TMyObj2;
function MakeAnother(AClass: TMyClass): TMyObj1;
begin
 Result := AClass.CreateMagic;
end;
begin
 MyObj2 := TMyObj2.CreateMagic;
 MyObj1 := MakeAnother(MyObj2.ClassType);
end.
Source: из Советов по Delphi от Валентина Озерова, Сборник Kuliba
ID: 00117
Информация о логических дисках

=== Информация о логических дисках ===
Теперь об информации о дисках: 
исчерпывающую информацию по этому поводу дает функция GetVolumeInformation,
посмотри help, там все понятно (там и серийный номер диска, и тип файловой системы, и прочее и прочее).
Вот параметры FileSysFlags:
 FS_CASE_IS_PRESERVED - (при записи на диск сохраняется регистр букв в его имени)
 FS_CASE_SENSITIVE - (поддерживается поиск файлов с учетом регистра букв)
 FS_UNICODE_STORED_ON_DISK - (поддерживается сохранение имен файлов в UniCode)
 FS_PERSISTENT_ACLS - (поддерживаются списки контроля доступа (ACL). Только для NTFS)
 FS_FILE_COMPRESSION - (поддерживается сжатие файлов на уровне системы)
 FS_VOL_IS_COMPRESSED - (устройство представляет собой сжатый диск)
Определение типа диска:
function GetDriveType(Drive: Byte): string;
var
 DriveLetter: Char;
 DriveType: uInt;
begin
 DriveLetter := Char(Drive + $41);
 DriveType := GetDriveType(PChar(DriveLetter + ':\'));
 case DriveType of
 0: Result := '?';
 1: Result := 'Path does not exists';
 Drive_Removable: Result := 'Removable';
 Drive_Fixed: Result := 'Fixed';
 Drive_Remote: Result := 'Remote';
 Drive_CDROM: Result := 'CD-ROM';
 Drive_RamDisk: Result := 'RAMDisk'
 else Result := 'Unknown';
 end;
end;
Может так попробовать:
procedure TMainForm.btnGetHandleClick(Sender: TObject);
var
 DriveHandle : HWND;
begin
 case Win32Platform of
 VER_PLATFORM_WIN32_NT:
 begin
 DriveHandle := CreateFile ('\\.\Scsi0:', GENERIC_READ+GENERIC_WRITE,
 FILE_SHARE_READ+FILE_SHARE_WRITE, nil, 
 OPEN_EXISTING, 0, 0);
 if DriveHandle <> INVALID_HANDLE_VALUE then
 MessageBox (MainForm.Handle, PChar(IntToStr(DriveHandle)),
 PChar('Here is your handle:'), MB_ICONINFORMATION)
 else
 MessageBox (MainForm.Handle, PChar('Error!'), PChar('Error'), 
 MB_ICONERROR);
 end;
 VER_PLATFORM_WIN32_WINDOWS:
 begin
 DriveHandle := CreateFile ('\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
 if DriveHandle <> INVALID_HANDLE_VALUE then
 MessageBox (MainForm.Handle, PChar(IntToStr(DriveHandle)), 
 PChar('Here is your handle:'), MB_ICONINFORMATION)
 else
 MessageBox (MainForm.Handle, PChar('Error!'), PChar('Error'), MB_ICONERROR);
 end;
 end; // case
end;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01371