Не раз уже встречал случаи, когда кто-нибудь хотел выложить какие-то свои наработки в Delphi: модули, исходники, компоненты, может еще что-то. Предлагалось создавать отдельный раздел, но пока не понятно, будет ли от этого толк. Пока что создаю эту тему. В дальнейшем же будет видно насчёт отдельного раздела исходников по тому, какая тут будет активность, и как к этому отнесётся Admin.

Единственное правило - в этой теме не флеймить, тут оставлять только краткое описание модулей и ссылки к ним.

Можно скинуть мне на мыло (кнопка E-Mail под моим постом) файл, и я его прикреплю к вашему сообщению при первой же возможности...

Модуль работы с ресурсами в PE файлах by Alex:
http://forum.vingrad.ru/index.php?showtopic=21183
- Извлечение иконок из ресурсов
- Добавление нового ресурса
- Изменение существующего ресурса
- Удаление ресурса
- Работа с ресурсами различных языков
- Работает в любой версии Windows
- И другое

 "Системный модуль"

"Модуль для работы со строками" 


"Зачатки модуля для работы с графикой"


"Зачатки модуля для работы с 2000/XP"



"Примеры" 

Зайти на сайт


Это сообщение отредактировал(а) SlaUr - 22.1.2007, 07:02

Функции для записи и чтение своих данных в, ЕХЕ- файле
http://forum.vingrad.ru/index.php?act=ST&f...=21513&unread=1

Модуль состоит:
1. AppendStringToFile - Дописывает строку к файлу
2. AppendedStringFromFile - Возвращает строку дописаную к файлу процедурой AppendStringToFile

Модуль для упрощенного вызова сообщений
http://forum.vingrad.ru/index.php?act=ST&f...=21766&unread=1

Модуль служит для вывода диалоговых окон посредством Windows.MessageBox.

Процедура поиска по всем полям

Код

Procedure FindRec(What,Mes:String;DS:TDataSet;sFields:array of String;                              foFromBegin,foCaseSansitive,ShowMes:Boolean); { What            - строка для поиска (editFind.Text) DS              - таблица (TTable,TQuery и т.д.) Fields          - список полей, по которым нужно вести поиск (['Field1','Field3','Field7']) foFromBegin     - поиск от начала таблицы (true - от начала или False от текущей записи) foCaseSansitive - поиск с зависимостью от регистра символов (true - зависит от регистра или False не зависит от регистра) }    Function FieldInFields(_Field:String;_Fields:array of String):Boolean;//    Var     x:byte;    begin//содержиться ли текущее поле в масива полей, предназначенных для поиска      Result:=False;      For x:=Low(_Fields) to High(_Fields) do        if _Field = _Fields[x] then begin          result:=true;          exit;        end;//if    end;//func Var i,q,f,w:integer; begin  ds.DisableControls;//для ускорения отключаем таблицу  w:=ds.RecNo;  try    //если поиск сначала таблицы      if foFromBegin then q:=0 else q:=ds.RecNo;    //идем по всем записям      For i:=q to ds.RecordCount-1 do begin    //пробег по всем полям        For f:=0 to ds.FieldCount-1 do begin    //если текущее поле содержится в массиве полей, предназначенных для поиска          if FieldInFields(ds.Fields[f].FieldName,sFields) then begin    //проверка на регистр            if (foCaseSansitive = True) AND (POS(What,ds.Fields[f].AsString)<>0) then exit;            if (foCaseSansitive = False) AND (POS(AnsiUpperCase(What),AnsiUpperCase(ds.Fields[f].AsString))<>0) then exit;          end;//if FieldInFields(ds.Fields[f].FieldName,sField) then begin        end;//For f:=0 to ds.FieldCount-1 do begin        ds.Next;      end;//For i:=q to ds.RecordCount-1 do begin      ds.RecNo:=w;      if ShowMes then ShowMessage(mes);  finally    ds.EnableControls;//даже если произойдет исключение, то таблицу надо включить  end;//try-finally end;//proc

Пример использования

Код

FindRec(edFindText.Text,'',dm.tSpis,['Dirname','Type','PathName','Prim'],False,cbRegister.Checked,False);

Delphi и Microsoft Office

Если нужно решить какуе то задачу для Word или Excel, на Делфи и вы не знаите как это сделать,то вот простое решение :
Откройте Word или Excel, запустите на запись макрос. Решите поставленную для вас задачу, закройтье макрос.
Дальше нажмите сочитание клавишь Alt+F8, выбирите ваш макрос, по идеи он там будит один. Нажимаите кнопку "Войти" (уменя русский офис) и перед вами предстанит тело вашего макроса.
Этот текст надо будит перенести в Делфи, но не Ctrl+C и Ctrl+V, а ту последовательностть функций, которая там идет, с параметрами могут возникнуть праблемы. Дело в том что VBA иногда опускае параметры, прочтите MSDN!!!!, а в делфи этот номер не пройдет. Так же для некоторых ф-ций, количество параметров увеличено. Я столкнулся с такой проблемой, когда мне надо было сделать график, в VBA они вообще не передавались,а в делфи их было 6 штук.

LENIN INC WIN32API Library v1.0 (build 11.05.04), Модули для создания программ на WIN32API

Вашему вниманию предлагаються модули для создания программ на чистом WIN32API в DELPHI (all version). Все функции и процедуры 100% работают в Win9X/ME/NT/2000/XP. Подробнее на странице - LENIN INC WIN32API Library v1.0 (build 11.05.04)

Суважением,
автор.

Маленький простенкий протектор для UPX'а.

Присоединённый файл ( Кол-во скачиваний: 300 )
 UPX_Protect.rar

Процедура для тех, кто пишет синхронизатор фалов, она ищет, сортирует файлы и добавляет в таблицы StringGrid.

http://forum.vingrad.ru/index.php?showtopi...ndpost&p=193439
есть мнения?....

Это сообщение отредактировал(а) Slawanix - 3.8.2004, 23:57

Пример работы с MS Agent:

Для начала добавить компонент TMicrosoftAgent, для этого нажимаем:
Component -> Import ActiveX Control -> ищешь "Microsoft Agent Control 2" или что-то вэтом роде, далее нажимаешь Install, затем заходишь на вкладку компонентов ActiveX, оттуда кидаешь на форму компонент TAgent и далее код:

Код

uses    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,    Dialogs, StdCtrls, OleCtrls, AgentObjects_TLB; //Добавить AgentObjects_TLB;

Код

private    { Private declarations }    Offcat: IAgentCtlCharacter; //Добавить Offcat: IAgentCtlCharacter;

В событие формы onCreate добавить:

Код

procedure TForm1.FormCreate(Sender: TObject); begin Agent1.Characters.Load('Offcat',ExtractFilePath(Application.ExeName)+'\Offcat.acs'); Offcat:=Agent1.Characters.Character('Offcat'); Offcat.Show(False); end;

Далее создать новую кнопку и ввести:

Код

procedure TForm1.Button1Click(Sender: TObject); begin Offcat.Speak(edit1.text,''); end;

Взять персоонажа можно либо из приложения Microsoft Office, либо из папки: C:\WINDOWS\srchasst\chars, от туда в папку со своим проектом копируй файл rover.acs, переименуй его в Offcat, первая буква "О" обязательно большая! Всё удачи, если будут проблемы пиши сюда!


Это сообщение отредактировал(а) The MASTER - 6.3.2005, 13:59

нужно найти номер позиции второго символа "/" из строки "17/32/16"

Код

Function PosExt(symbol,str:string;beg:integer):integer; {параметры symbol - искомый символ str        - строка, где производиться поиск beg      - найти позицию str по счету beg пример: нужно найти номер позиции 2-го[s] символа "/" из строки 17/32/16 ShowMessage(IntToStr(PosExt('/','17/23/16',2))); } var i,p:integer; begin i:=0; result := 0; if (str = '') or (symbol = '') then exit;//выходим если пусто For p:=1 to Length(str) do begin   if str[p] = symbol then i:=i+1;   if beg = i then   begin     result:= p;     break;   end;//if end;//for end;

Это сообщение отредактировал(а) dsergey - 16.9.2004, 09:00

Вот Примерчик сортировки!

Это сообщение отредактировал(а) p0s0l - 2.10.2004, 00:14

Присоединённый файл ( Кол-во скачиваний: 134 )
 unit1.pas

В архиве:

ufExSpellCheck.pas + ufExSpellCheck.dfm
Пример использования проверки граматики Word'а из Delphi. Реализовано два подхода.

Рекурсивный просмотр директорий.txt
"рыба" для рекурсивного просмотра и обработки каталога DirName
с подкаталогами.


Это сообщение отредактировал(а) p0s0l - 2.10.2004, 00:17

Присоединённый файл ( Кол-во скачиваний: 229 )
 archive.zip

Компонент LSVGauge является альтернативой стандартным
компонентам Gauge и ProgressBar
При помощи этого компонента можно создавать графические индикаторы с
оригинальным визуальным оформлением:
1) управление цветом частей текста на полосе и на фоне;
2) заполнение фона и полосы изображениями;
3) установка прозрачности заливки;
4) произвольная форма индикатора;
5) полоса с краями;
6) вывод целых блоков (в стиле ProgressBar, причем конфигурация
блоков может быть практически любой);
7) режим "бегущей полосы", когда число повторений цикла неизвестно
(возможность анимации полосы, титры на фоне см. пример);
8) простейшая трехмерная круговая диаграмма (Kind=Pie3D);
9) индикатор в стиле Partition Magic (текст центруется по текущей ширине
(высоте) полосы)
Может пригодиться тем, кто использует в своих приложениях сменные шкуры.


http://www.lsvhost.narod.ru/LSVGauge.zip

Модератор: Прошу не флеймить и не оффтопить в этой теме! Левые посты в скоре будут удалены. Все личные сообщения пишите через PM.
Также прошу не выкладывать огроменные тексты прямо тут - либо присоединяйте файл к ответу, либо давайте ссылку на исходник! Иначе неудобно просматривать тему!
Кто не может присоединить файл к ответу (т.е. не является участником клуба), или не знает как выложить в инете свой файл - просто пока запостите в эту тему пост про свой исходник и по мылу вышлите мне сам исходник - я его присоединю к вашему посту при первой же возможности.
Чтобы написать мне письмо, жмите кнопку "E-Mail" внизу под моим постом...

Отправка файлов в корзину
в секцию private

Код

procedure Recycle1(const FileNames:TStrings;Wnd:HWND=0);

в секцию USES

Код

ShellAPI

Код

procedure TForm1.Recycle1(const FileNames:TStrings;Wnd:HWND=0); var SHF:_SHFileOpStructA; Name:PChar; SizeName:Cardinal; u:integer; begin For u:=0 to FileNames.Count-1 do begin SizeName:=Length(FileNames.Strings[u])+2; GetMem(Name,SizeName); FillChar(Name^,SizeName,0); StrCopy(Name,PChar(FileNames.Strings[u])); FillChar(SHF,SizeOf(SHF),0); with SHF do begin  if Wnd=0 then Wnd:=Application.Handle;  wFunc:=FO_DELETE;  pFrom:=Name;  fFlags:=FOF_ALLOWUNDO or FOF_NOERRORUI or FOF_NOCONFIRMATION; end; try SHFileOperation(SHF); except end; FreeMem(Name,SizeName); end; end;

использование

Код

Recycle1(od1.Files, Handle);

od1-TOpenDialog(закладка Dialogs)

Это сообщение отредактировал(а) dsergey - 1.10.2004, 09:44

 Универсальная функция для обращения к любым экспортируем функциям DLL, внутри адресного пространства чужого процесса.

При этом возвращает как результат работы функции так и обработает все указатели на данные (т.е. к примеру в function ImageList_GetIconSize(ImageList: HIMAGELIST; var CX, CY: Integer): Bool - также вернет CX и CY).

Идею обращения к функции, внутри чужого процесса, предложил p0s0l, но к сожалению код был реализован только под одну функцию.
 
Функция:
PS: Писал ночью...   т.ч. могут быть ошибки   (если найдете - пишите в PM).

В архиве:
Inject.pas - сама функция
Example.pas -Пример использования:
- Выдираем в WinXP иконки из трея и добавляем их в ImageList и отображаем их в TreeView... 

13 октября 2006: Поправил пример 

Присоединённый файл ( Кол-во скачиваний: 126 )
 Girder2.zip 3,47 Kb

Накатал тут програмку от нечего делать. Можно использовать в качестве дневника или для ведения конфеденциальных записей. Применял свой алгоритм шифрования. Работает везде (по идее), тестировалась на WinXP SP2. Если будут какие либо предложения или замечания, пожалуюста напишите!

Присоединённый файл ( Кол-во скачиваний: 271 )
 Diry.zip

И я выложу (раз уж доделал) свою версию ...
В модуле две основых функции:
RemoteCall и AsyncRemoteCall - вторая асинхронная (работа потока не останавливается), результатов не возвращает.

Код

function RemoteCall (PID : DWORD; const FuncName, LibName : string; Params : array of TCallParam) : DWORD;

PID - ID процесса, в контексте которого будет вызвана функция
FuncName - имя функции, LibName - имя DLL
Params - параметры вызываемой функции. Передача параметров осуществляется двумя способами:
ByVal - по значению, и ByRef - по ссылке
Функция возвращает результат вызова функции в чужом процессе.
Пример 1:

Код

RemoteCall (GetCurrentProcessID, 'MessageBoxA', 'user32.dll', [ByVal(0), ByVal('Hello!'), ByVal('Caption'), ByVal(MB_ICONINFORMATION)]);

Пример 2:

Код

var s : AnsiString; begin  SetLength(s, 1024);  RemoteCall (<ProcessID>, 'GetWindowTextA', 'user32.dll', [ByVal(Handle), ByRef(s), ByVal(1024)]);  Form1.Caption := s; end;

Присоединённый файл ( Кол-во скачиваний: 149 )
 PSL_RemoteCall.zip

При составлении программ часто возникает ситуация, когда нужно что-нибудь подсчитать, и вывести результат в виде: ЧИСЛО + СЛОВО. Причём СЛОВО обозначает то, что, собственно, и нужно подсчитать. Например, нужно вывести число строк в списке TListBox в формате: 'N слов'. Благодаря особенностям великого и могучего русского языка и тому, что число N заранее неизвестно, может меняться и вычисляется самой программой, заранее также неясно в каком падеже нужно ставить следующее за числом слово.

Если плюнуть на это и написать просто: N + ' слово', то при расчётах получим малограмотные конструкции типа '17 слово' и '3 слово'.

Между тем избавиться от данной ситуации довольно просто. Я тут поразмыслил, и написал функцию, выбирающую из трёх падежей нужный. Возможно не самый оптимальный вариант, но всё же... Для более детального ознакомления смотрите комментарии в коде.

Код

program FndCase; {$APPTYPE CONSOLE} uses  SysUtils; {Функция возвращает строку, содержащую введённое число плюс введённое сцуществительное в падеже, согдасующимся с этим числом (порядковым числительным) Передаваемые параметры:  i : Integer - целое число, представляющее нужное порядковое числительное;  e_ip : String - именительный пажед единственного числа вводимого существительного                  (кто? что?);  e_rp : String - родительный падеж единственного числа вводимого существительного                  (кого? чего?);  mn_rp : String - родительный падеж множественного числа вводимого существительного                  (кого? чего?); Результатом является выбор между этих трёх вариантов в соответствии с порядковым числительным} function ChooseCase (i : Integer; e_ip, e_rp, mn_rp: String): String;  var    end_w : Integer;  begin    end_w := StrToInt(Copy(IntToStr(i), Length(IntToStr(i)) - 1, 2));     if (end_w > 10) and (end_w < 20)      then        begin         Result := IntToStr(i) + ' ' + mn_rp;        end      else        begin         end_w := StrToInt(Copy(IntToStr(end_w), Length(IntToStr(end_w)), 1));         case end_w of         0 : Result := IntToStr(i) + ' ' + mn_rp;         1 : Result := IntToStr(i) + ' ' + e_ip;         2..4 : Result := IntToStr(i) + ' ' + e_rp;         5..9 : Result := IntToStr(i) + ' ' + mn_rp;         end;        end;  end; begin  //Несколько примеров    Randomize;  WriteLn(ChooseCase(Random(1000), 'slovo', 'slova', 'slov'));  WriteLn(ChooseCase(Random(1000), 'bukva', 'bukvy', 'bukv'));  WriteLn(ChooseCase(Random(1000), 'programmist', 'programmista', 'programmistov'));  WriteLn(ChooseCase(Random(1000), 'Andrey', 'Andreya', 'Andreev'));  WriteLn(ChooseCase(Random(1000), 'Svetlana', 'Svetlany', 'Svetlan'));  WriteLn(ChooseCase(Random(6000000000), 'chelovek', 'cheloveka', 'chelovek'));  ReadLn; end.

Функция поворота изображения на заданный угол через DIB.

Функция:

Код

function HBitMapRotate(BitMap:HBitMap;Angle:Extended;var X_Y:TPoint):HBitmap; {Входные данные: BitMap - Источник рисунка                 Angle - Угол на который будет повернут BitMap Выходные данные: HBitMapRotate - Идентификатор точечного повернутого рисунка                  X_Y - Размеры повернутого изображения}

В архиве: Сама функция и пример использования

Это сообщение отредактировал(а) Girder - 12.11.2004, 23:56

Присоединённый файл ( Кол-во скачиваний: 133 )
 rGirder.zip

С помощью этого модуля можно прочитать или записать в файл, который уже открыт, даже эксклюзивно! (Но файл и не обязательно должен быть открыт )
Но:
* работает в NT (тестил в XP, в 2k - не тестил)
* нужны права администратора
* к файлу должен быть разрешен доступ FILE_READ_ATTRIBUTES (единственное, что не получилось пока прочитать - это файлы подкачек)
* тестил на: NTFS, FAT32 (FAT16 теоретически должен поддерживаться)
* при записи нужно учитывать работу кэша...
* также, следует понимать, что размер файла нельзя изменить, т.е. дописать что-то в конец файла, или обрезать файл...

В модуле 3 функции (названия говорят сами за себя):

Код

function DF_Read (const FileName : string; Offset, Size : Cardinal; Buf : Pointer) : Boolean; function DF_Write (const FileName : string; Offset, Size : Cardinal; Buf : Pointer) : Boolean; function DF_GetFileSize (const FileName : string) : Int64;

FileName - имя файла
Offset - смещение внутри файла в байтах, откуда будет происходить чтение/запись
Size - размер данных для записи/чтения (в байтах)
Buf - указатель на буфер

В архиве лежит этот модуль и пример. В примере .exe сам себя изменяет - считается количество запусков программы...

Присоединённый файл ( Кол-во скачиваний: 320 )
 DFA.ZIP

Пример реализации Русско-Английского KeyLoggera Средствами WinApi


Присоединённый файл ( Кол-во скачиваний: 287 )
 xKeyLoger.rar

* Пример внедрения длл в чужой процесс
* Пример перехвата функций Api:

FindNextFile...,
RegEnumValue...,
FormatMessage...,
WinExec...,
ShellExecute...,
CreateProcess... .

Таким образом можно скрывать имена файлов, ключи в реестре, открытые порты, и запрещать запуск определённых файлов.

Присоединённый файл ( Кол-во скачиваний: 428 )
 ApiHook.rar

Привет всем.
Пока не разобрался как добавить к сообщению файлы.
Если кто-нибудь озадачится вызовом отчетов Crystal Reports из приложения без установленного Crystal-а то для этого необходимо:
1. К проекту подключить модуль CRDelphi.pas,содержащий описание функций и типов для работы с Crystal Report Engine API. Модуль включен в дистрибутив CR 9.0 \\Tools\Developers
2. Библиотека содержащая функции CR API – crpe32.dll
3. Кроме того для работы программы без Crystal-а необходимы следующие библиотеки: crqe.dll, Implode.dll, querybuilder.dll, ufmanager.dll и также библиотеки используемые отчетом для подключения к источнику данных.
4. Так же необходимо внести изменения в реестр, чтобы программа могла использовать функции Crystal Report Engine. В разделы:
[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\CLSID\{BDE2D224-27E0-4925-A4E1-F5F38A191ABC}]
[HKEY_CLASSES_ROOT\CLSID\{BDE2D224-27E0-4925-A4E1-F5F38A191ABC}]
5. Пример использования функций CR API в программе (Пример урезанный):

Код

if PEOpenEngine then  begin    nPrintJob := PEOpenPrintJob(PChar(sReportName));//Путь и имя файла отчета    if nPrintJob = 0 then        ShowMessage('Error Open Report')    else      begin        //Получаем информацию о параметрах соединения отчета с БД        vLogOnInfo.StructSize := PE_SIZEOF_LOGON_INFO;        PEGetNthTableLogOnInfo(nPrintJob,0,vLogOnInfo);        //Присваиваем необходимые значения для соединения        vLogOnInfo.ServerName := '';        StrPCopy(vLogOnInfo.ServerName , sServerName);//Имя сервера БД для отчета        vLogOnInfo.Password := '';       StrPCopy(vLogOnInfo.Password , sPassword);//Пароль для пользователя БД        vLogOnInfo.DatabaseName := '';       StrPCopy(vLogOnInfo.DatabaseName , sDBName);//Имя БД        //Передаем параметры в отчет          if not PESetNthTableLogOnInfo(nPrintJob,0,vLogOnInfo,true) then          ShowMessage('Mistake of transfer parameters of connection.');         //Парамерты окна просмотра отчета        PEOutputToWindow(nPrintJob, PChar(sRepPuth), 0,0,0,0,  WS_MAXIMIZE+ WS_MINIMIZEBOX+WS_MAXIMIZEBOX+WS_SYSMENU,0);            vViewerOption.hasGroupTree := 1;            vViewerOption.canDrillDown := 1;            vViewerOption.hasNavigationControls := 1;            vViewerOption.hasCancelButton := 1;            vViewerOption.hasPrintButton := 1;            vViewerOption.hasExportButton := 1;            vViewerOption.hasZoomControl := 1;            vViewerOption.hasCloseButton := 1;            vViewerOption.hasProgressControls := 1;            vViewerOption.hasSearchButton := 1;            vViewerOption.hasPrintSetupButton := 1;            vViewerOption.hasRefreshButton := 0;           //Применение параметров окна просмотра            vViewerOption.StructSize := PE_SIZEOF_WINDOW_OPTIONS;            PESetWindowOptions(nPrintJob,vViewerOption);         End;        PEStartPrintJob(nPrintJob, true);      end;  end else    ShowMessage('CR Report Engine not started');

6. !!!!! ВАЖНО. При завершении работы приложения или во время его работы (зависит от того, сколько отчетов пользователь может просматривать одновременно) необходимо организовать выполнение процедуры PECloseEngine, иначе выдастся ошибка. При этом PECloseEngine нужно вызвать столько раз, сколько раз был запущен PEOpenEngine.

Я постарался сделать описание крадким, если данная тема интересна и нужна подробная информация, пишите на E-mail.

Это сообщение отредактировал(а) BSV_Sergey - 2.12.2004, 14:24

Получение длинного пути из короткого:

Код

function ShortToLongFileName(FileName: string): string; var  KernelHandle: THandle;  FindData: TWin32FindData;  Search: THandle;  GetLongPathName: function(lpszShortPath: PChar; lpszLongPath: PChar;                            cchBuffer: DWORD): DWORD; stdcall; begin  KernelHandle := GetModuleHandle('KERNEL32');  if KernelHandle <> 0 then    @GetLongPathName := GetProcAddress(KernelHandle, 'GetLongPathNameA');  // Использю GetLongPathName доступную в windows 98 и выше чтобы  // избежать проблем доступа к путям UNC в системах NT/2K/XP  if Assigned(GetLongPathName) then begin    SetLength(Result, MAX_PATH + 1);    SetLength(Result, GetLongPathName(PChar(FileName), @Result[1], MAX_PATH));  end  else begin    Result := '';    // Поднимаюсь на одну дирректорию выше от пути к файлу и запоминаю    // в result.  FindFirstFile возвратит длинное имя файла полученное    // из короткого.    while (True) do begin      Search := Windows.FindFirstFile(PChar(FileName), FindData);      if Search = INVALID_HANDLE_VALUE then Break;      Result := String('\') + FindData.cFileName + Result;      FileName := ExtractFileDir(FileName);      Windows.FindClose(Search);      // Нахожу имя диска с двоеточием.      if Length(FileName) <= 2 then Break;    end;    Result := ExtractFileDrive(FileName) + Result;  end; end;

OpenThread - Функция получения дескриптора потока по его идентификатору для Win 9X,ME,WinNT All.

PS: данная функция присутствует только в старших версиях NT и ME, в младших версиях есть NTOpenThread. При этом в Win 9X - её вообще нет...

Функция:

Код

const  THREAD_TERMINATE               =$0001;  THREAD_SUSPEND_RESUME          =$0002;  THREAD_GET_CONTEXT             =$0008;  THREAD_SET_CONTEXT             =$0010;  THREAD_SET_INFORMATION         =$0020;  THREAD_QUERY_INFORMATION       =$0040;  THREAD_SET_THREAD_TOKEN        =$0080;  THREAD_IMPERSONATE             =$0100;  THREAD_DIRECT_IMPERSONATION    =$0200;  THREAD_ALL_ACCESS              = STANDARD_RIGHTS_REQUIRED or                                   SYNCHRONIZE or $3FF; // == $1F03FF; function OpenThread(dwDesiredAccess:DWord;bInheritHandle:Bool;dwThreadId:DWord):Cardinal; //Функция получения дескриптора потока по его идентификатору для Win 9X,ME,WinNT All //dwDesiredAccess - флаги доступа к потоку //bInheritHandle - флаг наследования дескриптора //dwThreadId - идентификатор потока

В примере рассматривается алгоритм поиска потока отвечающий за панель задач. Основан он на том что если поток остановить(а для этого мы должны получить дескриптор потока с соответствующими правами) и обратится к его любым методам и свойствам из другого потока, то поток инициатор обращения тоже "как бы уснет"... . Для этого используется SendMessage(TrayWnd,SW_Show,0,0) - которая будет ждать результат обработки сообщения...

В архиве: сама функция и пример её использования...

Это сообщение отредактировал(а) Girder - 3.12.2004, 13:27

Присоединённый файл ( Кол-во скачиваний: 110 )
 OpenThread.zip

Модуль позволяющий, любые конвертации между темперетурными шкалами Цельсия, Фаренгейта, Ренкина и Реомюра.

Всего 20 функций, названия которых гроворят сами за себя:

Код

function CToK (Celsium_degree: Extended): Extended; // - Перевод градусов Цельсия в Кельвины и т. д. function KToC (Kelvin_degree: Extended): Extended; function FToC (Farengheit_degree : Extended): Extended; function CToF (Celsium_degree : Extended) : Extended; function RenToC (Renkin_degree : Extended): Extended; function CToRen (Celsium_degree : Extended) : Extended; function ReoToC (Reomur_degree : Extended): Extended; function CToReo (Celsium_degree : Extended) : Extended; function KToF (Kelvin_degree: Extended): Extended; function FToK (Farengheit_degree: Extended): Extended; function KToRen (Kelvin_degree: Extended): Extended; function RenToK (Renkin_degree: Extended): Extended; function KToReo (Kelvin_degree: Extended): Extended; function ReoToK (Reomur_degree: Extended): Extended; function RenToF (Renkin_degree: Extended): Extended; function FToRen (Farengheit_degree: Extended): Extended; function RenToReo (Renkin_degree: Extended): Extended; function ReoToRen (Reomur_degree: Extended): Extended; function FToReo (Farengheit_degree: Extended): Extended; function ReoToF (Reomur_degree: Extended): Extended;

Присоединённый файл ( Кол-во скачиваний: 103 )
 Temperature.zip

Иллюстрированный самоучитель по Delphi 7 для профессионалов


Этот самоучитель попал ко мне в виде набора HTML-страниц, что было неудобно в использовании. Я скомпилировал документ в формат chm, добавил оглавление и полнотекстовый поиск. Очень хороший самоучитель как для тех, кто серьезно занимается программированием на Delphi, так и для начинающих. Помимо всего прочего chm-файл содержит архив примеров к самоучителю с исходниками.

Скачать 3,21 Мб

Один из моих наиболее часто используемых библиотечных модулей.
Тут в основном функции работы со строками, но попадаются и некоторые другие. Может кто то найдет что-то интересное для себя.

Это сообщение отредактировал(а) Петрович - 21.1.2005, 11:30

Присоединённый файл ( Кол-во скачиваний: 350 )
 awString.zip

Многие кто писал консольные приложения наверное сталкивался с такой проблеммой:
В окне консоли используется кодировка OEM, т.е. DOS-кодировка. Поэтому, если в программе написать:

Код

WriteLn('Вася+Маша=Лубов');

то в консольно окне мы увидим "кракозябры" вместо русских букв. Это потому, что в Delphi программе естественно используется кодировка Windows.

Есть еще одна проблема:
Если в консольной программе возникает исключительная ситуация (Exception), то это вызывает малопонятное для клиента окно сообщения о системной ошибке в приложении.

Мне приходилось часто писать консольные приложения. Так вот, что бы не заниматься постоянной перекодировкой и не заботиться об необработанных программой исключениях, я написал свой модулек awConsole.
Просто добавление этого модуля в проект вызывает несколько изменений в поведении программы:
1. Весь консольный ввод/вывод осуществляется в кодировке OEM;
Достигается это подменой "драйвера" обслуживания консольных файлов Input, Output, ErrOutput.
2. Исключения не обработанные программой вызывают окно сообщения вместо системной ошибки.

Ну и есть там еще несколько полезных и не очень полезных функций.

Это сообщение отредактировал(а) Петрович - 21.1.2005, 11:30

Присоединённый файл ( Кол-во скачиваний: 162 )
 awConsole.zip

А вот еще, уже просто выдержки из библиотеки:

интерфейс:

Код

//////////////////////////////////////////////////////////////////////////////// // // Итераторы. type  tRecursiveOrder = (roNone,roParentChildrens,roChildrensParent);  tForEachProc    = procedure (Component :tObject); procedure ForEachOwned (Component      :TComponent;                        Proc           :tForEachProc;                        RecursiveOrder :tRecursiveOrder =roParentChildrens                        ); // Вызывают Proc для каждого компонента которым владеет Component. procedure ForEachChild (WinControl    :TWinControl;                       Proc           :tForEachProc;                       RecursiveOrder :tRecursiveOrder =roParentChildrens;                       IncludeNonWinControls :Boolean =False                       ); // Вызывают Proc для каждого дочернего по отношению к WinControl эл-та управления. // (Визуальное владение, WinControl.Controls, Parent которых = WinControl) // Главный "кайф" этих процедур в том, что Proc может быть ЛОКАЛЬНОЙ процедурой. // Причем, что-бы компилятор не ругался, надо поставить @ перед именем процедуры // (см.примеры). Однако, ответственность за соответствие числа и типа параметров // лежит на Вас. // // Например получение списка всех компонентов формы: // //    procedure TForm1.FormCreate(Sender: TObject); //    var i :Integer; //      procedure p(Component :TComponent); //      begin //        ListBox1.Items.Add(Format('%4d: %s :%s',[i,Component.Name,Component.ClassName])) //        Inc(i); //      end; //    begin //      ListBox1.Items.Add('Список компонентов принадлежащих форме') //      i := 0; //      ForEachOwned(Self,@p); //    end; // // Или еще - открытие всех наборов данных расположенных на форме, и всех // расположенных на ней фреймах и "подформах" : // //    procedure TForm1.FormShow(Sender: TObject); //      procedure OpenDataSet(Component :tComponent); //      begin //        if  Component is tDataSet  then  TDataSet(Component).Open; //      end; //    begin //      ForEachOwned(Self,@OpenDataSet); //    end; // ////////////////////////////////////////////////////////////////////////////////

Реализация "пристегнута"

А вот пример полезного использования:

Код

procedure En (Container :TWinControl; Enable :Boolean); // Устанавливает значение свойства Enabled у Container, а также // всем компонентам-редакторам лежащим на Container // будет еще установлен и цвет, clWindow при Enable True и clBtnFace // при Enable False. const ca :array [boolean] of tColor = (clBtnFace, clWindow);  procedure SetColor (C :TObject);  begin    if   (C is TCustomEdit)      //or (C is TCustomCheckBox)      //or (C is TCustomListBox)      then with tHackControl(C) do begin      Color := ca[Enabled and Enable];    end;  end; begin  Container.Enabled := Enable;  ForEachChild(Container,@SetColor); end;

И еще:

Код

procedure SetReadOnlyAndColorForAllWinControls(const WinControl :tWinControl; const ReadOnlyValue :Boolean; const SetColor :Boolean =True); // Выполняет SetReadOnlyAndColor(...,ReadOnlyValue) для WinControl и всех его // дочерних компонентов  procedure p (o :tObject);  begin    if  o is tWinControl  then   SetReadOnlyAndColor(TWinControl(o),ReadOnlyValue,SetColor);  end; begin  ForEachChild(WinControl,@p,roChildrensParent,False);  SetReadOnlyAndColor(WinControl,ReadOnlyValue,SetColor); end;

Соответственно требуется SetReadOnlyAndColor:

Код

type tHackControl = class(tControl); procedure  SetReadOnlyAndColor(WinCtrl :tWinControl; const ReadOnlyValue :Boolean; const SetColor :Boolean =True); // Если компонент WinCtrl имеет свойство ReadOnly то его значение // устанавливается в ReadOnlyValue. // Кроме того, если WinCtrl является потомком от TCustomEdit или TCustomGrid, // то его цвет изменяется в зависимости от значения ReadOnlyValue: //   False - устанавливается цвет clWindow; //   True  - устанавливается цвет на 1/8 темнее clWindow; begin  SetProperty(WinCtrl,'ReadOnly',ReadOnlyValue);  if  not SetColor  then  Exit;  if  (WinCtrl is TCustomEdit ) or (WinCtrl is TCustomGrid) then begin    if  ReadOnlyValue  then      tHackControl(WinCtrl).Color := MulDivIntensity(clWindow,7,8)    else      tHackControl(WinCtrl).Color := clWindow;    end  else begin //    tHackControl(WinCtrl).Color := clBtnFace;  end; end;

Это сообщение отредактировал(а) Петрович - 21.1.2005, 11:47

Присоединённый файл ( Кол-во скачиваний: 78 )
 Iterators.inc

Ну, пожалуй еще один модуль, и достаточно на сегодня
Модуль awNetwork пристегнут, а реализует он следующие функции:

Код

procedure NetGetListComputers (aList :tStrings); procedure GetComputers        (aList :tStrings);  deprecated; // Заполняют aList списком компьютеров обнаруженных в сети // Ex: EWNetError - см. NetEnum; procedure NetGetListDisks     (aList :tStrings); // Заполняет aList списком дисковых ресурсов обнаруженных в сети // Ex: EWNetError - см. NetEnum; procedure NetGetListPrinters  (aList :tStrings); // Заполняет aList списком принтеров обнаруженных в сети // Ex: EWNetError - см. NetEnum; procedure NetEnum (aList :tStrings; aResoureceDisplayType, aResoureceType :Cardinal); // Заполняет aList списком ресурсов обнаруженных в сети, соответствующих // aResoureceDisplayType и aResoureceType // Ex: EWNetError - Все ошибки накапливаются в списке и по завершению //                  сканирования выдается в одном Ex. //                  При этом, в результирующий список попадают все ресурсы не //                  вызвавшие ошибок. Это позволяет получить максимально полный //                  список ресурсов, даже при наличии ошибок, которые можно //                  просто игнорировать. procedure ForEachNetResource (Proc: Pointer); // Итератор вызывающий ЛОКАЛЬНУЮ процедуру Proc для каждого ресурса найденного в // сети. Процедура Proc должна быть ОБЯЗАТЕЛЬНО ЛОКАЛЬНОЙ процедурой вида: //    procedure (const NetRes :NetResource); register; // В качестве примера, можно посмотреть на реализацию функции NetEnum. // Ex: EWNetError - Все ошибки накапливаются в списке и по завершению //                  сканирования выдается в одном Ex. //                  При этом, Proc будет вызвана для всех ресурсов не вызвавших //                  ошибок. Это позволяет обработать максимально полный //                  список ресурсов, даже при наличии ошибок, которые можно //                  просто игнорировать. ///////////////////////////////////////////////// пока доступны только под WinNT procedure NetGetListServers  (aList :tStrings); // Заполняют aList списком серверов обнаруженных в сети. // Только под WinNT. // Ex: EWNetError procedure NetGetListSQLServers  (aList :tStrings); // Заполняют aList списком SQL-серверов (MS-SQL) обнаруженных в сети. // Только под WinNT. // Ex: EWNetError procedure NetEnumServers(aList :tStrings; ServersType :Cardinal =SV_TYPE_ALL); // Заполняет aList списком серверов обнаруженных в сети, соответствующего типа. // Только под WinNT. // Ex: EWNetError procedure NetEnumShare (aList :tStrings; ServerName :String =''); // Заполняет aList списком разделяемых ресурсов предоставляемых сервером // ServerName. По умолчанию своих. // Только под WinNT. // Ex: EWNetError function ServerInfoStr (ServerName :String) :String; // Возвращает строку с информацией о сервере ServerName. // Строки имеет вид: //   под NT+ - <ServerPlatform> <Version> <ServerType> //   под 9x  -                  <Version> <ServerType> // В принципе, это работающий, но рабочий вариант :). // Ex: EOSError

Присоединённый файл ( Кол-во скачиваний: 179 )
 awNetwork.zip

А вот еще модуль. Его я обычно использую для измерения времени исполнения процедур и даже отдельны фрагментов кода. Разрешающая способность составляет 1 такт процессора. Точность измерения конечно ниже, поскольку зависит от работы кэша процессора. Но она все равно значительно выше нежели все остальные известные мне способы использующие те или иные аппаратные таймеры.


Присоединённый файл ( Кол-во скачиваний: 241 )
 awStopWatch.zip

Вот, тут DRKB v2.3 натолкнул на мысль опубликовать еще один из модулей. К сожалению, автора исходного модуля мне установить не удалсь. Жаль, идеи заложенные в его модуле были очень хороши. Я лишь чуть усовершенствовал их.
Интерфейс:

Код

unit SafeUnit; // Является ремейком модуля "SafeUnit" неизвестного мне автора. interface uses Classes; /////////////////////////////////////////////////////////////////////////// IsAs (* Позволяет упростить вот такие фрагметы кода:  if aSomeObject is TMyObject then begin    aMyObject := aSomeObject as TMyObject;    // некоторые действия с aMyObject  end; При использовании функции IsAs это будет выглядить так:  if IsAs (aMyObject, aSomeObject, TMyObject) then begin    ... // некоторые действия с aMyObject  end; *) function IsAs (out   aReference {: Pointer};               const aObject     : TObject;               const aClass      : TClass) : Boolean; ////////////////////////////////////////////////////////////////// ExceptionSafe (* - "Накопитель" исключений Позволяет делать например следующее    with ExceptionSafe do      try        // Некоторые действия которые могут возбудить исключение        for aIndex := 1 to 10 do          try            ... // Некоторые действия которые могут возбудить исключение          except            SaveException;  // <- запоминание текста возникшего исключения в списке ExceptionSafe          end;        ... // Некоторые действия которые могут возбудить исключение        for aIndex := 10 to 20 do          try            ... // Некоторые действия которые могут возбудить исключение          except            SaveException;  // <- запоминание текста возникшего исключения в списке ExceptionSafe          end;        ... // Некоторые действия которые могут возбудить исключение      except        SaveException;  // <- запоминание текста возникшего исключения в списке ExceptionSafe      end;    end;// <===  Тогда, в момент выхода из With (<===), если был сохранен текст хотя бы  одного исключения, будет возбуждено Exception, с текстом всех сохраненных  в этом блоке исключений.  Формат текста:    Ex1.ClassName+': '+Ex1.Message  {+^M^J^I+ExN.ClassName+' '+ExN.Message} *) type  IExceptionSafe = interface    procedure SaveException;  end; function ExceptionSafe :IExceptionSafe; ///////////////////////////////////////////////////////////////////// ObjectSafe (* - Безопасный "контейнер" объектов и компонентов Пример использования:  procedure TestTheSafe;  var    aMyObject    :TMyObject;    aMyComponent :TMyComponent;  begin    with ObjectSafe do begin      // создание и регистрация объекта:      New (aMyObject, TMyObject.Create);      // или      aMyObject := TMyObject.Create; Guard(aMyObject);      // создание и регистрация компонента      aMyComponent := TMyComponent.Create (Safe);      ... // Некоторые действия которые могут возбудить исключение      // уничтожение экземпляра aMyObject      Dispose(aMyObject);      ... // Некоторые действия которые могут возбудить исключение    end; // <===  end;  Тогда, в момент выхода из With (<===), все объекты и компоненты  зарегестрированные в ObjectSafe, будут автоматически уничтожены (Free).  Причем, это произойжет даже если With будет покинут в результате  возникновения исключительной ситуации.  При уничтожении, сначала в произвольном порядке будут уничтожены  зарегестрированные объекты, а затем, будут уничтожены  зарегестрированные компоненты, так же в произвольном порядке. *) type  IObjectSafe = interface    function  Safe : TComponent;    function  New     (out   aReference {: Pointer};                       const aObject     : TObject) : IObjectSafe;    procedure Guard   (const aObject     : TObject);    procedure Dispose (var   aReference {: Pointer});  end; function ObjectSafe                                 : IObjectSafe; overload; function ObjectSafe (out aObjectSafe : IObjectSafe) : IObjectSafe; overload; //////////////////////////////////////////////////////////////////////////////// implementation /////////////////////////////////////////////////////////////////

Если интересно, то бери пристегнутый файл .

Присоединённый файл ( Кол-во скачиваний: 109 )
 SafeUnit.pas

Для пользователей библиотеки EhLib.
Мною, а так-же Alex'ом были сделаны несколько доработок некоторых модулей этой библиотеки.
Мои доработки следующие:

• (DBGridEh.pas) Изменена реакция на Ctrl+Up, Ctrl+Down, Ctrl+Shift+Up и Ctrl+Shift+Down.
  Ранее, они были эквивалентны соответственно сочетаниям Ctrl+PgUp, Ctrl+PgDown, Ctrl+Shift+PgUp и Ctrl+Shift+PgDown. Теперь, они действуют почти как в IDE Delphi - прокрутка окна просмотра, по возможности без изменения текущей позиции в наборе данных:
  Ctrl+Up - перемещение окна просмотра вверх (прокрутка вниз);
  Ctrl+Down - перемещение окна просмотра вниз (прокрутка вверх);
  Ctrl+Shift+Up - не действует;
  Ctrl+Shift+Down - не действует.
  
• (DBGridEh.pas) Исправлена ошибка. По крайней мере в v3.2 наблюдалось забавное поведение фильтра. А именно:
  Если задать (с клавиатуры) выражение фильтрования в каком-то поле, например во втором, и нажать Enter, то все прекрастно отфильтруется. Однако, если после этого сделать Grid.ClearFilter а затем Grid.ApplyFilter то, в отличие от ожиданий, ничего не произойдет. Т.е. не смотря на Grid.ClearFilter, во втором поле останется строка с условием фильтрования, и Dataset останется отфильтрованным!
  Поисходило это потому, что при Grid.ApplyFilter из редактора фильтра "извлекалось" текущее содержимое, и "запихивалось" обратно в STFilter.ExpressionStr соответствующей колонки.
  Отсюда, если перед Grid.ApplyFilter "перейти" в другую колонку, все будет нормально .
  В v3.4 такого дефекта вроде-бы не наблюдается, однако, "лечилка" не мешает, поэтому оставлена.
  
• (DBGridEh.pas) Изменено поведение при изменении фильтра и порядка сортировки.
  В исходном варианте, при испоьзовании датасетов требующих переоткрытия для обновления данных после изменения текста запроса, были на мой взгляд два неприятных момента которые я устранил:
  
  a. После переоткрытия датасета, теряется положение текущей записи - текущей
  становится первая запись. Это не очень удобно, особенно при изменения
  порядка сортировки. Да и при фильтровании, если текущая (до применения
  фильтра) запись присутствует в отфильтрованном наборе, хочется что-бы
  она же и осталось текущей.
  Для решения проблемы, перед закрытием датасета сохраняется список имен
  и значений полей текущей записи, и ее положение в гриде. Соответственно
  после открытия делается попытка спозиционировать датасет на эту запись
  (locate), и если попытка удачна, делается попытка восстановить ее
  положение в гриде (что-бы она осталась на той-же строке). Если запись не
  будет найдена, то как и ранее, грид будет спозиционирован на первую
  запись.
  
  b. Если колонки грида созданы динамически, а не в дизайнере (такое иногда
  бывает , то после переоткрытия теряется информация о маркерах
  сортировки, значениях фильтров, ширин колонок, и пр.. В общем всего что
  хранится в списке колонок, поскольку при закрытии датасета он очищается,
  а после открытия, создается заново со значениями по умолчанию.
  Чтобы предотвратить подобный ход событий, перед закрытием датасета,
  всем колонкам ставится признак IsStored (якобы они созданы в дизайнере).
  Естественно, реальное значение свойства IsStored всех колонок сохраняется
  и восстанавливается после открытия датасета.
  
  В моей реализации устранения этих моментов есть подводный камень:
  
  Может возникнуть ошибка, если после переоткрытия датасета изменится
  состав возвращаемых им полей. Например если датасет используется
  в рамках ReadCommited транзакции, и к моменту его переоткрытия кто-то,
  изменил на SQL-сервере метаданные объекта входящего в запрос. Хотя по моему,
  такая ситуация вряд-ли может встретиться в реальной жизни. Да и в случае
  "статически" (в дизайнере) созданных полей возникнет та-же бяка (хотя,
  пожалуй еще хуже будет).
  
  Конечно, сохранение позиции, надо-бы сделать включаемым/отключаемым опцией
  в OptionsEh. Но для этого, требуется коррекция еще и других модулей EhLib.
  Поэтому, это лучше делать автору.
  
  А вот фича "b", должна быть обязательно устранена, поскольку ее наличие
  делает невозможным нормальное использование сортировки и фильтрования
  с датасетами требующими переоткрытия.
  
• (DbUtilsEh.pas) Исправлена ошибка/недочет.
  
  В исходном варианте, в выражении фильтрования, нельзя было использовать константу 'NOW' допустимую в SQL.
  
• (EhLibADO.pas) Расширены возможности.
  
  В ADODataSetDriverName добавлена поддержка для MS SQL-сервера (по имени OLEDB провайдера).
  
• (EhLibIBX.pas) Исправлена ошибка.
  
  Некоторые версии сервера Interbase не допускает использования номеров полей
  в выражении ORDER BY, поэтому в конструктор объектов этого модуля добавлено:

Измененные модули для версии 3.5 приложены к посту. Для других версий можно сделать аналогично. Для этого, все мои изменения отмечены условной трансляцией по символу NoChangesBySAP

Это сообщение отредактировал(а) Петрович - 8.2.2005, 11:18

Присоединённый файл ( Кол-во скачиваний: 164 )
 EhLib_v3_5_units_modified_by_Petrovich.zip

Для пользователей библиотеки EhLib.
Мною, а так-же Alex'ом были сделаны несколько доработок некоторых модулей этой библиотеки.

Доработки от Alex:

• (DBCtrlsEh.pas и ToolCtrlsEh.pas) для контролов которые могут содержать доп.кнопки (наследники TCustomDBEditEh), добавлена возможность индивидуального управления активностью этих кнопок.
• (DBCtrlsEh.pas) исправлена ошибка (неточность) при работе с датами без указания года

Измененные модули для версии 3.5 приложены к посту. Для других версий можно сделать аналогично. Для этого, все изменения отмечены коментарием Alx

Это сообщение отредактировал(а) Петрович - 18.2.2005, 00:27

Присоединённый файл ( Кол-во скачиваний: 99 )
 EhLib_v3_5_units_modified_by_Alex.zip

Пример передачи файлов при помощи TClientSocke и TServerSocket

Очень многих интересует данный вопрос поэтому выкладываю сырячек.

Это пока так, зарисовочка, в дальнейшем планируется
доработать, оптимизировать и добавить кое-какие вещи.

Ну и соответвенно сделать примеры с использованием ICS и Indy.


Присоединённый файл ( Кол-во скачиваний: 546 )
 CustomWinSocket_0.1.rar

Посмотрев примеры в DRKB для перевода числа из одной системы счисления в другую, понял, что они предназначены не для глупого списывания, поэтому написал собственную функцию! код немного не оптимизированный, но все равно работает!
ПРЕДУПРЕЖДЕНИЕ: СИСТЕМЫ ПЕРЕВОДА ОТ 2 ДО 36!!! НЕ БОЛЬШЕ!

Код

function FromToAnySys(fromSys,ToSys: integer; chislo: string): string; var i,k,mo: integer; d: integer; buk: integer; step: integer; s,sl: string; s1: integer; m: string; function revert(n: string): string; var i: integer; q: string; begin for i:=length(n) downto 1 do begin  q:=q+n[i]; end; revert:=q; end; begin m:='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; s:=''; d:=0; for i:=1 to length(chislo) do begin  for k:=1 to 37 do   begin    if chislo[i]=m[k] then buk:=k-1;   end;  step:=strtoint(floattostr(power(FromSys,(length(chislo)-i))));  d:=d+(buk*step); end; while d<>0 do begin  mo:=d mod ToSys;  s:=s+m[mo+1];  d:=d div ToSys; end; result:=revert(s); end;

Вот реализация доработок EhLib от меня и Alex для версии 3.06. Подробнее см. здесь и здесь

Присоединённый файл ( Кол-во скачиваний: 153 )
 EhLib_v3_6_units_modified_by_Petrovich_Alex.zip

Этот пример показывает, как всего парой десятков строк можно использовать WMI (Windows Management Instrumentation) для просмотра информации о системе, железе, программах и многом другом...

Для компиляции нужно иметь библиотеки Jedi WinAPI...
Скачать их можно тут: http://members.chello.nl/m.vanbrakel2/ (архив около 2 метров)

При запуске программы будет показано три окошка:
Левое верхнее - список классов. Например, Win32_BIOS - инфа о биосе, Win32_Processor - о процессоре и т.д.
Правое верхнее окно - объявление выбранного класса (свойства и методы)
Нижнее - экземпляры выбранного класса...

WMI.ZIP (5 kb)

Присоединённый файл ( Кол-во скачиваний: 175 )
 WMI.ZIP

Компонент для работы с драйверами программы FileMon (Sysinternals - www.sysinternals.com).
***В компоненте реализованна полная потдержка управляющих команд в плоть до версии драйвера v436.
***Особые благодарности, за тест и конструктивные предложения: p0s0l-у

PS: Данный компонент выкладывается для ознакомительных целей. Использование его в своих программах допускается ... но на свой страх и риск! Так как Sysinternals запрещает использование их драйверов отдельно от FileMon

В присоединенке: Компонент и пример его использования(А также драйверы: новые и старые).

PS2: К сожалению... так и не смог найти подходящию иконку для компонента

Присоединённый файл ( Кол-во скачиваний: 168 )
 FileMon.zip

Сделал небольшой архив с примерами

Имя Описание
папки

05_1 Пример использования компонентов TTreeView и TTreeList
для просмотра информации из системного реестра Windows
05_2 Простой пример разработки собственного компонента
06_1 Ресурсы манифеста Windows XP
07_1 Пример использования в приложении списка объектов на основе
класса TList
07_2 Пример использования в приложении списка строк на основе
класса TStringList
10_1 Пример приложения, использующего компоненты Delphi
для отображения графики
10_2 Приложение для просмотра растровых приложений JPG, JPEG, BMP
11_1 Пример простейшего приложения баз данных
12_1 Пример использования параметров компонентов запросов SQL
и взаимодействия таких компонентов на основе передачи значений
параметров
14_1 Приложение баз данных, использующее отношение "один-ко-многим"
между таблицами базы данных
14_2 Приложение баз данных, демонстрирующее варианты поиска записей
в таблице базы данных
14_3 Пример использования закладок (класс TBookmark) в наборах
данных Delphi
15_1 Приложение баз данных, использующее компоненты синхронного
просмотра
16_1 Приложение баз данных, напрямую использующее API BDE
для полного удаления записей из таблиц базы данных
16_2 Приложение баз данных, напрямую использующее API BDE
для представления данных
17_1 Приложение баз данных, демонстрирующее возможности технологии
dbExpress
19_1 Приложение баз данных, демонстрирующее возможности
технологии ADO
21_1 Пример простого распределенного приложения баз данных
25_1 Пример использования компонента проекта отчета Rave Reports
и разработки простых отчетов в визуальной среде Rave Reports
26_1 Пример использования настраиваемого соединения на основе
компонента TRvCustomConnection
26_2 Пример отчетов Rave Reports для приложений баз данных
27_1 Пример реализации Drag-and-Drop
27_2 Пример реализации Drag-and-Dock
27_3 Пример реализации управления мышью
28_1 Пример создания динамической библиотеки
29_1 Приложение, использующее отдельный поток к памяти для расчета
числа
30_1 Приложение, использующее компоненты многомерного представления
данных
31_1 Пример приложения, использующего Shell API

пару папок удалил из архива, т.к. он получается больше 250 кБ.

Присоединённый файл ( Кол-во скачиваний: 484 )
 Example.zip

Примеры для работы с
1. MS Word
2. pop3
3. smtp
4. socket
5. mail - отправка почты

Примеры не мои личные

Присоединённый файл ( Кол-во скачиваний: 436 )
 dsergey.zip

Обмен данными между процессами. Сам не тестировал.

Присоединённый файл ( Кол-во скачиваний: 134 )
 FileMapping_ExchangeData.zip

Быстрая функция для разбивки строки на части (слова) в один цикл.

Код

type TDelim=set of Char;         TArrayOfString=Array of String;   //******************* // // Разбивает строку с разделителями на части // и возвращает массив частей // // fcToParts // function fcToParts(sString:String;tdDelim:TDelim):TArrayOfString var iCounter,iBegin:Integer; begin//fc if length(sString)>0 then  begin   include(tdDelim,#0);iBegin:=1; SetLength(Result,0);   For iCounter:=1 to Length(sString)+1 do    begin//for     if (sString[iCounter] in tdDelim) then      begin       SetLength(Result,Length(Result)+1);       Result[Length(Result)-1]:=Copy(sString,iBegin,iCounter-iBegin);       iBegin:=iCounter+1;      end;   end;//for  end;//if end;//fc

Пример использования

Код

var  StrArr:TArrayOfString StrArr:=fcToParts('строка1-строка2@строка3',['-','@']):

Делал тут ListBox с подсказками, получился такой вот компонент.

Компонент LSVListBox, потомок TListBox, использует всплывающие подсказки (Hint) для полного отображения
не умещающихся строк и позволяет изменять стиль подсказок (шрифт, цвета, дополнительные рамки, тень,
авторазмер), установить разные стили подсказок для выделенных и невыделенных пунктов.
Помимо этого не умещающиеся строки корректно обрезаются (с троеточием), имеется возможность изменить цвета для выделенных пунктов, отключить фокусирующий прямоугольник, уменьшено мерцание при прорисовке элементов, добавлены обработчики событий OnMouseEnter и OnMouseLeave

Это сообщение отредактировал(а) ДЫМ - 18.4.2005, 01:09

Присоединённый файл ( Кол-во скачиваний: 122 )
 LSVListBox.zip

Функция подмены разделителя целой и дробной части при вводе данных прямо в сетку, а также при вводе даты. Пользователя не должен думать о том, что ему правльно вводить в качетсве разделителя: точку или запятую
TfmMain - TForm

TDBGridEh - сетка из пакета EhLib, можно необязательно сетку, можно, просто TEdit.

Код

в разделе    public     { Public declarations } главной формы объявляем     Procedure DecPoint(Sender: TObject; var Key: Char); для доступности из всех остальных форм

Код

Procedure TfmMain.DecPoint(Sender: TObject; var Key: Char); begin  if (Sender is TDBGridEh) then    if (Sender as TDBGridEh).SelectedField.DataType=ftFloat then       if (Key='.') or (Key=',') then Key:=DecimalSeparator;  if (Sender is TDBEditEh) then    if (Sender as TDBEditEh).Field.DataType=ftDate then       if (Key='.') or (Key=',') then Key:=DateSeparator; end;

использование в OnKeyPress

Код

procedure TfmMain.DBGrid1KeyPress(Sender: TObject; var Key: Char); begin   DecPoint(Sender,Key); end;

Две полезные процедуры:

Код

uses    StrUtils; procedure CopyComponentProp(Source, Target: TObject; aExcept: array of string); // Копирование всех одинаковых по названию свойств/методов одного компонента в // другой за исключение "Name", "Left", "Top" и тех которые заданы в aExcept // Примеры использования: // CopyComponentProp(N11, N21, []); // CopyComponentProp(ListBox2, ListBox3, []); // CopyComponentProp(ListView1, ListView2, ['Items', 'Color']); var   I, Index: Integer;   PropName: string;   Source_PropList  , Target_PropList  : PPropList;   Source_NumProps  , Target_NumProps  : Word;   Source_PropObject, Target_PropObject: TObject;   // Поиск в списке свойства с заданным именем   function FindProperty(const PropName: string; PropList: PPropList; NumProps: Word): Integer;   var     I: Integer;   begin     Result:= -1;     for I:= 0 to NumProps - 1 do       if CompareStr(PropList^[I]^.Name, PropName) = 0 then begin         Result:= I;         Break;       end;   end; begin   if not Assigned(Source) or not Assigned(Target) then Exit;   Source_NumProps:= GetTypeData(Source.ClassInfo)^.PropCount;   Target_NumProps:= GetTypeData(Target.ClassInfo)^.PropCount;   GetMem(Source_PropList, Source_NumProps * SizeOf(Pointer));   GetMem(Target_PropList, Target_NumProps * SizeOf(Pointer));   try     // Получаем список свойств     GetPropInfos(Source.ClassInfo, Source_PropList);     GetPropInfos(Target.ClassInfo, Target_PropList);     for I:= 0 to Source_NumProps - 1 do begin       PropName:= Source_PropList^[I]^.Name;       if  (AnsiIndexText('None'  , aExcept                ) =  -1) and          ((AnsiIndexText(PropName, ['Name', 'Left', 'Top']) <> -1) or           (AnsiIndexText(PropName, aExcept                ) <> -1)) then Continue;       Index:= FindProperty(PropName, Target_PropList, Target_NumProps);       if Index = -1 then Continue; // не нашли       // Проверить совпадение типов       if Source_PropList^[I]^.PropType^.Kind <> Target_PropList^[Index]^.PropType^.Kind then         Continue;       case Source_PropList^[I]^.PropType^^.Kind of         tkClass:  begin                     Source_PropObject:= GetObjectProp(Source, Source_PropList^[I    ]);                     Target_PropObject:= GetObjectProp(Target, Target_PropList^[Index]);                     CopyComponentProp(Source_PropObject, Target_PropObject, ['None']);                   end;         tkMethod: SetMethodProp(Target, PropName, GetMethodProp(Source, PropName));       else         SetPropValue(Target, PropName, GetPropValue(Source, PropName));       end;     end;   finally     FreeMem(Source_PropList);     FreeMem(Target_PropList);   end; end;

Код

uses    StrUtils procedure AssignComponentProp(Source, Target: TObject; aProp: array of string); // Копирование свойств/методов заданых в aProp одного компонента в другой // Пример использования: // AssignedComponentProp(ListView1, ListView2, ['Items', 'Color']); var   I, Index: Integer;   PropName: string;   Source_PropList  , Target_PropList  : PPropList;   Source_NumProps  , Target_NumProps  : Word;   Source_PropObject, Target_PropObject: TObject;   // Поиск в списке свойства с заданным именем   function FindProperty(const PropName: string; PropList: PPropList; NumProps: Word): Integer;   var     I: Integer;   begin     Result:= -1;     for I:= 0 to NumProps - 1 do       if CompareStr(PropList^[I]^.Name, PropName) = 0 then begin         Result:= I;         Break;       end;   end; begin   if not Assigned(Source) or not Assigned(Target) then Exit;   Source_NumProps:= GetTypeData(Source.ClassInfo)^.PropCount;   Target_NumProps:= GetTypeData(Target.ClassInfo)^.PropCount;   GetMem(Source_PropList, Source_NumProps * SizeOf(Pointer));   GetMem(Target_PropList, Target_NumProps * SizeOf(Pointer));   try     // Получаем список свойств     GetPropInfos(Source.ClassInfo, Source_PropList);     GetPropInfos(Target.ClassInfo, Target_PropList);     for I:= 0 to Source_NumProps - 1 do begin       PropName:= Source_PropList^[I]^.Name;       if (AnsiIndexText('None'  , aProp   ) = -1) and          (AnsiIndexText(PropName, aProp   ) = -1) then Continue;       Index:= FindProperty(PropName, Target_PropList, Target_NumProps);       if Index = -1 then Continue; // не нашли       // Проверить совпадение типов       if Source_PropList^[I]^.PropType^.Kind <> Target_PropList^[Index]^.PropType^.Kind then         Continue;       case Source_PropList^[I]^.PropType^^.Kind of         tkClass:  begin                     Source_PropObject:= GetObjectProp(Source, Source_PropList^[I    ]);                     Target_PropObject:= GetObjectProp(Target, Target_PropList^[Index]);                     AssignComponentProp(Source_PropObject, Target_PropObject, ['None']);                   end;         tkMethod: SetMethodProp(Target, PropName, GetMethodProp(Source, PropName));       else         SetPropValue(Target, PropName, GetPropValue(Source, PropName));       end;     end;   finally     FreeMem(Source_PropList);     FreeMem(Target_PropList);   end; end;

Для пользователей библиотеки EhLib.

• (DBCtrlsEh.pas и ToolCtrlsEh.pas) для контролов которые могут содержать доп.кнопки (наследники TCustomDBEditEh), добавлена возможность индивидуального управления активностью этих кнопок.
• (DBCtrlsEh.pas) исправлена ошибка (неточность) при работе с датами без указания года.
• (ToolCtrlsEh.pas) для контролов которые могут содержать доп.кнопки (наследники TCustomDBEditEh), добавлено свойство Action. При задании свойства от Action кнопка наследует свойства: Enabled, Hint, ShortCut и Visible. Свойство доступно в Delphi 6 и выше.

Измененные модули для версии 3.6 приложены к посту. Для других версий можно сделать аналогично. Для этого, все изменения отмечены коментарием Alx

Присоединённый файл ( Кол-во скачиваний: 60 )
 EhLib_v3_6_units_modified_by_Alex.rar 55,99 Kb

Функция конвертации текста HTML содержащего строки вида &# 123; в читабельбный вид

Код

Function PreDecode(s:string):string;   function AddNumericChar(I: Integer):string;   var     W: WideChar;     Buffer: array[0..10] of char;   begin     if I = 9 then result := ' '        else if I < ord(' ') then  result := '?'  {control char}            else if (I < 256)  then   result := Chr(I)     else     begin     W := WideChar(I);     SetString(result, Buffer, WideCharToMultiByte(CP_ACP, 0,           @W, 1, @Buffer, SizeOf(Buffer), nil, nil))     end;   end; var val,i,ik:integer; sq:string; begin   for i:=1 to Length(s) do   begin       if ( (s[i]='&') and (s[i+1] ='#') ) then        begin           sq := Copy(s,i+2,length(s));           for ik:=1 to length(sq) do           begin             if not ( sq[ik] in ['0'..'9'] ) then             break;           end;           if  Copy(sq,1,ik-1) <> '' then           val := StrToInt( Copy(sq,1,ik-1) ) else val:=-1;           if ( (val <> -1) and (sq[ik] = ';')  )           then            begin              Result:=Result+AddNumericChar(val);              Delete(s,i,ik+1);             end;        end else  result:=Result+s[i];   end; end;

В аттаче пример работы с TaskBar (получене текста всех кнопок).

Это сообщение отредактировал(а) Rrader - 18.7.2008, 15:54

Присоединённый файл ( Кол-во скачиваний: 42 )
 Toolbar_Button_Enum.rar 7,59 Kb

 Функция, которая нарисует на форме сетку и сделает форму похожей на дизайнер форм Delphi. По умолчанию в дизайнере Delphi отступы равны 8 пикселям  
 
Ещё способ, рисует сетку либо линии на компоненте AObject цветом FGridColor, в параметре ACanvas нужно передать холст компонента, FSizeX и FSizeY определяют размер сетки либо линий:
  

Это сообщение отредактировал(а) Rrader - 24.6.2006, 11:57

Пример использование методов интерфейса IShellDispatch (это интересно ).

Код

Unit UMain; Interface Uses   Windows, Messages, SysUtils, Classes,   Graphics, Controls, Forms, Dialogs, StdCtrls,   ComObj, ActiveX, XPMan; Const   CLASS_Shell: TGUID = '{13709620-C279-11CE-A49E-444553540000}'; Type   TMainForm = Class(TForm)     FolderBtn: TButton;     GroupBox1: TGroupBox;     OpenBtn: TButton;     EdFolder: TEdit;     MinAllBtn: TButton;     UnMinAllBtn: TButton;     RunBtn: TButton;     ExitWinBtn: TButton;     FindBtn: TButton;     CmpFndBtn: TButton;     GroupBox2: TGroupBox;     DTBtn: TButton;     TaskBtn: TButton;     Helpbtn: TButton;     ApplBtn: TButton;     Label1: TLabel;     EdAppl: TEdit;     procedure FormCreate(Sender: TObject);     procedure FolderBtnClick(Sender: TObject);     procedure OpenBtnClick(Sender: TObject);     procedure MinAllBtnClick(Sender: TObject);     procedure UnMinAllBtnClick(Sender: TObject);     procedure RunBtnClick(Sender: TObject);     procedure ExitWinBtnClick(Sender: TObject);     procedure FindBtnClick(Sender: TObject);     procedure CmpFndBtnClick(Sender: TObject);     procedure HelpbtnClick(Sender: TObject);     procedure DTBtnClick(Sender: TObject);     procedure TaskBtnClick(Sender: TObject);     procedure ApplBtnClick(Sender: TObject);   Private     { Private declarations }   Public     { Public declarations }   End;   FolderItemVerb = Interface(IDispatch)     ['{08EC3E00-50B0-11CF-960C-0080C7F4EE85}']     Function Get_Application: IDispatch; Safecall;     Function Get_Parent: IDispatch; Safecall;     Function Get_Name: WideString; Safecall;     Procedure DoIt; Safecall;     Property Application: IDispatch Read Get_Application;     Property Parent: IDispatch Read Get_Parent;     Property Name: WideString Read Get_Name;   End;   FolderItemVerbs = Interface(IDispatch)     ['{1F8352C0-50B0-11CF-960C-0080C7F4EE85}']     Function Get_Count: Integer; Safecall;     Function Get_Application: IDispatch; Safecall;     Function Get_Parent: IDispatch; Safecall;     Function Item(index: OleVariant): FolderItemVerb; Safecall;     Function _NewEnum: IUnknown; Safecall;     Property Count: Integer Read Get_Count;     Property Application: IDispatch Read Get_Application;     Property Parent: IDispatch Read Get_Parent;   End;   FolderItem = Interface(IDispatch)     ['{FAC32C80-CBE4-11CE-8350-444553540000}']     Function Get_Application: IDispatch; Safecall;     Function Get_Parent: IDispatch; Safecall;     Function Get_Name: WideString; Safecall;     Procedure Set_Name(Const pbs: WideString); Safecall;     Function Get_Path: WideString; Safecall;     Function Get_GetLink: IDispatch; Safecall;     Function Get_GetFolder: IDispatch; Safecall;     Function Get_IsLink: WordBool; Safecall;     Function Get_IsFolder: WordBool; Safecall;     Function Get_IsFileSystem: WordBool; Safecall;     Function Get_IsBrowsable: WordBool; Safecall;     Function Get_ModifyDate: TDateTime; Safecall;     Procedure Set_ModifyDate(pdt: TDateTime); Safecall;     Function Get_Size: Integer; Safecall;     Function Get_type_: WideString; Safecall;     Function Verbs: FolderItemVerbs; Safecall;     Procedure InvokeVerb(vVerb: OleVariant); Safecall;     Property Application: IDispatch Read Get_Application;     Property Parent: IDispatch Read Get_Parent;     Property Name: WideString Read Get_Name Write Set_Name;     Property Path: WideString Read Get_Path;     Property GetLink: IDispatch Read Get_GetLink;     Property GetFolder: IDispatch Read Get_GetFolder;     Property IsLink: WordBool Read Get_IsLink;     Property IsFolder: WordBool Read Get_IsFolder;     Property IsFileSystem: WordBool Read Get_IsFileSystem;     Property IsBrowsable: WordBool Read Get_IsBrowsable;     Property ModifyDate: TDateTime Read Get_ModifyDate Write Set_ModifyDate;     Property Size: Integer Read Get_Size;     Property Type_: WideString Read Get_type_;   End;   FolderItems = Interface(IDispatch)     ['{744129E0-CBE5-11CE-8350-444553540000}']     Function Get_Count: Integer; Safecall;     Function Get_Application: IDispatch; Safecall;     Function Get_Parent: IDispatch; Safecall;     Function Item(Index: OleVariant): FolderItem; Safecall;     Function _NewEnum: IUnknown; Safecall;     Property Count: Integer Read Get_Count;     Property Application: IDispatch Read Get_Application;     Property Parent: IDispatch Read Get_Parent;   End;   Folder = Interface(IDispatch)     ['{BBCBDE60-C3FF-11CE-8350-444553540000}']     Function Get_Title: WideString; Safecall;     Function Get_Application: IDispatch; Safecall;     Function Get_Parent: IDispatch; Safecall;     Function Get_ParentFolder: Folder; Safecall;     Function Items: FolderItems; Safecall;     Function ParseName(Const bName: WideString): FolderItem; Safecall;     Procedure NewFolder(Const bName: WideString; vOptions: OleVariant); Safecall;     Procedure MoveHere(vItem: OleVariant; vOptions: OleVariant); Safecall;     Procedure CopyHere(vItem: OleVariant; vOptions: OleVariant); Safecall;     Function GetDetailsOf(vItem: OleVariant; iColumn: SYSINT): WideString; Safecall;     Property Title: WideString Read Get_Title;     Property Application: IDispatch Read Get_Application;     Property Parent: IDispatch Read Get_Parent;     Property ParentFolder: Folder Read Get_ParentFolder;   End;   IShellDispatch = Interface(IDispatch)     ['{D8F015C0-C278-11CE-A49E-444553540000}']     Function Get_Application: IDispatch; Safecall;     Function Get_Parent: IDispatch; Safecall;     Function NameSpace(vDir: OleVariant): Folder; Safecall;     Function BrowseForFolder(Hwnd: Integer; Const Title: WideString;       Options: Integer; RootFolder: OleVariant): Folder; Safecall;     Function Windows: IDispatch; Safecall;     Procedure Open(vDir: OleVariant); Safecall;     Procedure Explore(vDir: OleVariant); Safecall;     Procedure MinimizeAll; Safecall;     Procedure UndoMinimizeALL; Safecall;     Procedure FileRun; Safecall;     Procedure CascadeWindows; Safecall;     Procedure TileVertically; Safecall;     Procedure TileHorizontally; Safecall;     Procedure ShutdownWindows; Safecall;     Procedure Suspend; Safecall;     Procedure EjectPC; Safecall;     Procedure SetTime; Safecall;     Procedure TrayProperties; Safecall;     Procedure Help; Safecall;     Procedure FindFiles; Safecall;     Procedure FindComputer; Safecall;     Procedure RefreshMenu; Safecall;     Procedure ControlPanelItem(Const szDir: WideString); Safecall;     Property Application: IDispatch Read Get_Application;     Property Parent: IDispatch Read Get_Parent;   End;   CoShell = Class     Class Function Create: IShellDispatch;     Class Function CreateRemote(Const MachineName: String): IShellDispatch;   End; Var   MainForm: TMainForm;   I: IShellDispatch; Implementation {$R *.dfm} { CoShell } Class Function CoShell.Create: IShellDispatch; Begin   Result := CreateComObject(CLASS_Shell) As IShellDispatch; End; Class Function CoShell.CreateRemote(Const MachineName: String): IShellDispatch; Begin   Result := CreateRemoteComObject(MachineName, CLASS_Shell) As IShellDispatch; End; Procedure TMainForm.FormCreate(Sender: TObject); Begin   I := CoShell.Create; End; Procedure TMainForm.FolderBtnClick(Sender: TObject); Var   F: Folder; Begin   { Работа с папкой }   F := I.BrowseForFolder(Handle, 'IShellDispatch example', 0, 0);   If F = NIL Then Exit;   If F.ParentFolder <> NIL Then   Begin     { Показ имени родительской папки }     ShowMessage(F.ParentFolder.Title);     { Показ количества дочерних папок }     ShowMessage(IntToStr(F.Items.Count));   End; End; Procedure TMainForm.OpenBtnClick(Sender: TObject); Begin   { Открытие папки }   Try     I.Explore(EdFolder.Text);   Except     Exit;   End; End; Procedure TMainForm.MinAllBtnClick(Sender: TObject); Begin   { Свернуть все окна }   I.MinimizeAll; End; procedure TMainForm.UnMinAllBtnClick(Sender: TObject); Begin   I.UndoMinimizeALL; End; Procedure TMainForm.RunBtnClick(Sender: TObject); Begin   { Окно "Выполнить..." }   I.FileRun; End; Procedure TMainForm.ExitWinBtnClick(Sender: TObject); Begin   { Выключить Windows }   I.ShutdownWindows; End; Procedure TMainForm.FindBtnClick(Sender: TObject); Begin   { Поиск }   I.FindFiles; End; Procedure TMainForm.CmpFndBtnClick(Sender: TObject); Begin   { Поиск компьютеров }   I.FindComputer; End; Procedure TMainForm.HelpbtnClick(Sender: TObject); Begin   { Вызов справки }   I.Help; End; Procedure TMainForm.DTBtnClick(Sender: TObject); Begin   { Апплет: дата/время }   I.SetTime; End; Procedure TMainForm.TaskBtnClick(Sender: TObject); Begin   { Апплет: панель задач }   I.TrayProperties; End; Procedure TMainForm.ApplBtnClick(Sender: TObject); Begin   { Запуск своего апплета }   I.ControlPanelItem(EdAppl.Text); End; End.

Проект с формой находится в аттаче.

Присоединённый файл ( Кол-во скачиваний: 132 )
 IShellDispatch.zip 11,87 Kb

Как сделать ProgressBar таким же, как на заставке Windows XP
Вопос задается часто, вот решение без каких-либо компонентов:

Код

unit Unit1; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,   Dialogs, XPMan, ComCtrls, StdCtrls; type   TForm1 = class(TForm)     Button1: TButton;     ProgressBar1: TProgressBar;     Button2: TButton;     procedure Button1Click(Sender: TObject);     procedure Button2Click(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; var   Form1: TForm1; const   PBS_MARQUEE = $08;   PBM_SETMARQUEE = WM_USER + 10; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var   FSpeed: Integer; begin   FSpeed := 100;   SetWindowLong(ProgressBar1.Handle, GWL_STYLE,     GetWindowLong(ProgressBar1.Handle, GWL_STYLE) Or PBS_MARQUEE);   { Включить }   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 1, FSpeed); end; procedure TForm1.Button2Click(Sender: TObject); begin   { Выключить }   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, 0, 0); end; end.

Периодически читаю рассылку этого форума. Хочу поделиться своими наработками (обновленной версией). Последние лет 5 при работе над текущими проектами пытаюсь выносить код общего назначения в отдельные библиотеки. Думаю, что выкладываемые исходники библиотек, а также реализованные в них идеи по универсализации функций и классов могут быть интересны и остальным.

ALLLIB. НАБОР ИСХОДНИКОВ ДЛЯ РАСШИРЕНИЯ ФУНКЦИОНАЛА СТАНДАРТНЫХ БИБЛИОТЕК DELPHI. ВЕРСИЯ ОТ 9.01.2006

Исходники библиотек: http://vstepanov78.narod.ru/alllib.zip
Краткая справка: http://vstepanov78.narod.ru/prog.htm#alllib

ОБЗОР ФУНКЦИОНАЛА

1. ОБЩИЕ ФУНКЦИИ (типы, строки, варианты, память, списки, таблицы, потоки, файлы, ini, реестр, многопоточность, исключения, языки):
- КОНВЕРТАЦИЯ ТИПОВ: конвертация строк и вариантов в типы и наоборот с автораспознаванием многих форматов независимо от настроек разделителей Windows (включая сложные форматы вроде '1 443,45', '12=34', '1111011b', '30-JAN-2004', '30/01/04 11:12:55.945', 'Wed Mar 13 19:15:06 UTC+0300 2002'), варианты функций без порождения исключений и использования SysUtils и с порождением исключений;
- КОДИРОВАНИЕ: кодирование и декодирование (строки C++/JScript и Pascal, Base64, HTML, URLEncode/URLDecode, KOI, ISO, Wide формата Windows NT и с нечетным количеством байт, XOR и др.), в том числе поддерживается быстрое кодирование длинных строк; разбор Delphi-форм DFM, включая бинарные; проверка соответствия маске и извлечение по маске (маски - с символами '?' и '*'); увеличение, уменьшение и округление даты до секунд, минут, часов, дней, месяцев, лет; поиск и замена в строке, добавление и извлечение строки из массива, хранимого в строке; извлечение строки текста при разных вариантах перевода строки, выравнивание колонок текста, функции парсинга выражений без использования объектов;
- ПАМЯТЬ: контроль утечек объектов и возможность контроля утечек памяти, дескрипторов; работа со списком и списком списков без SysUtils и использования объектов с заданием емкости, работа со строкой с заданием емкости и перераспределением памяти при превышении емкости, наращиваемой шагами; буфер в строку, изменение регистра и регистронезависимое сравнение блоков памяти, перемещение с перекрытием;
- СПИСКИ: индексируемые списки и таблицы без изменения порядка элементов с построением индекса при первой попытке поиска, поиск в таблице по любому набору колонок (списки и таблицы - указателей, строк, вариантов); иерархия без VCL;
- ПОТОКИ: обертки потоков с кэшированием чтения и записи, возможностью чтения следующего фрагмента данных без смещения позиции благодаря кэшу, извлечением следующей строки до перевод строки;
- ФАЙЛЫ: список файлов, копирование и удаление по маске с возможностью просмотра подкаталогов, вызовом прогресса; собственное имя DLL, получение версии библиотеки; поиск файла в %PATH%, разбор командной строки; работа с ярлыками, Map-файлами; простые функции файл в строку и строка в файл; простая функция записи в лог или на консоль с однозначно интерпретируемым форматом лога, поддержка отладки во многих функциях и объектах библиотеки; диалоги выбора файла и папки без VCL и SysUtils; вставка и извлечение из буфера обмена с правильной обработкой русских букв;
- INI: ini в памяти или потоке, возможность работы с секцией без имени, значениями параметров любой длины, быстрый поиск, сохранение комментариев; быстрое чтение иерархической конфигурации в многомерный массив вариантов;
- РЕЕСТР: реестр с корректной работой при ограниченных правах доступа, экспортом, импортом и удалением ключа с подразделами;
- МНОГОПОТОЧНОСТЬ: threadvar с инициализацией и завершением, правильной работой в Delphi 3, поддержка многопоточности всем кодом, инициализация и автоосвобождение объектов без увеличения кода приложения в случае подключения библиотеки без обращений к объекту библиотеки из приложения, работа с критическими секциями без SysUtils;
- ИСКЛЮЧЕНИЯ: отдельные модули сокращенных аналогов SysUtils для небольших приложений; объекты исключений с именем процедуры и кодом ошибки, в том числе поддержкой определения текста по коду ошибки Windows; список информации об исключениях;
- ЯЗЫКИ: русские и английские языковые константы, динамический выбор языка; чтение текущего языка системы; сумма прописью для разных валют на русском и английском с torry.ru без необходимости ini-файла; проверка ключевания счета;
- УДОБНЫЕ ФУНКЦИИ И ДР.: прочие функции для конвертации типов, удобной работы со строками вроде IIf, IfEmpty, AddPrefix, AddPostfix, JoinStr, вариантами, файлами.

2. СПЕЦИАЛИЗИРОВАННЫЕ ФУНКЦИИ (окна, база, интернет, COM, интерпретация скриптов, процессы, сжатие, привязка к компьютеру, графика):
- ДИАЛОГИ: диалоги без VCL, SysUtils и ресурсов - функции ввода строки, пароля, логина и пароля, просмотра и редактирование текста с выбором кодировки, ввода имени файла или выбора каталога, ввода случайной последовательности (функции взывают дочерние объекты от единого абстрактного объекта диалога без VCL); добавление иконки в системную область панели задач; получение списка окон верхнего уровня или иерархии с дочерними окнами; скроллирование в конец и поиск в TRichEdit в VCL, быстрое получение и обновление списка TListView и иерархии TTreeView из списка и иерархии в памяти;
- БАЗЫ ДАННЫХ: работа с базами данных через ADO без VCL, загрузка выборки таблиц в индексируемую таблицу вариантов в памяти и обновление выборки таблицы в базе по содержимому таблицы в памяти при заданных ключевых полях, в том числе с корректной работой с BLOB-полями для MS-SQL, Sybase, Oracle (с поддержкой ISO Cyrillic), Interbase; получение версии ADO;
- ИНТЕРНЕТ: работа с сокетами для сервера и клиента без VCL и SysUtils; отсылка HTTP- или HTTPS-запроса с получением ответа через WinInet; подключение к интернету, выход из Offline-режима браузера, получение собственных IP-адресов, разбор HTTP-ссылки; обертки ASP- и HTML-объектов с общим предком, делающим однотипным доступ к параметрам (полям) формы из сервера и клиента; общий метод чтения из ASP параметров сертификата CryptoAPI/Крипто-Про и Сигнал-КОМ Inter-PRO Client; отсылка почты простой функцией;
- СКРИПТЫ: поддержка интерфейса IActiveScript устанавливаемого с браузером интерпретатора JScript, VBScript (напрямую, без использования ScriptControl); поддержка интерфейса IDispatch (без необходимости написания и регистрации ocx), например, для встраивания COM-объекта в пространство имен IActiveScript для обращения к нему из скрипта; внутренний парсер функции строки обращения к COM-объекту с параметрами; получение GUID;
- ПРОЦЕССЫ: список имен и идентификаторов процессов (с поддержкой Windows 95/NT+); запуск задачи с ожиданием завершения или ожиданием создания ею первого окна, открытие документа (также есть возможность ожидания заданного промежутка времени с обработкой событий без VCL или ожидания появления файла); объекты межзадачного обмена с помощью сообщений Windows и прямой записи в память процесса; запуск приложения от имени пользователя; запуск и остановка сервиса, включая таймаут ожидания зависимых сервисов; запуск и остановка приложений COM+ в Component Services;
- СЖАТИЕ: сжатие и распаковка строки путем использования библиотеки Delphi ZLib (без внешних dll); распаковка CAB-файла;
- ПРИВЯЗКА К КОМПЬЮТЕРУ: привязка приложения к компьютеру, чтение напрямую из оборудования идентификатора и серийного номера CPU (также корректное определение частоты процессора), версии, даты, производителя и серийного номера BIOS, модели, версии и серийного номера контроллера HDD (возможно чтение для первых четырех жестки дисков) - всего используется порядка 14 различных способов обращении к оборудованию, благодаря чему поддерживаются Windows 95/98/ME/NT/2000/XP/2003, получение одинаковой информации при различных правах пользователя, включая гостевые; также чтение системной информации PCI-драйверах, версии Windows и Internet Explorer, доступных шрифтах;
- ГРАФИКА: поддержка загрузки GIF, PCX - позаимствованы с torry.ru, сделана динамическая инициализация; поддержка загрузки других форматов графики, в том числе TIF, PNG с помощью GDI+ (сделана динамически, т.к. библиотека может отсутствовать в старых Windows); функция изменения яркости картинки;
- ФИНАНСОВЫЕ И ДР.: прочие специализированные функции и классы конвертации, в том числе в и из формата 1С, поддержки HTTP-транспорта, получения информации об автозагружаемых процессах Windows.

3. КРИПТОГРАФИЯ (поддержка библиотек асимметричной шифрации и ЭЦП, симметричная шифрация и CRC):
- CRYPTOAPI/КРИПТО-ПРО: асимметричная шифрация и дешифрация, подпись и проверка ЭЦП с использованием CryptoAPI RSA, RSA-128 и Крипто-Про ГОСТ 28147-89, ГОСТ Р 34.11/34.10-94/2001 с возможностью кэширования ключей (прямое обращение к CryptoAPI), доступна симметричная шифрация (на сессионном ключе) и асимметричная шифрация на секретном и открытом ключе, секретном ключе и сертификате, автораспознавание Base64 и PEM-форматов запроса и сертификата, возможность хранения ключей Крипто-Про в файлах с временным импортом в реестр на период криптооперации и экспортом после нее; генерация ключей, формирование запросов на сертификат и установка сертификатов без и с использованием xenroll.dll, выпуск или отзыв сертификата по запросу в Microsoft Certification Authority, проверка действительности сертификата; поиск сертификата в хранилище по набору параметров, чтение его полей, добавление сертификата в хранилище, диалоги просмотра и выбора сертификатов; список установленных в системе типов криптопровайдеров, их имен и параметров, поддерживаемых алгоритмов и алгоритмов по умолчанию;
- СИГНАЛ-КОМ: асимметричная шифрация и дешифрация, подпись и проверка ЭЦП с использованием trial-версии Сигнал-КОМ Message-PRO RSA и СКЗИ ГОСТ 28147-89, ГОСТ Р 34.11/34.10-94/2001 с возможностью кэширования ключей; значения полей сертификата и просмотр содержимого сертификата аналогично диалогу в Сигнал-КОМ Inter-PRO; эмуляция диалога генерации случайной последовательности при ее отсутствии для ранних версий mespro.dll (аналогично имеющемуся в поздних);
- СИММЕТРИЧНОЕ ШИФРОВАНИЕ И CRC: симметричная шифрация и дешифрация по алгоритмам Blowfish, RC6, GOST, контрольная сумма CRC32 - позаимствованы с torry.ru, добавлена возможность кэширования ключей шифрования, чтобы не проводить повторную инициализацию, занимающую некоторое время, добавлена возможность поточного шифрования; формирование и однозначный разбор строки X500 с поддержкой имен параметров, используемых в CryptoAPI и Message-PRO.

ОСОБЕННОСТИ БИБЛИОТЕК:
- совместимость с Delphi 3 - Delphi 7 (преимущественно тестируется на Delphi 5);
- при подключении модулей в код EXE добавляются только те функции и объекты, которые реально вызываются в программе;
- динамическое подключение функций различных API, если они могут отсутствовать в Windows 95 или Windows NT, при этом для последних, по возможности, вызывается альтернативная функция, иногда недокументированная;
- все глобальные описания и объекты многопоточны или чаще создается отдельная копия глобального объекта в каждом потоке;
- библиотеки не требуют установки компонентов и прописывания путей в Delphi, при компиляции нет Warnings и Hints, публичные объекты и функции откомментированы на русском.


ПРИЛАГАЕТСЯ: UTILS.EXE. УТИЛИТА С ИНТЕРФЕЙСОМ И ПОДДЕРЖКОЙ КОМАНДНОЙ СТРОКИ И ЕЕ ИСХОДНИКИ НА DELPHI (ТРЕБУЮТ ALLLIB). ВЕРСИЯ ОТ 9.01.2006

Утилита и ее исходники: http://vstepanov78.narod.ru/utils.zip

Функции: графический просмотр и проигрывание файлов, блокнот с поддержкой шифрования, вывода оглавления; конвертация (Base64 и др.) и двоичный редактор файлов; просмотр, правка и экспорт в SQL-запросы значений полей базы данных, включая BLOB-поля; список запущенных процессов с корректным завершением; список активных окон по задачам; системная информация; запускаемые при старте Windows процессы; отправка и прием данных через серверный или клиентский сокет, включая двоичные данные, WhoIs, отправка почты; генерация ключей, запрос, издание и установка сертификатов, в том числе для сервера, для алгоритмов CryptoAPI RSA и Крипто-Про ГОСТ; шифрация и дешифрация, подпись и проверка ЭЦП для алгоритмов CryptoAPI RSA и Крипто-Про ГОСТ, а также Сигнал-КОМ Message-PRO, перепривязка секретного ключа от одного сертификата CryptoAPI к другому.

Мини - прога для расчета промежутка времени...


Присоединённый файл ( Кол-во скачиваний: 77 )
 raschet_vremeni.zip 9,07 Kb