nyuuzyou/wikis huggingface dataset:
Пример очистки куков и Temporaly Internet Files

=== Пример очистки куков и Temporaly Internet Files ===
uses WinInet;
procedure DeleteCache; 
var 
 lpEntryInfo: PInternetCacheEntryInfo; 
 hCacheDir: LongWord; 
 dwEntrySize: LongWord; 
begin 
 dwEntrySize := 0; 
 FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize); 
 GetMem(lpEntryInfo, dwEntrySize); 
 try
 if dwEntrySize > 0 then
 lpEntryInfo^.dwStructSize := dwEntrySize; 
 hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize); 
 if hCacheDir <> 0 then 
 try
 repeat 
 DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName); 
 FreeMem(lpEntryInfo, dwEntrySize); 
 dwEntrySize := 0; 
 FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize); 
 GetMem(lpEntryInfo, dwEntrySize); 
 if dwEntrySize > 0 then
 lpEntryInfo^.dwStructSize := dwEntrySize; 
 until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize); 
 finally
 FindCloseUrlCache(hCacheDir); 
 end; 
 finally
 FreeMem(lpEntryInfo, dwEntrySize); 
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 01667
Пример переменной записи

=== Пример переменной записи ===
В Delphi 2.0 я пытаюсь прочесть текстовый файл и получаю проблему. Текстовый файл, который я хочу прочесть, имеет записи фиксированной длины, но в самих записях могут располагаться различные типы с различной длиной, и оканчиваться в различных позициях, в зависимости от типа. 
Файл выглядит примерно так: 
 TFH.......<First record type, первый тип записи>
 TBH.......<Second record type, второй тип записи>
 TAB.......<Third record type, третий тип записи>
 TAA.......<Fourth record type, четвертый тип записи>
Вы можете поймать больше одного зайца в случае объявления переменной записи, но если сделаете это правильно.
type
 TDataTag = array[1..3] of Char;
 TDataTags = array[0..NumOfTags - 1] of TDataTag;
 TDataRec = packed record
 tagfield: TDataTag;
 case integer of
 0: (поля для тэга TFH);
 1: (поля для тэга TBH);
 2: ..
 ....
 end;
 TMultiRec = packed record
 case Boolean of
 false: (строка: array[0..1024] of Char);
 { должно установить строку максимально возможной длины }
 true: (data: TDataRec);
 end;
const
 DataTags: TDataTags = ('TFH', 'TBH', ....);
var
 rec: TMultirec;
 ReadLn(datafile, rec.line);
 case IndexFromDataTag(rec.data.tagfield) of
 0: ...
 1: ...
 end;
IndexFromDataTag должен искать передаваемый тэг поля в массиве DataTags. Определите все поля в TDataRec как Array [1..someUpperBound] of Char.
Source: http://delphiworld.narod.ru
ID: 00785
Пример получение информации о NETBIOS именах компьютера

Пример получение информации о NETBIOS именах компьютера (аналог nbtstat -a).
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03330
Category:Связь
Пример получения TCP и UDP статистики

Пример получения TCP и UDP статистики стандартным способом (GetTcpTable) и через AllocateAndGetTcpExTableFromStack (XP only).
Обновленная версия. Исправлена одна маленькая ошибка и добавлен вывод статистики по UDP. Исправлена ошибка при которой неверно показывались открытые порты (htons забыл :)
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03365
Category:Связь
Пример получения информации о пользователях, группах и рабочих станциях домена

Пример получения информации о пользователях, группах и рабочих станциях домена
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03331
Category:Связь
Пример приложения, демонстрирующее возможности технологии ADO

=== Пример приложения, демонстрирующее возможности технологии ADO ===
Пример приложения, демонстрирующее возможности технологии ADO
Приложение баз данных, демонстрирующее возможности технологии ADO
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02669
Пример приложения, демонстрирующее возможности технологии dbExpress

=== Пример приложения, демонстрирующее возможности технологии dbExpress ===
Пример приложения, демонстрирующее возможности технологии dbExpress
Приложение баз данных, демонстрирующее возможности технологии dbExpress 
Author: Akella
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02692
Пример приложения, напрямую использующее API BDE для представления данных

=== Пример приложения, напрямую использующее API BDE для представления данных ===
Пример приложения, напрямую использующее API BDE для представления данных
Приложение баз данных, напрямую использующее API BDE для представления данных
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02536
Пример приложения, напрямую использующее API BDE для удаления записей

=== Пример приложения, напрямую использующее API BDE для удаления записей ===
Пример приложения, напрямую использующее API BDE для удаления записей
Приложение баз данных, напрямую использующее API BDE для полного удаления записей из таблиц базы данных
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02535
Пример программирования обращения к IRC

Не раз уже задавался вопрос про использование MIRC'а... 
Вот и решил показать простейший пример использования и программирования IRC протокола.
Написание под этот протокол абсолютно ничем не отличается от написания под все (т.е. почти все) др. сетевые протоколы...
Так же будет показан простейший пример: коннект к серверу, ответ на запрос IRC сервера, возможность
посылать фразы в канал....
Для начала неплохо было бы скачать rfc 1459 для (Internet Relay Chat Protocol).
Начнем...
Заведем нужную структуру с необходимой нам информацией. Она может выглядеть примерно так:
type
 TsInfo = record
 sIP: string[20];
 sChan: string[10];
 sNick: string[10];
 end;
Все поля будут заполнятся из введеных пользователем строк в Edit'ы.
 Info.sIP := Edit1.Text; // ИП адрес сервера
 Info.sChan := Edit2.Text; // канал на который будем заходить
 Info.sNick := Edit3.Text; // наш ник
Так… все что необходимо мы уже имеем. (Все это я тестировал у себя в локалке!!! Так что и у вас должно работать =()
Теперь, первое, что нам необходимо, это, собственно, приконекатся к серверу. В примере я использовал стандартный компонент TClientSocket (я обозвал его «cs»).
Заполним необходимые для соединения данные:
cs.Address := Info.sIP;
cs.Port := 6667; // выбираем стандартный порт (у вас может быть другой)
Ну и далее, стандартное для TClientSocket соединение 
cs.Active := TRUE;
Все, если все ок, то мы должны присоединиться. Далее мы хотели зайти на канал - попробуем сделать это!
OnConnect:
begin
 cs.Socket.SendText('NICK' + ' ' + Info.sNick + #13#10);
 cs.Socket.SendText('USER' + ' ' + Info.sNick + ' ' + 'test' + ' test' + 'test' + #13#10);
end;
Все необходимые команды берутся из выше указанного rfc.
Но нельзя пропустить то обстоятельство, что сервер постоянно проверяет вашего клиента на «валидность», используя при этом команду «PING ‘rnd строка’», нам же в этом случае необходимо будет ответить на этот запрос, примерно так «PONG ‘rdn строка’». После этого мы должны стать «своими» на сервере! Пробудем:
OnRead:
begin
 sText := cs.Socket.ReceiveText;
 tmp := copy(sText, 1, 4);
 if (tmp = 'PING') then
 begin
 tmp := ' '; tmp := copy(sText, pos(' ', sText)+2, length(sText)-6);
 cs.Socket.SendText('PONG' + ' ' + tmp + #13#10);
 cs.Socket.SendText('JOIN' + ' #' + Info.sChan + #13#10);
 end;
 Memo1.Lines.Add(sText)
end;
Тут же ( cs.Socket.SendText('JOIN' + ' #' + Info.sChan + #13#10); ) мы заходим на канал Info.sChan, замечу, что перед именем канала должен стоять символ #.
Вот почти и все, осталось сделать возможность отсылать сообщения.
OnClick:
 cs.Socket.SendText('PRIVMSG #' + Info.sChan + ' :' + Edit4.Text + #13#10);
Author: x2er0
Source: http://forum.sources.ru
ID: 03389
Category:Связь
Пример простейшей DLL в Delphi

=== Пример простейшей DLL в Delphi ===
Код, представленный ниже демонстрирует простейшую DLL с всего одной функцией "TestDLL". Результат этой процедуры - диалоговое окошко с текстом.
library Test; 
{ В хелпе Delphi 5 рекомендуют добавлять юнит ShareMem для улучшения управления памятью и экспортирования вызываемых строк. }
uses ShareMem, SysUtils, Windows, Dialogs; 
{$R *.RES} 
const TestConst = 'This is a tests DLL.'; 
{ Так же рекомендуется использовать параметр StdCall. Это позволяет сделать DLL совместимую с другими языками... }
procedure TestDLL(TestStr: string); stdcall 
begin 
 MessageDlg(TestConst + Chr(13) + Chr(13) + 'Your string is: ' + TestStr, mtInformation, [mbOk], 0); 
end; 
exports TestDLL; // С таким именем процедура будет доступна в приложении...
begin 
end. 
Теперь достаточно достаточно объявить в приложении процедуру из DLL и скопировать саму DLL в директорию с приложением.
 procedure TestDLL(TestStr: sting); stdcall; external 'Test.dll'; 
Source: Взято из http://forum.sources.ru
ID: 01985
Пример простого распределенного приложения баз данных

=== Пример простого распределенного приложения баз данных ===
Пример простого распределенного приложения баз данных
* Пример простого распределенного приложения баз данных
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02425
Пример процедуры убивающей таймеры по заголовку окна в чужих приложениях написанных на Delphi

=== Пример процедуры убивающей таймеры по заголовку окна в чужих приложениях написанных на Delphi ===
var
 HInst : THandle;
 WndArr : array of THandle;
 Wnd : THandle;
procedure KillDelphiWndTimers(const AppCaption: string);
var
 i: Integer;
 function GetTimerWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;
 const
 sClName = 'TPUtilWindow';
 var
 s: string;
 begin
 Result := True;
 SetLength(s, Length(sClName)+1);
 GetClassName(Handle, PChar(s), Length(s));
 SetLength(s, Length(sClName));
 if (GetWindowLong(Handle, GWL_HINSTANCE) = HInst ) and (s = sClName) then
 begin
 SetLength(WndArr, High(WndArr)+2);
 WndArr[High(WndArr)] := Handle;
 end;
 end;
begin
 Wnd := FindWindow(nil, PChar(AppCaption));
 if Wnd = 0 then Exit;
 HInst := GetWindowLong(Wnd, GWL_HINSTANCE);
 EnumWindows(@GetTimerWindows, 0);
 for i := 0 to High(WndArr) do KillTimer(WndArr[i], 1);
end;
Author: Radmin
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02120
Пример работы с DrawIcon(Ex)

=== Пример работы с DrawIcon(Ex) ===
DrawIcon(Canvas.Handle, 5, 5, Application.Icon.Handle);
DrawIconEx(Canvas.Handle, 40, 40, Application.Icon.Handle, 0, 0, 0, Canvas.Brush.Handle, DI_NORMAL);
Author: cully 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02352
Пример работы с Flash

The example of a simple movie creating which shows rectangle moving and circle transforming is below
procedure MakeSWF;
var
 Movie: TFlashMovie;
 Shape1, Shape2: TFlashShape;
begin
 Movie := TFlashMovie.Create(0, 0, 400 * twips, 400 * twips, 12);
 Movie.Compressed := true;
 Movie.SystemCoord := scPix;
 Shape1 := Movie.AddCircle(0, 0, 50);
 Shape1.SetRadialGragient(cswfWhite, SWFRGBA(clNavy), 35, 35);
 Shape2 := Movie.AddRectangle(0, 0, 150, 50);
 Shape2.SetSolidColor(SWFRGBA(clRed, $cc));
 for il := 0 to 20 do
 begin
 with Movie.PlaceObject(Shape1, 1) do
 begin
 SetScale(1 + il / 10, 1+il / 20);
 SetTranslate(200, 200);
 if il > 0 then
 RemoveDepth := True;
 end;
 with Movie.PlaceObject(Shape2, 2) do
 begin
 SetTranslate(20 + il, il * 6);
 if il > 0 then
 RemoveDepth := True;
 end;
 Movie.ShowFrame;
 end;
 {...}
 Movie.MakeStream;
 Movie.SaveToFile('demo.swf');
 Movie.Free;
end;
Source: http://www.delphiflash.com
ID: 04477
Пример работы с MailSlot

=== Пример работы с MailSlot ===
procedure TForm1.Button1Click(Sender: TObject);
var
 hSlot1: THandle;
 lpszSlotName: LPSTR;
begin
 lpszSlotName := '\\.\mailslot\sample_mailslot';
 hslot1 := CreateMailslot(lpszSlotName, 0, MAILSLOT_WAIT_FOREVER, nil);
 // тут по идее должна быть обработка ошибки, если не удалось создать
 // Далее работаем с ним, как с файлом т.е. WriteFile и т.д.
 // CloseHandle(hSlot1); // а кады закрываем за собой дескриптор,
 // то память чистится т.е. все, что мы туда поназаписали удаляется
end;
Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02081
Пример работы с указателями

=== Пример работы с указателями ===
var
 p1: ^String;
 s1: String;
begin
 s1 := 'NotTest';
 New(p1);
 p1 := @s1;
 p1^ := 'Test';
 Label1.Caption := s1;
end;
Author: Baa
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00255
Пример реализации Drag-and-Drop

=== Пример реализации Drag-and-Drop ===
Пример реализации Drag-and-Drop
unit Main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls;
type
 TMainForm = class(TForm)
 Panel1: TPanel;
 Edit1: TEdit;
 Edit2: TEdit;
 Label1: TLabel;
 Label2: TLabel;
 Panel2: TPanel;
 procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure Edit2DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
 procedure Edit2DragDrop(Sender, Source: TObject; X, Y: Integer);
 procedure Edit1EndDrag(Sender, Target: TObject; X, Y: Integer);
 procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
 procedure FormDragDrop(Sender, Source: TObject; X, Y: Integer);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if Button = mbLeft then
 TEdit(Sender).BeginDrag(True);
end;
procedure TMainForm.Edit2DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 Accept := (Source is TEdit);
end;
procedure TMainForm.Edit2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
 TEdit(Sender).Text := TEdit(Source).Text;
 TEdit(Sender).SetFocus;
 TEdit(Sender).SelectAll;
end;
procedure TMainForm.Edit1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
 if Assigned(Target) then
 TEdit(Sender).Text := 'Текст перенесен в ' + TEdit(Target).Name;
end;
procedure TMainForm.FormDragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 Accept := (Source.ClassName = 'TPanel');
end;
procedure TMainForm.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
 TPanel(Source).Left := X;
 TPanel(Source).Top := Y;
end;
end.
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00375
Category:VCL
Category:DragAndDrop
Пример чтения данных по битовой маске из значения

=== Пример чтения данных по битовой маске из значения ===
Пример чтения данных по битовой маске из значения:
procedure TForm1.Button1Click(Sender: TObject);
const
 Col: Word = $ABCD;
var
 R,
 G,
 B: Byte;
begin
 R := Byte(Col shr 8) div 8; // первые 5 бит
 G := ((Byte(Col shr 8) and $7) * 8) or (Byte(Col) div $20); // Вторые 6 бит
 B := Byte(Col) and $1F; // третьи 5 бит
end;
Source: Взято из http://forum.sources.ru
ID: 00231
Пример шифрования данных

procedure DoEncode(var Source: string; const Key: string);
asm
 push ESI
 push EDI
 push EBX
 or EAX,EAX
 jz @Done
 push EAX
 push EDX
 call UniqueString
 pop EDX
 pop EAX
 mov EDI,[EAX]
 or EDI,EDI
 jz @Done
 mov ECX,[EDI-4]
 jecxz @Done
 mov ESI,EDX
 or ESI,ESI
 jz @Done
 mov EDX,[ESI-4]
 dec EDX
 js @Done
 mov EBX,EDX
 mov AH,DL
 cld
@L1:
 test AH,8
 jnz @L3
 xor AH,1
@L3:
 not AH
 ror AH,1
 mov AL,[ESI+EBX]
 xor AL,AH
 xor AL,[EDI]
 stosb
 dec EBX
 jns @L2
 mov EBX,EDX
@L2:
 dec ECX
 jnz @L1
@Done:
 pop EBX
 pop EDI
 pop ESI
end;
Author: Vit
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03977
----
Комментарий от Chingachguk'a:
Мне кажется, у этого алгоритма есть два недостатка:
1) Код, сильно зависимый от компилятора. Далеко не всегда регистр EAX будет указывать на ячейку с адресом Source, а регистр EDX - на пароль(Key). Но это мелочь.
2) Единственный байт гаммы (или ксорирующей последовательности), который меняется при шифровании - это длина пароля. Остальные символы пароля НИКАК НЕ ПЕРЕМЕШИВАЮТСЯ в ходе шифрования. Алгоритм шифрования примерно такой:
Len := Lengh(Key);
Index := Lengh(Key) - 1;
i := 1;
repeat
 Len := func1(Len);
 Source[i] := (Key[Index] xor Len) xor Source[i];
 Dec(Index);
 if Index := 0 then Index := Lengh(Key)-1;
until i < Lenght(Source);
Нетрудно видеть, что основной для тупого подбора является длина пароля. Пусть она равна 10. Очевидно, что 1-ый,11,21.. символы будут зашифрованы ОДИНАКОВЫМ значением Key[Index], но разными значениями Len. Казалось бы, Len для 1,11,21... будет разным, но это ерунда - ведь Len вычисляется однозначно на ЛЮБОМ шаге через реккурентный закон func1 !
И это - фатальный недостаток.
----
Информацию по шифрованию можно найти на
http://www.cryptography.ru/
Author: Shaman
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03978
Category:Алгоритмы
Примеры для работы с Email

Примеры для работы с Email
* Примеры для работы с Email (mailer32.zip)
* Примеры для работы с Email (MailTo.zip)
* Примеры для работы с Email (SMSPMlrV4_1.zip)
* Примеры для работы с Email (smtp_auth.zip)
Author: Akella 
Source: Vingrad.ru http://forum.vingrad.ru
ID: 03416
Category:Связь
Category:Электронная почта
Примеры форматирования строк с использованием API-функции wvsprintf

=== Примеры форматирования строк с использованием API-функции wvsprintf ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Примеры форматирования строк с использованием API-функции wvsprintf
Примеры показывают приемы использования функции wvsprintf в Delphi для
форматирования строк. Эта функция входит в состав Windows API
(реализована в user32.dll), поэтому не требует подключения модуля
SysUtils по сравнению с аналогичной функцией Format.
Зависимости: Windows
Автор: Внук, Zhigalin@poria.ru, ICQ:60571446, Самара
Copyright: Внук
Дата: 29 мая 2002 г.
***************************************************** }
// Пример использования функции wvsprintf с двумя параметрами разного типа
function WinFormat(out TargetString: AnsiString): Boolean;
const
 FormatStr = 'String Parameter:"%s", Number Parameter:%05d';
var
 StrParam: AnsiString;
 NumberParam, FormatResult: Integer;
 ParamArray: array[0..1] of Pointer;
begin
 NumberParam := 105; // Задаем значение первого параметра
 StrParam := 'Hello'; // Задаем значение второго параметра
 SetLength(TargetString, 50); // Должно быть достаточно места для результата.
 // Без этой строки работать не будет
 ParamArray[0] := @StrParam[1];
 ParamArray[1] := Pointer(NumberParam);
 FormatResult := wvsprintf(PChar(TargetString), FormatStr, PChar(@ParamArray));
 if FormatResult < Length(FormatStr) then // В случае ошибки значение функции
 // меньше длины шаблонной строки
 begin
 TargetString := ;
 Result := False;
 end
 else
 result := True;
end;
// Пример использования функции wvsprintf с одним параметром
function SimpleWinFormat(out TargetString: AnsiString): Boolean;
const
 FormatStr = 'Number Parameter:%05d';
var
 NumberParam, FormatResult: Integer;
begin
 NumberParam := 112;
 SetLength(TargetString, 50); // Должно быть достаточно места для результата.
 // Без этой строки работать не будет
 FormatResult := wvsprintf(PChar(TargetString), FormatStr,
 PChar(@NumberParam));
 if FormatResult < Length(FormatStr) then // В случае ошибки значение функции
 // меньше длины шаблонной строки
 begin
 TargetString := ;
 Result := False;
 end
 else
 result := True;
end;
// Пример использования: 
uses Dialogs;
var
 S: AnsiString;
begin
 if WinFormat(S) then
 ShowMessage(S)
 else
 ShowMessage('An error has been occured!');
 if SimpleWinFormat(S) then
 ShowMessage(S)
 else
 ShowMessage('An error has been occured!');
end;
Source: http://delphibase.endimus.com
ID: 00916
Приостановить компьютер (sleep)

=== Приостановить компьютер (sleep) ===
У компьютеров ATX есть функция Sleep. Эта программа заставляет компьютер "заснуть". 
procedure TForm1.Button1Click(Sender: TObject);
begin
 SetSystemPowerState(true, true);
end;
 e-mail: delphi4all@narod.ru
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: Алексей Денисов
ID: 01703
----
=== Переход в Спящий режим (WinNT) ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Переход в Спящий режим (WinNT)
Зависимости: Windows, system
Copyright: @
Дата: 21 сентября 2002 г.
***************************************************** }
procedure NTSleep;
var
 hToken: THandle;
 tkp: TTokenPrivileges;
 ReturnLength: Cardinal;
begin
 if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
 TOKEN_QUERY, hToken) then
 begin
 LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
 tkp.PrivilegeCount := 1; // one privelege to set
 tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
 SetSystemPowerState(true, true);
 end;
end;
Source: http://delphibase.endimus.com
ID: 01704
Присвоение форме выбранного окна свойства Disabled / Enabled

=== Присвоение форме выбранного окна свойства Disabled / Enabled ===
{ в конце процедуры: False для запрета True для разрешения }
EnableWindow(FindWindow(nil, PChar('Название Окна')), False);
Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02028
Присвоить значение полям записи с помощью Assemblera

=== Присвоить значение полям записи с помощью Assemblera ===
unit Main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure Foo(var I: integer);
begin
 { some code }
 asm
 mov eax, I
 inc dword ptr [eax]
 end;
 { i has now been incremented by one }
 { some more code }
end;
type
 TDumbRec = record
 i: integer;
 c: char;
 end;
procedure ManipulateRec(var DR: TDumbRec);
asm
 mov [eax].TDumbRec.i, 24
 mov [eax].TDumbRec.c, 's'
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 R: TDumbRec;
begin
 ManipulateRec(R);
 ShowMessage(IntToStr(R.i));
 Caption := Caption + R.c;
end;
end.
Source: http://delphiworld.narod.ru
ID: 00687
Приёмы работы с BLOB (OLE/Memo) полями

=== Приёмы работы с BLOB (OLE/Memo) полями ===
==== Загрузка файла из TImage: ====
 QAll.Edit;
 QAll.FieldByName('Logo').Assign(Image.Picture);
 QAll.Post;
==== Чтение файла из таблицы в TImage: ====
 Image.Picture.Assign(QAll.FieldByName('Logo'));
==== Загрузка данных в поле: ====
(Table1.DataSource2.Fields.Field[01] As TBlobField).LoadFromStream(SomeStream);
==== Загрузка данных через параметры: ====
Запрос
INSERT INTO MyTable (MyBlobField)
VALUES (:Something)
В коде:
(Query1.Parameters.ParamByName('Something') as TBlobField).LoadFromFile();
(Query1.Parameters.ParamByName('Something') as TBlobField).LoadFromStream();
(Query1.Parameters.ParamByName('Something') as TBlobField).Assign();
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято из http://forum.sources.ru
ID: 02481
Проблема всплывающих подсказок в дочерних MDI-формах

=== Проблема всплывающих подсказок в дочерних MDI-формах ===
Если вам просто нужно отобразить всплывающие подсказки от элементов управления вашей дочерней формы, то сделайте это в вашей главной форме. 
Объявите следующую процедуру в классе вашей главной формы:
private
{============================================================}
{ Процедура, вызываемая приложением всякий раз, когда }
{ приложение хотело бы показать всплывающую подсказку. }
{ Добавляет хинт на панель статуса. }
{============================================================}
procedure ShowHint(Sender : TObject);
затем в процедуре главной формы .create добавьте следующую строку:
{ Отображает хинт на статусной панели}
Application.OnHint := ShowHint;
Теперь приведем код функции ShowHint, принадлежащей главной форме:
{================================================================}
{ Обновляем pnlStatusText.Caption с текстом всплывающей подсказки}
{ элемента управления, над которым находится курсор мыши. }
{================================================================}
procedure TMainFrame.ShowHint(Sender: TObject);
begin
 pnlStatusText.Caption := Application.Hint;
end;
Это должно работать. Вам нужно будет только задать текст подсказок для элементов управления во всех окнах, включая главное. Устанавливая свойство показа хинтов в false или true, вы тем самым указываете способ показа хинтов: обычным способом в виде всплывающих окошек, или совместно с показом в строке состояния. 
Source: Взято с http://delphiworld.narod.ru
ID: 00494