Програмное выключение клавиатуры и мыши
Програмное выключение клавиатуры и мыши
winexec(Pchar('rundll32 keyboard,disable' ) ,sw_Show); Клава OFF
winexec(Pchar('rundll32 mouse,disable' ) ,sw_Show); Маус OFF
кстати а вот так клава врубается
Отрубить
Asm
in al,21h
or al,00000010b
out 21h,al
End;
Врубить
Asm
in al,21h
mov al,0
out 21h,al
End;
Автор ответа: RAdmin
Взято с Vingrad.ru
BlockInput(), живёт в user32.dll
Автор ответа: Song
Взято с Vingrad.ru
Как скрыть курсор мышки
Поместите в событие OnClick в button1 и button2 следующие коды.Если курсор мышки скрыт, то выбрать button2 можно клавишей Tab.
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowCursor(False);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowCursor(True);
end;
Взято с Исходников.ru
Проход дерева каталогов
Проход дерева каталогов
Procedure ScanDir(Dir:string);
var SearchRec:TSearchRec;
begin
if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
repeat
if (SearchRec.name='.') or (SearchRec.name='..') then continue;
if (SearchRec.Attr and faDirectory)<>0 then
ScanDir(Dir+SearchRec.name) //we found Directory: "Dir+SearchRec.name"
else
Showmessage(Dir+SearchRec.name); //we found File: "Dir+SearchRec.name"
until FindNext(SearchRec)<>0;
FindClose(SearchRec);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ScanDir('c:');
end;
Автор ответа Vit
Взято с Vingrad.ru
Прокрутка, ScrollBox
Прокрутка, ScrollBox
Cодержание раздела:
См. также статьи в других разделах:
Прокрутка таблицы - хитрость PeekMessage
Прокрутка таблицы - хитрость PeekMessage
На днях я решил поиграть с API-функцией PeekMessage(). Функция работает, но ловить ее нужно следующим образом.
Я прокручиваю таблицу, связанную с набором данных. "Поиск" в наборе данных замедляет процесс скролирования (условимся называть "поиском" синхронное перемещение табличного курсора в процессе скроллирования, при котором текущей записью становится запись, ближайшая к нажимаемой кнопке полосы прокрутки). Возникла задача: необходимо отменить "поиск" (процесс слежения) и переместить указатель на необходимую запись только в случае остановки пользователем процесса скроллирования, другими словами - пока пользователь осуществляет скроллирование, "поиск" необходимо отменить. Итак, ко мне в голову пришла мысль, что с помощью PeekMessage() можно выловить определенное сообщение и тем самым отменить поиск во время прокрутки. Звучит просто, но на самом деле все оказалось наоборот.
Я установил фильтр поиска сообщений на WM_MOUSEFIRST/LAST. Ситуация: пользователь непрерывно прокручивает DBGrid вниз, т.е. держит нажатой нижнюю кнопку скроллирования. В результате PeekMessage() возвращает False - нас это не устраивает, это не то, что мы хотим. Положительный результат можно получить только в случае сверхскоростных манипуляций мышью.
Если в фильтре использовать 0 и 0, чтобы поймать любое сообщение, результат всегда будет True. Причина, очевидно в том, что любой щелчок мыши в области DBGrid никак не обойдется без последствий, генерация системой сообщения PAINT яркий тому пример, поэтому PeekMessage может возвратить True в любое время, что тоже не может нам помочь.
Было бы хорошо, если бы дескриптор DBGrid получал событие OnMouseUp() во время его скроллирования. Обидно, но OnMouseUp() работает только с DBGrid, а не с полосами прокрутки. OnMouseUp() с TForm при KeyPreview:=true не работает, я проверял.
После пришла идея опросить состояние кнопок мыши с помощью функции GetKeyState(). Пока кнопка нажата (DOWN), "поиск" запрещен, и наоборот. UP (кнопка отжата) свидетельствует об окончании процесса скроллирования. Данный способ работы с окном во время манипуляций с его полосой прокрутки заработал без проблем. Теперь все в порядке: поиска во время прокрутки не происходит и табличный курсор также никуда не перемещается.
Рассмотренная тема имеет отношение к полосам прокрутки, а события OnKeyUp() и OnMouseUp() могут применяться где-нибудь еще.
Взято из
Прокрутка TreeView, чтобы держать выделение посередине
Прокрутка TreeView, чтобы держать выделение посередине
procedureTMyForm.TreeChange(Sender: TObject; Node: TTreeNode);
var
i : integer;
pp, cp : TTreeNode;
begin
if Assigned(Tree.Selected) then
begin
cp := Tree.Selected;
pp := cp;
for i := 1 to Round(Tree.Height/30) do
if cp <> nil then
begin
pp := cp;
cp := cp.GetPrevVisible;
end;
Tree.TopItem := pp;
end;
end;
Взято с
Просмотрщик запущенных процессов
Просмотрщик запущенных процессов
Автор: Василий
Программа не видна по Ctrl+Alt+Del, и сама оттуда же может спрятать любой из процессов(правда, не все с самого начала "светятся" по Ctrl+Alt+Del) или завершить его. Простой пример для знакомства с ToolHelp32.
В исходном коде есть недоработки, например, процедура Delproc получает в качестве параметра строку, затем переводит ее в целочисленный тип(integer), хотя можно передавать сразу число. Заморочка была в проверке числа-индекса на подлинность, а так как я выдрал часть кода из более ранней своей проги, я не стал это менять, а просто подогнал до рабочей версии. Оптимизацией кода вы можете заняться сами по желанию(вы можете, если хотите, а если не хотите, то вы не обязаны, вы посто могли бы... да... :))) Программа не работала в WinNT 4.0, но в Win9x работать должна.
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, tlhelp32, StdCtrls, ComCtrls, Buttons;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Button5: TButton;
StatusBar1: TStatusBar;
Button6: TButton;
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
procedure ListProcesses;
procedure Delproc(numb:string);
public
{ Public declarations }
end;
var
Form1: TForm1;
processID:array[1..50] of integer;
function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'kernel32.dll';
implementation
{$R *.DFM}
procedure TForm1.delproc(numb:string);
var
c1:Cardinal;
pe:TProcessEntry32;
s1,s2:string;
x:integer;
begin
x:=0;
try
Strtoint(numb);
except
Statusbar1.SimpleText:='Invalid number';
exit;
end;
c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
if c1=INVALID_HANDLE_VALUE then
begin
Statusbar1.SimpleText:='Process listing failed';
exit;
end;
try
pe.dwSize:=sizeof(pe);
if Process32First(c1,pe) then
repeat
inc(x);
s1:=ExtractFileName(pe.szExeFile);
s2:=ExtractFileExt(s1);
Delete(s1,length(s1)+1-length(s2),maxInt);
if x=strtoint(numb) then
if terminateprocess(OpenProcess(PROCESS_ALL_ACCESS,false,pe.th32ProcessID),1)
then begin
Statusbar1.SimpleText:='Process '+s1+' terminated.';
end
else Statusbar1.SimpleText:=('Couldnt terminate process'+pe.szExeFile);
until not Process32Next(c1,pe);
finally CloseHandle(c1);
end;
end;
procedure Tform1.ListProcesses;
var c1:Cardinal;
pe:TProcessEntry32;
s1,s2:string;
x:integer;
begin
X:=0;
c1:=CreateToolHelp32Snapshot(TH32CS_SnapProcess,0);
if c1=INVALID_HANDLE_VALUE then
begin
Statusbar1.SimpleText:=('Информация о процессах закрыта.');
exit;
end;
try
pe.dwSize:=sizeof(pe);
if Process32First(c1,pe) then
repeat
inc(x);
s1:=ExtractFileName(pe.szExeFile);
s2:=ExtractFileExt(s1);
Delete(s1,length(s1)+1-length(s2),maxInt);
Listbox1.Items.Add(Inttostr(x)+' '+s1+' : '+pe.szExeFile);
ProcessId[x]:=pe.th32ProcessID;
//ListBox1.Items.Add(inttostr(pe.th32ProcessID));
until not Process32Next(c1,pe);
finally CloseHandle(c1);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Enabled:=false;
Button5.Enabled:=false;
Button6.Enabled:=false;
ListProcesses;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Listbox1.Clear;
ListProcesses;
end;
procedure TForm1.Button1Click(Sender: TObject);
var p:integer;
begin
//hide
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(ProcessID[p],1);
with Listbox1 do
StatusBar1.SimpleText:=(Listbox1.items[itemindex]+ ' hidden');
end;
procedure TForm1.Button5Click(Sender: TObject);
var p:integer;
begin
//show
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(ProcessID[p],0);
with Listbox1 do
StatusBar1.SimpleText:=(Listbox1.items[itemindex]+ ' shown');
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
Button1.Enabled:=true;
Button5.Enabled:=true;
Button6.Enabled:=true;
end;
procedure TForm1.Button6Click(Sender: TObject);
var p:integer;
begin
with Listbox1 do
p:=Listbox1.Items.IndexOf(Listbox1.items[itemindex])+1;
delproc(inttostr(p));
end;
end.
Взято с Исходников.ru
Простейшая авторизация в ISAPI/CGI приложениях
Простейшая авторизация в ISAPI/CGI приложениях
Самый простой способ защитить директорию на web сервере - это применить авторизацию. Этот пример показывает как это сделать используя только ISAPI приложение.
Совместимость: Delphi 5.x (или выше)
Исходный код:
============
- Эти две строчки заставляют браузер спросить имя пользователя и пароль:
Response.StatusCode := 401; // Запрос логина и пароля
Response.WWWAuthenticate := 'Basic realm="Delphi"'; // Заголовок
- Браузер посылает имя пользователя и пароль и мы получаем их:
Request.Authorization
- Но информация закодирована в Base64. Существует довольно много исходников, которые показывают как кодировать/декодировать в Base64. Следующая строчка возвращает декодированные данные в mAuthorization.
FBase64.DecodeData(Copy(Request.Authorization, 6,
Length(Request.Authorization)), mAuthorization);
Взято с Исходников.ru
Простейший алгоритм шифрования строки
Простейший алгоритм шифрования строки
FunctionDecode(S: String; Code: Integer): String;
Var t: Integer;
Begin
For t:=1 to Length(S) Do S[t]:=Chr(Ord(S[t]) xor Code);
Result:=S;
End;
В параметрах функции передайте саму строку, которую хотите зашифровать и код шифрования. Зашифрованная строка будет результатом функции. Для декодирования примените к закодированной строке вызов функции с тем же самым кодом.
Автор:
SongВзято из
Простейший CGI на Дельфи
Простейший CGI на Дельфи
program helloworld;
{$E cgi}
begin
Write('Content type: Text/HTML' + #13#10#13#10);
Write('Hello World!');
end.
Всё что этот код делает это выводит в поток вывода 'Hello World!'. Открываем новый проэкт. Удаляем все из DPR файла, заполняем приведенным кодом. Компиллируем. Полученный файл helloworld.cgi ставим в папку cgi-bin IIS сервера, убеждаемся что в настройках сервера разрешено исполнение серверных скриптов и сам сервер включен, далее открываем браузер и вводим адрес, у меня это:
httр://vitaly/cgi-bin/helloworld.cgi
любуемся надписью "Hello World!" в браузере.
А вот чуть более сложный пример - вывод потока (в данном случае если поток содержит картинку) в браузер:
procedure OutputStream(m: TStream);
var h: Integer;
j: cardinal;
begin
h := GetStdHandle(STD_OUTPUT_HANDLE);
try
WriteFile(h, 'Content type: image/x-MS-bmp' + #13#10#13#10, 32, j, nil);
WriteFile(h, m.memory^, m.size, j, nil);
finally
CloseHandle(h);
end;
end;
Теперь сделанный cgi можно использовать в качестве картинки.
Естественно, что работать такой CGI ,будет только в среде Windows (для работы под Linux надо подумать над компилляцией в среде Kilix)
Ещё типы контента:
text/html
text/plain
text/richtext
image/gif
image/jpeg
image/x-MS-bmp
image/x-xpixmap
video/mpeg
video/quicktime
audio/x-wav
audio/basic (Sun *.au audio files)
audio/mp3
audio/mpeg
audio/x-mp3
audio/x-mpeg
audio/m3u
audio/x-m3u
audio/x-aiff (aif aiff aifc)
application/msword
application/octet-stream (для exe)
application/x-zip
application/mac-binhex40 (hqx)
application/pdf
application/rtf
application/x-latex
application/zip
application/rss+xml
Автор ответа Vit
Взято с Vingrad.ru
Простой пример
Простой пример
Итак, попробуем рассказать в простоте. Вот есть у вас класс - примитивный калькулятор:
MyCalc=class
fx,fy:integer;
public:
procedure SetOperands(x,y:integer)
function Sum:integer;
function Diff:integer;
end;
procedure MyCalc.SetOperands(x,y:integer)
begin
fx:=x; fy:=y;
end;
function MyCalc.Sum:integer;
begin
result:=fx+fy;
end;
function MyCalc.Diff:integer;
begin
result:=fx-fy;
end;
Все элементарно. Теперь если у вас есть объект этого класса, то вам не составит труда им воспользоваться.
Но представим следующую ситуацию: у вас есть один модуль, где объявлется объект этого класса. Допустим:
unit MyCalc
type
MyCalc=class
<описание выше>
var
Calc:MyCalc;
и теперь вы хотите использовать в другом модуле. Хорошо, скажите Вы, мы его просто подключим, и используем. Но, допустим, вы хотите, чтобы и другие могли пользоваться вашим объектом, даже используея другой компилятор. То есть нужно сделать так, чтобы ваш модуль можно было бы использовать без перекомпиляции. Как это сделать?
Ясно, что без каких-то стандартов не обойтись. Скорее всего, самый простой вариант выглядел бы так:
unit MyCalc
type
MyCalc=class
<описание выше>
var Calc:MyCalc;
procedure SetOperands(x,y:integer)
begin
Calc.SetOperands(x,y);
end;
function Sum:integer;
begin
result:= Calc.Sum;
end;
function Diff:integer;
begin
result:= Calс.Diff;
end;
procedure CreateObject;
begin
Calc:=MyCalc.Create;
end;
procedure ReleaseObject;
begin
Calc.Free;
end;
откомпилировать этот юнит, посмотреть, по какому адресу находятся функции SetOperands, Sum, Diff, CreateObject и ReleaseObject и приложить документацию где эти адреса будут указанны. Теперь каждый сможет загрузить ваш модуль в память и по адресу указанном в вашей документации вызвать нужную функцию.
Понятно, чем такой подход чреват. Это крайне не удобно. Но, эта проблема была поставленна давно, и теперь у нас есть стандартизированное соглашение об экспорте функций. То есть вместо того, чтобы писать для каждого модуля документацию с адресами функций при компиляции в заголовке модуля создается специальная стандартная таблица где указанны имена этих функций и их адреса (также указывается числовой индефикатор, который может быть использован вместо имени). Теперь уже лучше. Для того чтобы вызвать ваши функции, достаточно загрузить ваш модуль в память прочитать таблицу экспорта, и можно по именам в ней нати адреса функций и их вызвать. Так устроены DLL. Сейчас все это поддерживается компиляторами, и Windows API. То есть вам самому ничего этого делать не надо, а достаточно вызвать LoadLibrary, чтобы загрузить ваш модуль в память, и GetProcAddress чтобы получить адрес функции по имени.
Простой способ отправки файлов при помощи TClientSocket/TServerSocket
Простой способ отправки файлов при помощи TClientSocket/TServerSocket
Автор: M K
На вопрос "Как я могу отправлять файлы через TClientSocket & TServerSocket?" даём наш ответ :)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Button1: TButton;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
Reciving: boolean;
DataSize: integer;
Data: TMemoryStream;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Image1Click(Sender: TObject);
begin
// Это процедура для открытия сокета на ПРИЁМ (RECEIVING).
// Button1.Click is this procedure as well.
ClientSocket1.Active:= true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Открытие ОТПРАВЛЯЮЩЕГО (SENDING) сокета.
ServerSocket1.Active:= true;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
// Посылаем команду для начала передачи файла.
Socket.SendText('send');
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s, sl: string;
begin
s:= Socket.ReceiveText;
// Если мы не в режиме приёма:
if not Reciving then
begin
// Теперь нам необходимо получить длину потока данных.
SetLength(sl, StrLen(PChar(s))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(s), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
// Удаляем информацию о размере из данных.
Delete(s, 1, Length(sl));
Reciving:= true;
end;
// Сохраняем данные в файл, до тех пор, пока не получим все данные.
try
Data.Write(s[1], length(s));
if Data.Size = DataSize then
begin
Data.Position:= 0;
Image2.Picture.Bitmap.LoadFromStream(Data);
Data.Free;
Reciving:= false;
Socket.Close;
end;
except
Data.Free;
end;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ms: TMemoryStream;
begin
// Клиент получает команду на передачу файла.
if Socket.ReceiveText = 'send' then
begin
ms:= TMemoryStream.Create;
try
// Получаем данные на передачу.
Image1.Picture.Bitmap.SaveToStream(ms);
ms.Position:= 0;
// Добавляем длину данных, чтобы клиент знал, сколько данных будет передано
// Добавляем #0 , чтобы можно было определить, где заканчивается информация о размере.
Socket.SendText(IntToStr(ms.Size) + #0);
// Посылаем его.
Socket.SendStream(ms);
except
// Итак, осталось освободить поток, если что-то не так.
ms.Free;
end;
end;
end;
end.
Взято с Исходников.ru
Протокол блокировки BDE
Протокол блокировки BDE
Данная информация будет полезна каждому, кто решил разрабатывать приложения для работы с базами данных с использованием Delphi и BDE.
Таблицы, типы полей и поддерживаемые характеристики
Каждый следующий выпуск Paradox, начиная с версии 2.0, содержал улучшения структуры таблицы. Все типы таблиц Paradox, начиная с Paradox 1.0 и заканчивая Paradox 3.5, совместимые друг с другом.
Paradox 4.0 добавляет новый тип данных к формату таблиц: Binary Large Objects (бинарные большие объекты), обычно известные как BLOb'ы, и новые типы вторичных индексов. Paradox 4.0 поддерживает два типа BLOb-полей: Memo и BLOb. Paradox старее версии 4.0 и Engine до версии 3.0 не могут читать, писать и создавать этот новый табличный формат. При попытке чтения или записи таблиц типа Paradox 4.0 более ранней версией Paradox, вы получите ошибку о защите таблицы паролем.
Paradox 5.0 добавляет несколько новых типов данных к формату таблиц: Long Integer, Time, TimeStamp, Logical, Autoincrement, BCD, Bytes. Paradox 7.0 добавляет наследуемый вторичный индекс. Создание или любое изменение таблицы переводит ее формат на новый уровень, включающий все вышеописанные характеристики. По умолчанию создаваемая с использованием Database Desktop или BDE (Borland Database Engine) таблица имеет тип Paradox 4.0. Данный тип, заданный по умолчанию, может быть изменен с помощью утилиты BDE configuration utility или Database desktop configuration utility, и ему может быть присвоен тип Paradox 3, 4, 5 или 7 для BDE.
Paradox 4.0 может читать, писать и создавать таблицы типа Paradox, совместимые с таблицами версий от Paradox 1.0 до Paradox 4.0. Так, таблица, созданая в Paradox 1.0, совместима с Paradox 4.0. Таблица, созданная в Engine 1.0 или 2.0, может быть прочитана и записана в Paradox 4.0.
Paradox и Engine не изменяет тип таблицы при чтении или записи. Тип таблицы изменяется только при ее реструктуризации.
Протоколы блокировки Paradox
Есть два различных протокола блокировки Paradox: протокол, введенный в Paradox 2.0 и протокол, введенный в Paradox 4.0. Эти два протокола не совместимы друг с другом. Протокол блокировки не оказывает влияния на тип таблицы, с которым может работать программа. Существуют несколько программ, также поддерживающих протоколы блокировки; тем не менее, эти программы в отдельный момент времени могут поддерживать только один протокол. Здесь мы рассматриваем только протокол блокировки версии 4.0.
Протокол блокировки Database Desktop/ Paradox 4.0
Протокол блокировки Paradox 4.0 - единственный протокол, доступный для Paradox 4.0 и IDAPI Engine. Обозначение "Paradox 4.0 locking protocol" представляет данный стиль блокировки.
Блокировки каталога
Paradox 4.0 располагает файл блокировки, PDOXUSRS.LCK, в каждом каталоге, в котором доступны таблицы. Файл блокировки регулирует доступ к файлам, расположенным в каталоге. Файл блокировки ссылается на PDOXUSRS.NET, поэтому все пользователи должны подключать данные по одному и тому же пути. При этом в каталоге также располагается эксклюзивный файл PARADOX.LCK. Это делается для того, чтобы предохранить те версии Paradox или Engine, которые используют старую блокировочную систему, от неумышленного получения доступа к таблицам.
Рабочие каталоги и каталоги общего доступа
Когда Paradox или Database Desktop необходимо получить доступ к таблицам, расположенным в каталоге, то в этом каталоге они размещают "общий" файл PDOXUSRS.LCK и "эксклюзивный" файл PARADOX.LCK. Этим способом они "метят" каталог для того, чтобы другие пользователи Paradox 4.0 также могли иметь доступ к таблицам, расположенным в данном каталоге. Эксклюзивный файл PARADOX.LCK устанавливается в этом каталоге для обеспечения работы несовместимого протокола блокировки, и, таким образом, для уменьшения риска при постинге данных. В Paradox'е этот каталог известен как рабочий, "Working" каталог.
Частные/эксклюзивные каталоги
Для Paradox и Database Desktop также необходим каталог, где они могли бы сохранять временные файлы, например, результаты запроса. При запуске Paradox или Paradox Runtime, они также размещают в каталоге "эксклюзивные" файлы PDOXUSRS.LCK и PARADOX.LCK, определяя данный каталог как место для хранения временных файлов. Это обозначает, что другие пользователи Paradox не смогут получить доступ к таблицам в этом каталоге. В Paradox'е этот каталог известен как частный, "Private" каталог.
Блокировка таблицы
Paradox 4.0 размещает каждую табличную блокировку в блокирующем файле PDOXUSRS.LCK, располагаемом в каталоге с таблицами. Теперь нет необходимости в использовании отдельного блокирующего файла для каждой таблицы, как это было в предыдущих версиях. Например, если три пользователя просматривают таблицу CUSTOMER.DB и один пользователь реструктуризирует таблицу ORDERS.DB, то файл PDOXUSRS.LCK будет иметь общую блокировку, указывающую на каждого из тех трех пользователей, просматривающих таблицу CUSTOMER.DB, и эксклюзивную блокировку на ORDERS.DB для пользователя, реструктуризирующего таблицу.
Протокол блокировки параллельности Paradox 4.0 (Locking Protocol Concurrency)
В многопользовательской среде протокол блокировки Paradox 4.0 поддерживает параллелизм, т.е. одновременное использование приложений, через файл PDOXUSRS.NET. Все пользователи, которые хотят иметь общий доступ к таблицам Paradox, должны иметь один и тот же путь к файлу PDOXUSRS.NET, но при этом логическая буква сетевого диска может отличаться. Для того, чтобы предотвратить доступ к файлам, расположенным в каталоге, предыдущим версиям, Paradox размещает PDOXUSRS.LCK и эксклюзивный файл PARADOX.LCK в каждом каталоге, где имеются доступные таблицы. Каждый пользователь, который хочет дать общий доступ к таблице в этом каталоге, должен подключить этот каталог с одним и тем же путем, с использованием одного логического сетевого диска и пути. Затем Paradox разместит всю информацию о блокировках для этой таблице в файле PDOXUSRS.LCK, уменьшая этим количество необходимых файлов.
Сетевой управляющий файл (Network Control File)
Сетевой управляющий файл Paradox, PDOXUSRS.NET, служит в качестве контрольной точки для всех блокирующих файлов, создаваемых Paradox. Net-файл содержит список пользователей, в настоящий момент использующих BDE, вместе со списком используемых ими таблиц. Каждый блокирующий файл ссылается на сетевой управляющий файл и содержит информацию о блокировках таблицы и пользователях, заблокировавших эти таблицы, поэтому все пользователи должны иметь один и тот же путь к сетевому управляющему файлу, но при этом логическая буква сетевого диска может отличаться.
Например, если вы используете том DATA на сервере SERVER_1, и сетевой управляющий файл расположен в каталоге \PDOXDATA, то все пользователи должны использовать путь \\SERVER_1\DATA:\PDOXDATA, тем не менее, любой пользователь может при этом использовать свою логическую букву сетевого диска. Если в вашей сети не пользуют тома, DATA должен быть корневым каталогом SERVER_1.
Если вы подключаете \\SERVER_1\DATA в корень диска P, то каждая система Paradox должна определять расположение PARADOX.NET как P:\PDOXDATA\. Тем не менее, другие пользователи могут подключить \\SERVER_1\DATA к корневому каталогу O и установить O:\PDOXDATA\ как местоположение сетевого управляющего файла.
Конфигурирование 16-битного Database Engine / IDAPI.CFG
Файл конфигурации Database Engine хранит специфическую сетевую информацию, список псевдонимов баз дынных и другую информацию. Вы можете конфигурировать IDAPI с помощью программы конфигурации Database Engine, BDECFG.EXE, и устанавливать с помощью нее месторасположение сетевого управляющего файла. Также возможно добавление, удаление и изменение псевдонимов баз данных (включая информацию об используемом драйвере и типе псевдонима), каким способом IDAPI осуществляет общий доступ к локальным таблицам для программ, использующих протокол блокировки Paradox 4.0, а также некоторые особенности относительно таблиц и способа отображения данных.
Локальные 16-битные установки
Файл WIN.INI содержит путь к файлу IDAPI.CFG, "рабочему" ("Working") каталогу Database Desktop и "частному" ("Private") каталогу Database Desktop. Для изменения этих значений необходимо загрузить файл WIN.INI в любой текстовый редактор и отредактировать его. Путь к файлу IDAPI.CFG описан в группе [IDAPI] как CONFIGFILE=<полный диск, путь и имя файла> или CONFIGFILE01=<полный диск, путь и имя файла>.
Месторасположение "рабочего" ("Working") и "частного" ("Private") каталога Database Desktop описано в группе [DBD] соответственно как WORKDIR=<полный диск и каталог> и PRIVDIR=<полный диск и каталог>.
Конфигурирование 32-битного Database Engine / IDAPI32.CFG
Конфигурационный файл BDE хранит ту же информацию, что и конфигурационный файл Database Engine. Для конфигурирования IDAPI32.CFG используется утилита BDE Configuration, BDECFG32.EXE. Вдобавок к этому, вы можете сохранять информацию в регистрах, или сразу, и в регистрах, и в IDAPI32.CFG.
Локальные 32-битные установки
В регистрах содержится путь к IDAPI32.CFG, к "рабочему" ("Working") и частному ("Private") каталогу. Месторасположение файла IDAPI32.CFG хранится в ключе HKEY_LOCAL_MACHINE\Software\Borland\Database Engine. Значение CONFIGFILE01 содержит данные типа <полный диск, путь и имя файла>.
Месторасположение каталогов BDE "Working" и "Private" хранится соответственно в ключах HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\WorkDir и HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\PrivDir. По умолчанию, данные для каждого каталога хранятся в виде <Полный диск и каталог>.
Доступ к таблицам Paradox
BDE сначала пытается получить доступ к файлу PDOXUSRS.NET. Если файл PDOXUSRS.NET не найден, Paradox создает новый файл PDOXUSRS.NET и продолжает процедуру запуска. Если файл PDOXUSRS.NET присутствует, но владелец этого net-файла использует другой путь, т.е. подключил сервер иначе, возникает исключительная ситуация "Multiple net files in use" (Используются несколько net-файлов) и BDE прекращает свою работу. После того, как сеть успешно открыла эксклюзивную блокировку, PARADOX.LCK размещается во временном, частном каталоге. При невозможности установки блокировки, BDE прекращает свою работу. Причина неудачи может заключаться в том, что какой-то пользователь имеет в этом каталоге эксклюзивную блокировку, или же файлы блокировки используют различные net-файлы. После того, как каталог будет защищен от частного использования, общий файл PARADOX.LCK будет расположен в рабочем каталоге, и на этом процесс инициализации будет завершен.
Взято с
Протоколы
Протоколы
Cодержание раздела:
·
·
·
·
·
·
·
·
·
·
·
·
·
·
См. также статьи в других разделах:
Проверка наличия BDE
Проверка наличия BDE
unitFindbde;
interface
implementation
uses
Controls,
SysUtils,
WinTypes,
WinProcs,
Dialogs;
var
IdapiPath: array[0..255] of Char;
IdapiHandle: THandle;
initialization
GetProfileString('IDAPI', 'DLLPath', 'C:\', IdapiPath, 255);
{следующие строки "изолируют" первый путь к каталогу из IdapiPath в случае, если их несколько}
if Pos(';', StrPas(IdapiPath)) <> 0 then
begin
StrPCopy(IdapiPath, Copy(StrPas(IdapiPath), 1,
Pred(Pos(';', StrPas(IdapiPath)))));
end;
IdapiHandle := LoadLibrary(StrCat(IdapiPath, '\IDAPI01.DLL'));
if IdapiHandle < HINSTANCE_ERROR then
begin
if MessageDlg('ОШИБКА: Borland Database Engine (IDAPI) не найдена' +
'перед следующей попыткой ее необходимо установить....',
mtError, [mbOK], 0) = mrOK then
Halt
end
{ IDAPI в системе не установлена }
else
begin
FreeLibrary(IdapiHandle);
{ IDAPI Установлена в системе }
end;
end.
Взято из
Советов по Delphi от
Сборник Kuliba
Способ 1:
Следующая функция получает структуру SysVersion и записывает результаты в stringlist.
uses dbierrs, DBTables;
...
function fDbiGetSysVersion(SysVerList: TStringList): SYSVersion;
var
Month, Day, iHour, iMin, iSec: Word;
Year: SmallInt;
begin
Check(DbiGetSysVersion(Result));
if (SysVerList <> nil) then
begin
with SysVerList do
begin
Clear;
Add(Format('ENGINE VERSION=%d', [Result.iVersion]));
Add(Format('INTERFACE LEVEL=%d', [Result.iIntfLevel]));
Check(DbiDateDecode(Result.dateVer, Month, Day, Year));
Add(Format('VERSION DATE=%s', [DateToStr(EncodeDate
(Year, Month, Day))]));
Check(DbiTimeDecode(Result.timeVer, iHour, iMin, iSec));
Add(Format('VERSION TIME=%s', [TimeToStr(EncodeTime
(iHour, iMin, iSec div 1000, iSec div 100))]));
end;
end;
end;
Вызов этой функции выглядит следующим образом:
var hStrList: TStringList;
Ver: SYSVersion;
begin
hStrList:= TStringList.Create;
try Ver := fDbiGetSysVersion(hStrList); except
ShowMessage('BDE not installed !');
end;
ShowMessage(IntToStr(Ver.iVersion));
Memo1.Lines.Assign(hStrList);
hStrList.Destroy;
end;
Возможные результаты (отображаемые в memo-поле):
ENGINE VERSION=500
INTERFACE LEVEL=500
VERSION DATE=09.06.98
VERSION TIME=17:06:13
Способ 2:
Читаем ключ в реестре:
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(`SOFTWARE\Borland\Database Engine`, False);
try
s := ReadString(`CONFIGFILE01`);
//BDE установлена
finally
CloseKey;
end;
Способ 3:
Можно попробовать установить BDE
IsBDEExist := (dbiInit(nil) = 0)
PS: Последний способ более предпочтителен, так как анинсталлер мог удалить BDE-файлы, но оставить в реестре ключ :)
Взято с Исходников.ru
Проверка правильности E-mail адреса
Проверка правильности E-mail адреса
Автор:
Udo NesshoeverЕсли пользователю Вашего приложения необходимо вводить почтовый адрес, то возникает потребность в проверке адреса на правильнось. Конечно способов сделать это существует множество, но этот, на мой взгляд, самый короткий и доступный для понимания.
Совместимость: Delphi 3.x (или выше)
function IsValidEmail(const Value: string): boolean;
function CheckAllowed(const s: string): boolean;
var
i: integer;
begin
Result:= false;
for i:= 1 to Length(s) do
begin
{ недопустимый символ в s - значит недопустимый адрес }
if not (s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.']) then
Exit;
end;
Result:= true;
end;
var
i: integer;
namePart, serverPart: string;
begin // начало выполнения IsValidEmail
Result:= false;
i:= Pos('@', Value);
if i = 0 then
Exit;
namePart:= Copy(Value, 1, i - 1);
serverPart:= Copy(Value, i + 1, Length(Value));
// @ не указано имя имя или сервер не указаны; минимально для сервера. "a.com"
if (Length(namePart) = 0) or ((Length(serverPart) < 5)) then
Exit;
i:= Pos('.', serverPart);
// должно иметь точку и как минимум три знака от конца
if (i = 0) or (i > (Length(serverPart) - 2)) then
Exit;
Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;
Взято с Исходников.ru
Проверка правописания и синонимов при помощи компонентов MS Office
Проверка правописания и синонимов при помощи компонентов MS Office
This is the VCL for Spell Checking and Synonyms using MS Word COM interface. It can correct and replace words in a Text String,TMemo or TRichEdit using a built in replacement editor, or can be controlled by user dialog. I see there are other callable functions in the interface, which I have not implemented. Anyone see a use for any of them ?.
They are ...
property PartOfSpeechList: OleVariant read Get_PartOfSpeechList;
property AntonymList: OleVariant read Get_AntonymList;
property RelatedExpressionList: OleVariant read Get_RelatedExpressionList;
property RelatedWordList: OleVariant read Get_RelatedWordList;
Example of checking and changing a Memo text ...
SpellCheck.CheckMemoTextSpelling(Memo1);
Properties
----------------
LetterChars
- Characters considered to be letters. default is['A'..'Z','a'..'z'] (English) but could be changed to
['A'..'Z','a'..'z','б','й','н','у','ъ'] (Spanish)
Color - Backgound color of Default dialog Editbox and Listbox
CompletedMessage - Enable/Disable display of completed and count message dialog
Font - Font of Default dialog Editbox and Listbox
Language - Language used by GetSynonyms() method
ReplaceDialog - Use Default replace dialog or User defined (see events)
Active - Readonly, set at create time. Indicates if MS Word is available
Methods
----------------
function GetSynonyms(StrWord : string; Synonyms : TStrings) : boolean;
True if synonyms found for StrWord. Synonyms List is
returned in TStrings (Synonyms).
function CheckWordSpelling(StrWord : string; Suggestions : TStrings) : boolean;
True if StrWord is spelt correctly. Suggested corrections
returned in TStrings (Suggestions)
procedure CheckTextSpelling(var StrText : string);
Proccesses string StrText and allows users to change
mispelt words via a Default replacement dialog or User
defined calls. Words are changed and returned in StrText.
Words in the text are changed automatically by the Default
editor. Use the events if you want to control the dialog
yourself. ie. Get the mispelt word, give a choice of
sugesstions (BeforeCorrection), Change the word to
corrected (OnCorrection) and possibly display "Was/Now"
(AfterCorrection)
procedure CheckRichTextSpelling(RichEdit : TRichEdit);
Corrects misspelt words directly in TRichEdit.Text.
Rich Format is maintained.
procedure CheckMemoTextSpelling(Memo : TMemo);
Corrects misspelt words directly into a TMemo.Text.
Events (Mainly used when ReplaceDialog = repUser)
--------------------------------------------------------------------------------
BeforeCorrection
- Supplies the mispelt word along with a TStringsvar containing suggested corrections.
OnCorrection - Supplies the mispelt word as a VAR type allowing
user to change it to desired word. The word will be
replaced by this variable in the passed StrText.
AfterCorrection - Supplies the mispelt word and what it has been
changed to.
unit
SpellChk;interface
// =============================================================================
// MS Word COM Interface to Spell Check and Synonyms
// Mike Heydon Dec 2000
// mheydon@pgbison.co.za
// =============================================================================
uses Windows, SysUtils, Classes, ComObj, Dialogs, Forms, StdCtrls,
Controls, Buttons, Graphics, ComCtrls, Variants;
// Above uses Variants is for Delphi 6 - remove for Delphi 5 and less
type
// Event definitions
TSpellCheckBeforeCorrection = procedure(Sender: TObject;
MispeltWord: string;
Suggestions: TStrings) of object;
TSpellCheckAfterCorrection = procedure(Sender: TObject;
MispeltWord: string;
CorrectedWord: string) of object;
TSpellCheckOnCorrection = procedure(Sender: TObject;
var WordToCorrect: string) of object;
// Property types
TSpellCheckReplacement = (repDefault, repUser);
TSpellCheckLetters = set of char;
TSpellCheckLanguage = (wdLanguageNone, wdNoProofing, wdDanish, wdGerman,
wdSwissGerman, wdEnglishAUS, wdEnglishUK, wdEnglishUS,
wdEnglishCanadian, wdEnglishNewZealand,
wdEnglishSouthAfrica, wdSpanish, wdFrench,
wdFrenchCanadian, wdItalian, wdDutch, wdNorwegianBokmol,
wdNorwegianNynorsk, wdBrazilianPortuguese,
wdPortuguese, wdFinnish, wdSwedish, wdCatalan, wdGreek,
wdTurkish, wdRussian, wdCzech, wdHungarian, wdPolish,
wdSlovenian, wdBasque, wdMalaysian, wdJapanese, wdKorean,
wdSimplifiedChinese, wdTraditionalChinese,
wdSwissFrench, wdSesotho, wdTsonga, wdTswana, wdVenda,
wdXhosa, wdZulu, wdAfrikaans, wdArabic, wdHebrew,
wdSlovak, wdFarsi, wdRomanian, wdCroatian, wdUkrainian,
wdByelorussian, wdEstonian, wdLatvian, wdMacedonian,
wdSerbianLatin, wdSerbianCyrillic, wdIcelandic,
wdBelgianFrench, wdBelgianDutch, wdBulgarian,
wdMexicanSpanish, wdSpanishModernSort, wdSwissItalian);
// Main TSpellcheck Class
TSpellCheck = class(TComponent)
private
MsWordApp,
MsSuggestions: OleVariant;
FLetterChars: TSpellCheckLetters;
FFont: TFont;
FColor: TColor;
FReplaceDialog: TSpellCheckReplacement;
FCompletedMessage,
FActive: boolean;
FLanguage: TSpellCheckLanguage;
FForm: TForm;
FEbox: TEdit;
FLbox: TListBox;
FCancelBtn,
FChangeBtn: TBitBtn;
FBeforeCorrection: TSpellCheckBeforeCorrection;
FAfterCorrection: TSpellCheckAfterCorrection;
FOnCorrection: TSpellCheckOnCorrection;
procedure SetFFont(NewValue: TFont);
protected
procedure MakeForm;
procedure CloseForm;
procedure SuggestedClick(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetSynonyms(StrWord: string; Synonyms: TStrings): boolean;
function CheckWordSpelling(StrWord: string;
Suggestions: TStrings): boolean;
procedure CheckTextSpelling(var StrText: string);
procedure CheckRichTextSpelling(RichEdit: TRichEdit);
procedure CheckMemoTextSpelling(Memo: TMemo);
procedure Anagrams(const InString: string; StringList: TStrings);
property Active: boolean read FActive;
property LetterChars: TSpellCheckletters read FLetterChars write FLetterChars;
published
property Language: TSpellCheckLanguage read FLanguage
write FLanguage;
property CompletedMessage: boolean read FCompletedMessage
write FCompletedMessage;
property Color: TColor read FColor write FColor;
property Font: TFont read FFont write SetFFont;
property BeforeCorrection: TSpellCheckBeforeCorrection
read FBeforeCorrection
write FBeforeCorrection;
property AfterCorrection: TSpellCheckAfterCorrection
read FAfterCorrection
write FAfterCorrection;
property OnCorrection: TSpellCheckOnCorrection
read FOnCorrection
write FOnCorrection;
property ReplaceDialog: TSpellCheckReplacement
read FReplaceDialog
write FReplaceDialog;
end;
procedure Register;
// -----------------------------------------------------------------------------
implementation
// Mapped Hex values for ord(FLanguage)
const
LanguageArray: array[0..63] of integer =
($0, $400, $406, $407, $807, $C09, $809, $409,
$1009, $1409, $1C09, $40A, $40C, $C0C, $410,
$413, $414, $814, $416, $816, $40B, $41D, $403,
$408, $41F, $419, $405, $40E, $415, $424, $42D,
$43E, $411, $412, $804, $404, $100C, $430, $431,
$432, $433, $434, $435, $436, $401, $40D, $41B,
$429, $418, $41A, $422, $423, $425, $426, $42F,
$81A, $C1A, $40F, $80C, $813, $402, $80A, $C0A, $810);
// Change to Component Pallete of choice
procedure Register;
begin
RegisterComponents('MahExtra', [TSpellCheck]);
end;
// TSpellCheck
constructor TSpellCheck.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// Defaults
FLetterChars := ['A'..'Z', 'a'..'z'];
FCompletedMessage := true;
FColor := clWindow;
FFont := TFont.Create;
FReplaceDialog := repDefault;
FLanguage := wdEnglishUS;
// Don't create an ole server at design time
if not (csDesigning in ComponentState) then
begin
try
MsWordApp := CreateOleObject('Word.Application');
FActive := true;
MsWordApp.Documents.Add;
except
on E: Exception do
begin
// MessageDlg('Cannot Connect to MS Word',mtError,[mbOk],0);
// Activate above if visual failure required
FActive := false;
end;
end;
end;
end;
destructor TSpellCheck.Destroy;
begin
FFont.Free;
if FActive and not (csDesigning in ComponentState) then
begin
MsWordApp.Quit;
MsWordApp := VarNull;
end;
inherited Destroy;
end;
// ======================================
// Property Get/Set methods
// ======================================
procedure TSpellCheck.SetFFont(NewValue: TFont);
begin
FFont.Assign(NewValue);
end;
// ===========================================
// Return a list of synonyms for single word
// ===========================================
function TSpellCheck.GetSynonyms(StrWord: string;
Synonyms: TStrings): boolean;
var
SynInfo: OleVariant;
i, j: integer;
TS: OleVariant;
Retvar: boolean;
begin
Synonyms.Clear;
if FActive then
begin
SynInfo := MsWordApp.SynonymInfo[StrWord,
LanguageArray[ord(FLanguage)]];
for i := 1 to SynInfo.MeaningCount do
begin
TS := SynInfo.SynonymList[i];
for j := VarArrayLowBound(TS, 1) to VarArrayHighBound(TS, 1) do
Synonyms.Add(TS[j]);
end;
RetVar := SynInfo.Found;
end
else
RetVar := false;
Result := RetVar;
end;
// =======================================
// Check the spelling of a single word
// Suggestions returned in TStrings
// =======================================
function TSpellCheck.CheckWordSpelling(StrWord: string;
Suggestions: TStrings): boolean;
var
Retvar: boolean;
i: integer;
begin
RetVar := false;
if Suggestions <> nil then
Suggestions.Clear;
if FActive then
begin
if MsWordApp.CheckSpelling(StrWord) then
RetVar := true
else
begin
if Suggestions <> nil then
begin
MsSuggestions := MsWordApp.GetSpellingSuggestions(StrWord);
for i := 1 to MsSuggestions.Count do
Suggestions.Add(MsSuggestions.Item(i));
MsSuggestions := VarNull;
end;
end;
end;
Result := RetVar;
end;
// ======================================================
// Check the spelling text of a string with option to
// Replace words. Correct string returned in var StrText
// ======================================================
procedure TSpellCheck.CheckTextSpelling(var StrText: string);
var
StartPos, CurPos,
WordsChanged: integer;
ChkWord, UserWord: string;
EoTxt: boolean;
procedure GetNextWordStart;
begin
ChkWord := '';
while (StartPos <= length(StrText)) and
(not (StrText[StartPos] in FLetterChars)) do
inc(StartPos);
CurPos := StartPos;
end;
begin
if FActive and (length(StrText) > 0) then
begin
MakeForm;
StartPos := 1;
EoTxt := false;
WordsChanged := 0;
GetNextWordStart;
while not EoTxt do
begin
// Is it a letter ?
if StrText[CurPos] in FLetterChars then
begin
ChkWord := ChkWord + StrText[CurPos];
inc(CurPos);
end
else
begin
// Word end found - check spelling
if not CheckWordSpelling(ChkWord, FLbox.Items) then
begin
if Assigned(FBeforeCorrection) then
FBeforeCorrection(self, ChkWord, FLbox.Items);
// Default replacement dialog
if FReplaceDialog = repDefault then
begin
FEbox.Text := ChkWord;
FForm.ShowModal;
if FForm.ModalResult = mrOk then
begin
// Change mispelt word
Delete(StrText, StartPos, length(ChkWord));
Insert(FEbox.Text, StrText, StartPos);
CurPos := StartPos + length(FEbox.Text);
if ChkWord <> FEbox.Text then
begin
inc(WordsChanged);
if Assigned(FAfterCorrection) then
FAfterCorrection(self, ChkWord, FEbox.Text);
end;
end
end
else
begin
// User defined replacemnt routine
UserWord := ChkWord;
if Assigned(FOnCorrection) then
FOnCorrection(self, UserWord);
Delete(StrText, StartPos, length(ChkWord));
Insert(UserWord, StrText, StartPos);
CurPos := StartPos + length(UserWord);
if ChkWord <> UserWord then
begin
inc(WordsChanged);
if Assigned(FAfterCorrection) then
FAfterCorrection(self, ChkWord, UserWord);
end;
end;
end;
StartPos := CurPos;
GetNextWordStart;
EoTxt := (StartPos > length(StrText));
end;
end;
CloseForm;
if FCompletedMessage then
MessageDlg('Spell Check Complete' + #13#10 +
IntToStr(WordsChanged) + ' words changed',
mtInformation, [mbOk], 0);
end
else if not FActive then
MessageDlg('Spell Check not Active', mtError, [mbOk], 0)
else if FCompletedMessage then
MessageDlg('Spell Check Complete' + #13#10 +
'0 words changed', mtInformation, [mbOk], 0);
end;
// =============================================================
// Check the spelling of RichText with option to
// Replace words (in situ replacement direct to RichEdit.Text)
// =============================================================
procedure TSpellCheck.CheckRichTextSpelling(RichEdit: TRichEdit);
var
StartPos, CurPos,
WordsChanged: integer;
StrText, ChkWord, UserWord: string;
SaveHide,
EoTxt: boolean;
procedure GetNextWordStart;
begin
ChkWord := '';
while (not (StrText[StartPos] in FLetterChars)) and
(StartPos <= length(StrText)) do
inc(StartPos);
CurPos := StartPos;
end;
begin
SaveHide := RichEdit.HideSelection;
RichEdit.HideSelection := false;
StrText := RichEdit.Text;
if FActive and (length(StrText) > 0) then
begin
MakeForm;
StartPos := 1;
EoTxt := false;
WordsChanged := 0;
GetNextWordStart;
while not EoTxt do
begin
// Is it a letter ?
if StrText[CurPos] in FLetterChars then
begin
ChkWord := ChkWord + StrText[CurPos];
inc(CurPos);
end
else
begin
// Word end found - check spelling
if not CheckWordSpelling(ChkWord, FLbox.Items) then
begin
if Assigned(FBeforeCorrection) then
FBeforeCorrection(self, ChkWord, FLbox.Items);
// Default replacement dialog
if FReplaceDialog = repDefault then
begin
FEbox.Text := ChkWord;
RichEdit.SelStart := StartPos - 1;
RichEdit.SelLength := length(ChkWord);
FForm.ShowModal;
if FForm.ModalResult = mrOk then
begin
// Change mispelt word
Delete(StrText, StartPos, length(ChkWord));
Insert(FEbox.Text, StrText, StartPos);
CurPos := StartPos + length(FEbox.Text);
RichEdit.SelText := FEbox.Text;
if ChkWord <> FEbox.Text then
begin
inc(WordsChanged);
if Assigned(FAfterCorrection) then
FAfterCorrection(self, ChkWord, FEbox.Text);
end;
end
end
else
begin
// User defined replacemnt routine
UserWord := ChkWord;
RichEdit.SelStart := StartPos - 1;
RichEdit.SelLength := length(ChkWord);
if Assigned(FOnCorrection) then
FOnCorrection(self, UserWord);
Delete(StrText, StartPos, length(ChkWord));
Insert(UserWord, StrText, StartPos);
CurPos := StartPos + length(UserWord);
RichEdit.SelText := UserWord;
if ChkWord <> UserWord then
begin
inc(WordsChanged);
if Assigned(FAfterCorrection) then
FAfterCorrection(self, ChkWord, UserWord);
end;
end;
end;
StartPos := CurPos;
GetNextWordStart;
EoTxt := (StartPos > length(StrText));
end;
end;
CloseForm;
RichEdit.HideSelection := SaveHide;
if FCompletedMessage then
MessageDlg('Spell Check Complete' + #13#10 +
IntToStr(WordsChanged) + ' words changed',
mtInformation, [mbOk], 0);
end
else if not FActive then
MessageDlg('Spell Check not Active', mtError, [mbOk], 0)
else if FCompletedMessage then
MessageDlg('Spell Check Complete' + #13#10 +
'0 words changed', mtInformation, [mbOk], 0);
end;
// =============================================================
// Check the spelling of Memo with option to
// Replace words (in situ replacement direct to Memo.Text)
// =============================================================
procedure TSpellCheck.CheckMemoTextSpelling(Memo: TMemo);
var
StartPos, CurPos,
WordsChanged: integer;
StrText, ChkWord, UserWord: string;
SaveHide,
EoTxt: boolean;
procedure GetNextWordStart;
begin
ChkWord := '';
while (not (StrText[StartPos] in FLetterChars)) and
(StartPos <= length(StrText)) do
inc(StartPos);
CurPos := StartPos;
end;
begin
SaveHide := Memo.HideSelection;
Memo.HideSelection := false;
StrText := Memo.Text;
if FActive and (length(StrText) > 0) then
begin
MakeForm;
StartPos := 1;
EoTxt := false;
WordsChanged := 0;
GetNextWordStart;
while not EoTxt do
begin
// Is it a letter ?
if StrText[CurPos] in FLetterChars then
begin
ChkWord := ChkWord + StrText[CurPos];
inc(CurPos);
end
else
begin
// Word end found - check spelling
if not CheckWordSpelling(ChkWord, FLbox.Items) then
begin
if Assigned(FBeforeCorrection) then
FBeforeCorrection(self, ChkWord, FLbox.Items);
// Default replacement dialog
if FReplaceDialog = repDefault then
begin
FEbox.Text := ChkWord;
Memo.SelStart := StartPos - 1;
Memo.SelLength := length(ChkWord);
FForm.ShowModal;
if FForm.ModalResult = mrOk then
begin
// Change mispelt word
Delete(StrText, StartPos, length(ChkWord));
Insert(FEbox.Text, StrText, StartPos);
CurPos := StartPos + length(FEbox.Text);
Memo.SelText := FEbox.Text;
if ChkWord <> FEbox.Text then
begin
inc(WordsChanged);
if Assigned(FAfterCorrection) then
FAfterCorrection(self, ChkWord, FEbox.Text);
end;
end
end
else
begin
// User defined replacemnt routine
UserWord := ChkWord;
Memo.SelStart := StartPos - 1;
Memo.SelLength := length(ChkWord);
if Assigned(FOnCorrection) then
FOnCorrection(self, UserWord);
Delete(StrText, StartPos, length(ChkWord));
Insert(UserWord, StrText, StartPos);
CurPos := StartPos + length(UserWord);
Memo.SelText := UserWord;
if ChkWord <> UserWord then
begin
inc(WordsChanged);
if Assigned(FAfterCorrection) then
FAfterCorrection(self, ChkWord, UserWord);
end;
end;
end;
StartPos := CurPos;
GetNextWordStart;
EoTxt := (StartPos > length(StrText));
end;
end;
Memo.HideSelection := SaveHide;
CloseForm;
if FCompletedMessage then
MessageDlg('Spell Check Complete' + #13#10 +
IntToStr(WordsChanged) + ' words changed',
mtInformation, [mbOk], 0);
end
else if not FActive then
MessageDlg('Spell Check not Active', mtError, [mbOk], 0)
else if FCompletedMessage then
MessageDlg('Spell Check Complete' + #13#10 +
'0 words changed', mtInformation, [mbOk], 0);
end;
// ======================================================================
// Return a list of Anagrams - Careful, long words generate HUGE lists
// ======================================================================
procedure TSpellCheck.Anagrams(const InString: string; StringList: TStrings);
var
WordsChecked, WordsFound: integer;
procedure RecursePerm(const StrA, StrB: string; Len: integer; SL: TStrings);
var
i: integer;
A, B: string;
begin
if (length(StrA) = Len) then
begin
inc(WordsChecked);
if (SL.IndexOf(StrA) = -1) and MsWordApp.CheckSpelling(StrA) then
begin
inc(WordsFound);
SL.Add(StrA);
Application.ProcessMessages;
end;
end;
for i := 1 to length(StrB) do
begin
A := StrB;
B := StrA + A[i];
delete(A, i, 1);
RecursePerm(B, A, Len, SL);
end;
end;
begin
if FActive then
begin
WordsChecked := 0;
WordsFound := 0;
StringList.Clear;
Application.ProcessMessages;
RecursePerm('', LowerCase(InString), length(InString), StringList);
if FCompletedMessage then
MessageDlg('Anagram Search Check Complete' + #13#10 +
IntToStr(WordsChecked) + ' words checked' + #13#10 +
IntToStr(WordsFound) + ' anagrams found',
mtInformation, [mbOk], 0);
end
else
MessageDlg('Spell Check not Active', mtError, [mbOk], 0);
end;
// =========================================
// Create default replacement form
// =========================================
procedure TSpellCheck.MakeForm;
begin
// Correction form container
FForm := TForm.Create(nil);
FForm.Position := poScreenCenter;
FForm.BorderStyle := bsDialog;
FForm.Height := 260; // 240 if no caption
FForm.Width := 210;
// Remove form's caption if desired
// SetWindowLong(FForm.Handle,GWL_STYLE,
// GetWindowLong(FForm.Handle,GWL_STYLE) AND NOT WS_CAPTION);
FForm.ClientHeight := FForm.Height;
// Edit box of offending word
FEbox := TEdit.Create(FForm);
FEbox.Parent := FForm;
FEbox.Top := 8;
FEbox.Left := 8;
FEbox.Width := 185;
FEBox.Font := FFont;
FEbox.Color := FColor;
// Suggestion list box
FLbox := TListBox.Create(FForm);
FLbox.Parent := FForm;
FLbox.Top := 32;
FLbox.Left := 8;
FLbox.Width := 185;
FLbox.Height := 193;
FLbox.Color := FColor;
FLbox.Font := FFont;
FLbox.OnClick := SuggestedClick;
FLbox.OnDblClick := SuggestedClick;
// Cancel Button
FCancelBtn := TBitBtn.Create(FForm);
FCancelBtn.Parent := FForm;
FCancelBtn.Top := 232;
FCancelBtn.Left := 8;
FCancelBtn.Kind := bkCancel;
FCancelBtn.Caption := 'Ignore';
// Change Button
FChangeBtn := TBitBtn.Create(FForm);
FChangeBtn.Parent := FForm;
FChangeBtn.Top := 232;
FChangeBtn.Left := 120;
FChangeBtn.Kind := bkOk;
FChangeBtn.Caption := 'Change';
end;
// =============================================
// Close the correction form and free memory
// =============================================
procedure TSpellCheck.CloseForm;
begin
FChangeBtn.Free;
FCancelBtn.Free;
FLbox.Free;
FEbox.Free;
FForm.Free;
end;
// ====================================================
// FLbox on click event to populate the edit box
// with selected suggestion (OnClick/OnDblClick)
// ====================================================
procedure TSpellCheck.SuggestedClick(Sender: TObject);
begin
FEbox.Text := FLbox.Items[FLbox.ItemIndex];
end;
end.
Взято с
Delphi Knowledge BaseПрозрачность формы
Прозрачность формы
Cодержание раздела:
См. также статьи в других разделах:
приложений доступна одна из замечательных
Прозрачность в Delphi 6
(Перевод одноимённой статьи с сайта delphi.about.com )
В Delphi 6 разработчикам Windows- приложений доступна одна из замечательных возможностей создавать (полу)прозрачные формы (окна). В Delphi 6 класс TForm поддерживает формы со слоями, которые имеют свойства AlphaBlend, AlphaBlendValue, TransparentColor, и TransparentColorValue.
Прозрачность в форме означает то, что пользователь может видить то, что находится позати формы.
Чтобы подготовить форму к прозрачности, Вам потребуется установить свойство AlphaBlend в True. Если AlphaBlend установлено в True, то свойство AlphaBlendValue указывает степень прозрачности. Это свойство позволяет задать значения от 0 до 255. 0 указывает на полную прозрачность окна, в то время как 255 указывает на непрозрачное окно.
Так же возможно устанавливать свойства AlphaBlend и AlphaBlendValue во время разработки (или во время выполнения приложения) при помощи Object Inspector.
Возможно, Вы подумаете, что такая возможность в Delphi, может Вам пригодиться довольно редко, однако прозрачностью можно довольно эффективно привлекать внимание пользователей Вашей программы:
procedure TAboutBox.FormClose
(Sender: TObject; var Action: TCloseAction);
var
i, cavb : 0..255;
begin
if AlphaBlend=False then
begin
AlphaBlendValue:=255;
AlphaBlend:=True;
end;
cavb:=AlphaBlendValue;
for i := cavb downto 0 do
begin
AlphaBlendValue := i;
Application.ProcessMessages;
end
end;
Вышеприведённый код, в событие OnClose для формы about, создаёт плавно изменяющийся эффект. Когда пользователь попытается закрыть диалоговое окошко, то форма плавно исчезнет. Делается это путём циклического уменьшения AlphaBlendValue до нуля.
Другие два новый свойства формы в Delphi 6, это TransparentColor и TransparentColorValue. TransparentColor, это булевое свойство, которое указывает, будет определённый цвет, указанный в TransparentColorValue прозрачным. То есть мы можем задать прозрачность только определённому цвету.
И взаключении хотелось бы указать на главный недостаток. Все свойства, описанные выше, не будут работать, если приложение запущено не под Windows 2000 или выше, и если процессор на компьютере ниже P90.
Взято с Исходников.ru
Прозрачный Bitmap
Прозрачный Bitmap
Вам необходимо две копии вашего изображения. Маску и само изображение. Маска является ничем иным, как изображением, состоящим из двух цветов. Черного для тех областей, которые вы хотите показать, и белого для прозрачных. Для Windows 3.1 маска изображения может быть черно-белой, и предназначена для определения размеров изображения. В Win95 черно-белая маска ни при каких обстоятельствах не работает, т.к. у нее должна быть та же глубина цветов, что и у самого изображения, которое вы хотите показать.
Изображение, которое вы хотите показать, должно содержать в прозрачных областях значение цвета, равное 0. Метод помещения изображения на экран такой же, как и в DOS. Маска AND экран, изображение OR или XOR с той же областью.
Ниже приведен код Delphi, позволяя сделать вышеописанное с помощью двух TBitmap.
Canvas.CopyMode:= cmSrcAnd;
Canvas.CopyRect(TitleRect, BMask.Canvas, TitleRect);
{заполняем "пробелы" изображением}
Canvas.CopyMode := cmSrcPaint;
Canvas.CopyRect(TitleRect, BTitle.Canvas, TitleRect);
procedure DrawTransparentBmp(Cnv: TCanvas; x,y: Integer; Bmp: TBitmap; clTransparent: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin
try
bmpAND := TBitmap.Create;
bmpAND.Width := Bmp.Width;
bmpAND.Height := Bmp.Height;
bmpAND.Monochrome := True;
oldcol := SetBkColor(Bmp.Canvas.Handle, ColorToRGB(clTransparent));
BitBlt(bmpAND.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
SetBkColor(Bmp.Canvas.Handle, oldcol);
bmpINVAND := TBitmap.Create;
bmpINVAND.Width := Bmp.Width;
bmpINVAND.Height := Bmp.Height;
bmpINVAND.Monochrome := True;
BitBlt(bmpINVAND.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpAND.Canvas.Handle, 0, 0, NOTSRCCOPY);
bmpXOR := TBitmap.Create;
bmpXOR.Width := Bmp.Width;
bmpXOR.Height := Bmp.Height;
BitBlt(bmpXOR.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
BitBlt(bmpXOR.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpINVAND.Canvas.Handle, 0, 0, SRCAND);
bmpTarget := TBitmap.Create;
bmpTarget.Width := Bmp.Width;
bmpTarget.Height := Bmp.Height;
BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Cnv.Handle, x, y, SRCCOPY);
BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpAND.Canvas.Handle, 0, 0, SRCAND);
BitBlt(bmpTarget.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, bmpXOR.Canvas.Handle, 0, 0, SRCINVERT);
BitBlt(Cnv.Handle, x, y, Bmp.Width, Bmp.Height, bmpTarget.Canvas.Handle, 0, 0, SRCCOPY);
finally
bmpXOR.Free;
bmpAND.Free;
bmpINVAND.Free;
bmpTarget.Free;
end;
end;
Взято из
QT и Linux API
QT и Linux API
Cодержание раздела:
QuickReport
QuickReport
Cодержание раздела:
См. также статьи в других разделах:
Рабочий стол
Рабочий стол
Cодержание раздела:
См. также статьи в других разделах:
См. также другие разделы:
Работа c Canvas
Работа c Canvas
Cодержание раздела:
См. также статьи в других разделах:
Работа через ADO
Работа через ADO
Cодержание раздела:
См. также статьи в других разделах:
Работа через BDE
Работа через BDE
Cодержание раздела:
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
Работа через Handle
Работа через Handle
Еще один способ работы с файлами - это открытие Handle на файл и работу через него. Тут есть 2 варианта - можно использовать функции Дельфи или использовать WinAPI напрямую.
При использовании функций Дельфи можно применять следующие функции:
FileOpen(FileName, fmOpenWrite or fmShareDenyNone) - функция открывает файл и возвращает целое цисло - Handle на файл. Параметры функции - имя файла и тип доступа (все типы доступа я перечислил ранее). Если файл успешно открыт то Handle должен быть положительным цислом, отрицательное число - это код ошибки.
Во всех остальных функциях используется именно значение Handle, возвращаемое этой функцией.
FileClose(Handle: Integer) - закрывает файл
FileRead(Handle: Integer; var Buffer; Count: Integer): Integer;
FileWrite(Handle: Integer; const Buffer; Count: Integer): Integer;
Эти функции для чтения/записи файла, где Buffer любая переменная достаточного размера для чтения/записи куска информации (обычно типа PChar или массив), Count-количество байт, которое Вы желаете записать/прочитать. Функции возвращают количество байт которые реально были прочитанны или записаны.
Этот тип доступа к файлам применяется весьма редко. Дело в том что он практически дублирует соответствующие функции WinAPI и к тому же обычно работает несколько медленнее, чем например потоки. И все же использование функций FileOpen и FileClose не лишено привлекательности. Наряду с тем что эти функции намного легче в использовании соответствующих функций WinAPI (можете сравнить - FileOpen имеет 2 параметра, cooтветствующая функция WinAPI - CreateFile имеет 7 параметров, большая часть из которых реально требуется лишь в ограниченном числе случаев) этот путь доступа открывает возможность прямого использования всех функций WinAPI про работе с файлами, которые требуют Handle на открытый файл.
Работа через MAPI
Работа через MAPI
Работа через MAPI
Пример с delphi.mastak.ru мне понравился(который нашел Song), я решил его сюда скопировать, может кому понадобится:
unit Email;
interface
uses Windows, SusUtils, Classes;
function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
function IsOnline: Boolean;
implementation
uses Mapi;
function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
var
MapiMessage: TMapiMessage;
MapiFileDesc: TMapiFileDesc;
MapiRecipDesc: TMapiRecipDesc;
i: integer;
s: string;
begin
with MapiRecipDesc do
begin
ulRecerved:= 0;
ulRecipClass:= MAPI_TO;
lpszName:= PChar(RecipName);
lpszAddress:= PChar(RecipAddress);
ulEIDSize:= 0;
lpEntryID:= nil;
end;
with MapiFileDesc do
begin
ulReserved:= 0;
flFlags:= 0;
nPosition:= 0;
lpszPathName:= PChar(Attachment);
lpszFileName:= nil;
lpFileType:= nil;
end;
with MapiMessage do
begin
ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Subject);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 1;
lpRecips := @MapiRecipDesc;
if length(Attachment) > 0 then
begin
nFileCount:= 1;
lpFiles := @MapiFileDesc;
end
else
begin
nFileCount:= 0;
lpFiles:= nil;
end;
end;
Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;
function IsOnline: Boolean;
var
RASConn: TRASConn;
dwSize,dwCount: DWORD;
begin
RASConns.dwSize:= SizeOf(TRASConn);
dwSize:= SizeOf(RASConns);
Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
Result:= (Res = 0) and (dwCount > 0);
end;
end.
Взято с Vingrad.ru
Автор: Sven Lohmann
Обычно в программах используется два способа отправки email. Первый - это "ShellExecute", а второй - через OLE server, как в Delphi 5. Однако, предлагаю посмотреть, как эта задача решается посредствам MAPI.
Совместимость: Delphi 4.x (или выше)
unit MapiControl;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
{ Вводим новый тип события для получения Errorcode }
TMapiErrEvent = procedure(Sender: TObject; ErrCode: Integer) of object;
TMapiControl = class(TComponent)
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
private
{ Private-объявления }
FSubject: string;
FMailtext: string;
FFromName: string;
FFromAdress: string;
FTOAdr: TStrings;
FCCAdr: TStrings;
FBCCAdr: TStrings;
FAttachedFileName: TStrings;
FDisplayFileName: TStrings;
FShowDialog: Boolean;
FUseAppHandle: Boolean;
{ Error Events: }
FOnUserAbort: TNotifyEvent;
FOnMapiError: TMapiErrEvent;
FOnSuccess: TNotifyEvent;
{ +> Изменения, внесённые Eugene Mayevski [mailto:Mayevski@eldos.org]}
procedure SetToAddr(newValue : TStrings);
procedure SetCCAddr(newValue : TStrings);
procedure SetBCCAddr(newValue : TStrings);
procedure SetAttachedFileName(newValue : TStrings);
{ +< конец изменений }
protected
{ Protected-объявления }
public
{ Public-объявления }
ApplicationHandle: THandle;
procedure Sendmail();
procedure Reset();
published
{ Published-объявления }
property Subject: string read FSubject write FSubject;
property Body: string read FMailText write FMailText;
property FromName: string read FFromName write FFromName;
property FromAdress: string read FFromAdress write FFromAdress;
property Recipients: TStrings read FTOAdr write SetTOAddr;
property CopyTo: TStrings read FCCAdr write SetCCAddr;
property BlindCopyTo: TStrings read FBCCAdr write SetBCCAddr;
property AttachedFiles: TStrings read FAttachedFileName write SetAttachedFileName;
property DisplayFileName: TStrings read FDisplayFileName;
property ShowDialog: Boolean read FShowDialog write FShowDialog;
property UseAppHandle: Boolean read FUseAppHandle write FUseAppHandle;
{ события: }
property OnUserAbort: TNotifyEvent read FOnUserAbort write FOnUserAbort;
property OnMapiError: TMapiErrEvent read FOnMapiError write FOnMapiError;
property OnSuccess: TNotifyEvent read FOnSuccess write FOnSuccess;
end;
procedure Register;
implementation
uses Mapi;
{ регистрируем компонент: }
procedure Register;
begin
RegisterComponents('expectIT', [TMapiControl]);
end;
{ TMapiControl }
constructor TMapiControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOnUserAbort := nil;
FOnMapiError := nil;
FOnSuccess := nil;
FSubject := '';
FMailtext := '';
FFromName := '';
FFromAdress := '';
FTOAdr := TStringList.Create;
FCCAdr := TStringList.Create;
FBCCAdr := TStringList.Create;
FAttachedFileName := TStringList.Create;
FDisplayFileName := TStringList.Create;
FShowDialog := False;
ApplicationHandle := Application.Handle;
end;
{ +> Изменения, внесённые Eugene Mayevski [mailto:Mayevski@eldos.org]}
procedure TMapiControl.SetToAddr(newValue : TStrings);
begin
FToAdr.Assign(newValue);
end;
procedure TMapiControl.SetCCAddr(newValue : TStrings);
begin
FCCAdr.Assign(newValue);
end;
procedure TMapiControl.SetBCCAddr(newValue : TStrings);
begin
FBCCAdr.Assign(newValue);
end;
procedure TMapiControl.SetAttachedFileName(newValue : TStrings);
begin
FAttachedFileName.Assign(newValue);
end;
{ +< конец изменений }
destructor TMapiControl.Destroy;
begin
FTOAdr.Free;
FCCAdr.Free;
FBCCAdr.Free;
FAttachedFileName.Free;
FDisplayFileName.Free;
inherited destroy;
end;
{ Сбрасываем все используемые поля}
procedure TMapiControl.Reset;
begin
FSubject := '';
FMailtext := '';
FFromName := '';
FFromAdress := '';
FTOAdr.Clear;
FCCAdr.Clear;
FBCCAdr.Clear;
FAttachedFileName.Clear;
FDisplayFileName.Clear;
end;
{ Эта процедура составляет и отправляет Email }
procedure TMapiControl.Sendmail;
var
MapiMessage: TMapiMessage;
MError: Cardinal;
Sender: TMapiRecipDesc;
PRecip, Recipients: PMapiRecipDesc;
PFiles, Attachments: PMapiFileDesc;
i: Integer;
AppHandle: THandle;
begin
{ Перво-наперво сохраняем Handle приложения, if not
the Component might fail to send the Email or
your calling Program gets locked up. }
AppHandle := Application.Handle;
{ Нам нужно зарезервировать память для всех получателей }
MapiMessage.nRecipCount := FTOAdr.Count + FCCAdr.Count + FBCCAdr.Count;
GetMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));
try
with MapiMessage do
begin
ulReserved := 0;
{ Устанавливаем поле Subject: }
lpszSubject := PChar(Self.FSubject);
{ ... Body: }
lpszNoteText := PChar(FMailText);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
{ и отправителя: (MAPI_ORIG) }
Sender.ulReserved := 0;
Sender.ulRecipClass := MAPI_ORIG;
Sender.lpszName := PChar(FromName);
Sender.lpszAddress := PChar(FromAdress);
Sender.ulEIDSize := 0;
Sender.lpEntryID := nil;
lpOriginator := @Sender;
PRecip := Recipients;
{ У нас много получателей письма: (MAPI_TO)
установим для каждого: }
if nRecipCount > 0 then
begin
for i := 1 to FTOAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_TO;
{ lpszName should carry the Name like in the
contacts or the adress book, I will take the
email adress to keep it short: }
PRecip^.lpszName := PChar(FTOAdr.Strings[i - 1]);
{ Если Вы используете этот компонент совместно с Outlook97 или 2000
(не Express версии) , то Вам прийдётся добавить
'SMTP:' в начало каждого (email-) адреса.
}
PRecip^.lpszAddress := PChar('SMTP:' + FTOAdr.Strings[i - 1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
{ То же самое проделываем с получателями копии письма: (CC, MAPI_CC) }
for i := 1 to FCCAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_CC;
PRecip^.lpszName := PChar(FCCAdr.Strings[i - 1]);
PRecip^.lpszAddress := PChar('SMTP:' + FCCAdr.Strings[i - 1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
{ ... тоже самое для Bcc: (BCC, MAPI_BCC) }
for i := 1 to FBCCAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_BCC;
PRecip^.lpszName := PChar(FBCCAdr.Strings[i - 1]);
PRecip^.lpszAddress := PChar('SMTP:' + FBCCAdr.Strings[i - 1]);
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
end;
lpRecips := Recipients;
{ Теперь обработаем прикреплённые к письму файлы: }
if FAttachedFileName.Count > 0 then
begin
nFileCount := FAttachedFileName.Count;
GetMem(Attachments, MapiMessage.nFileCount * sizeof(TMapiFileDesc));
PFiles := Attachments;
{ Во первых установим отображаемые на экране имена файлов (без пути): }
FDisplayFileName.Clear;
for i := 0 to FAttachedFileName.Count - 1 do
FDisplayFileName.Add(ExtractFileName(FAttachedFileName[i]));
if nFileCount > 0 then
begin
{ Теперь составим структурку для прикреплённого файла: }
for i := 1 to FAttachedFileName.Count do
begin
{ Устанавливаем полный путь }
Attachments^.lpszPathName := PChar(FAttachedFileName.Strings[i - 1]);
{ ... и имя, отображаемое на дисплее: }
Attachments^.lpszFileName := PChar(FDisplayFileName.Strings[i - 1]);
Attachments^.ulReserved := 0;
Attachments^.flFlags := 0;
{ Положение должно быть -1, за разьяснениями обращайтесь в WinApi Help. }
Attachments^.nPosition := Cardinal(-1);
Attachments^.lpFileType := nil;
Inc(Attachments);
end;
end;
lpFiles := PFiles;
end
else
begin
nFileCount := 0;
lpFiles := nil;
end;
end;
{ Send the Mail, silent or verbose:
Verbose means in Express a Mail is composed and shown as setup.
In non-Express versions we show the Login-Dialog for a new
session and after we have choosen the profile to use, the
composed email is shown before sending
Silent does currently not work for non-Express version. We have
no Session, no Login Dialog so the system refuses to compose a
new email. In Express Versions the email is sent in the
background.
}
if FShowDialog then
MError := MapiSendMail(0, AppHandle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
else
MError := MapiSendMail(0, AppHandle, MapiMessage, 0, 0);
{ Теперь обработаем сообщения об ошибках. В MAPI их присутствует достаточное.
количество. В этом примере я обрабатываю только два из них: USER_ABORT и SUCCESS,
относящиеся к специальным.
Сообщения, не относящиеся к специальным:
MAPI_E_AMBIGUOUS_RECIPIENT,
MAPI_E_ATTACHMENT_NOT_FOUND,
MAPI_E_ATTACHMENT_OPEN_FAILURE,
MAPI_E_BAD_RECIPTYPE,
MAPI_E_FAILURE,
MAPI_E_INSUFFICIENT_MEMORY,
MAPI_E_LOGIN_FAILURE,
MAPI_E_TEXT_TOO_LARGE,
MAPI_E_TOO_MANY_FILES,
MAPI_E_TOO_MANY_RECIPIENTS,
MAPI_E_UNKNOWN_RECIPIENT:
}
case MError of
MAPI_E_USER_ABORT:
begin
if Assigned(FOnUserAbort) then
FOnUserAbort(Self);
end;
SUCCESS_SUCCESS:
begin
if Assigned(FOnSuccess) then
FOnSuccess(Self);
end
else begin
if Assigned(FOnMapiError) then
FOnMapiError(Self, MError);
end;
end;
finally
{ В заключение освобождаем память }
FreeMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));
end;
end;
{
Вопросы и замечания присылайте Автору.
}
end.
Взято с Исходников.ru
Работа через ODBC
Работа через ODBC
Cодержание раздела:
См. также статьи в других разделах:
Работа через WinAPI
Работа через WinAPI
Раздел написан Podval (примеры к сожалению на С++)
Любителям WinAPI посвящается...
Функции FileOpen, FileSeek, FileRead.
Возьмем форму, положим на нее кнопку, грид и Опен диалог бокс.
Это для Билдера, но какая нам в данном случае разница?
void __fastcall TForm1::Button1Click(TObject *Sender)
{
int iFileHandle;
int iFileLength;
int iBytesRead;
char *pszBuffer;
if (OpenDialog1->Execute())
{
try
{
iFileHandle = FileOpen(OpenDialog1->FileName, fmOpenRead);
iFileLength = FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
pszBuffer = new char[iFileLength+1];
iBytesRead = FileRead(iFileHandle, pszBuffer, iFileLength);
FileClose(iFileHandle);
for (int i=0;i<iBytesRead;i++)
{
StringGrid1->RowCount += 1;
StringGrid1->Cells[1][i+1] = pszBuffer[i];
StringGrid1->Cells[2][i+1] = IntToStr((int)pszBuffer[i]);
}
delete [] pszBuffer;
}
catch(...)
{
Application->MessageBox("Can't perform one of the following file operations: Open, Seek, Read, Close.", "File Error", IDOK);
}
}
}
Потренируемся еще.
Функции FileExists, RenameFile, FileCreate, FileWrite, FileClose.
Бросим на форму Save dialog box.
#include <dir.h>
void __fastcall TForm1::Button1Click(TObject *Sender)
{
char szFileName[MAXFILE+4];
int iFileHandle;
int iLength;
if (SaveDialog1->Execute())
{
if (FileExists(SaveDialog1->FileName))
{
fnsplit(SaveDialog1->FileName.c_str(), 0, 0, szFileName, 0);
strcat(szFileName, ".BAK");
RenameFile(SaveDialog1->FileName, szFileName);
}
iFileHandle = FileCreate(SaveDialog1->FileName);
// Write out the number of rows and columns in the grid.
FileWrite(iFileHandle, (char*)&(StringGrid1->ColCount), sizeof
(StringGrid1->ColCount));
FileWrite(iFileHandle, (char*)&(StringGrid1->RowCount), sizeof
(StringGrid1->RowCount));
for (int x=0;x<StringGrid1->ColCount;x++)
{
for (int y=0;y<StringGrid1->RowCount;y++)
{
// Write out the length of each string, followed by the string itself.
iLength = StringGrid1->Cells[x][y].Length();
FileWrite(iFileHandle, (char*)&iLength, sizeof
(iLength));
FileWrite(iFileHandle, StringGrid1->Cells[x][y].c_str(), StringGrid1->Cells[x][y].Length());
}
}
FileClose(iFileHandle);
}
}
(с) Оба примера взяты из хелпа по Borland C++ Builder 5.
Дата/время файла
extern PACKAGE int fastcall FileGetDate(int Handle);
extern PACKAGE int fastcall FileSetDate(int Handle, int Age);
Первоисточник тот же.
Атрибуты файла.
extern PACKAGE int __fastcall FileGetAttr(const AnsiString FileName);
И
extern PACKAGE int fastcall FileSetAttr(const AnsiString FileName, int Attr);
Может быть, такая функция полезна будет, хотя о программном поиске файлов и так много наговорено. Но на всякий случай, как говорится.
В этом примере идет поиск в текущем каталоге и каталоге Windows
void __fastcall TForm1::Button1Click(TObject *Sender)
{
char buffer[256];
GetWindowsDirectory(buffer, sizeof(buffer));
AnsiString asFileName = FileSearch(Edit1->Text, GetCurrentDir() + AnsiString(";") + AnsiString(buffer));
if (asFileName.IsEmpty())
ShowMessage(AnsiString("Couldn't find ") + Edit1->Text + ".");
else
ShowMessage(AnsiString("Found ") + asFileName + ".")
}
В дополнение к Дате/Времени
extern PACKAGE int __fastcall FileAge(const AnsiString FileName);
Для конвертации возвращаемого значения в TDateTime:
extern PACKAGE int fastcall FileDateToDateTime(int FileDate);
Работа метода Assign
Работа метода Assign
В общем случае, утверждение "Destination := Source" не идентично утверждению "Destination.Assign(Source)".
Утверждение "Destination := Source" принуждает Destination ссылаться на тот же объект, что и Source, а "Destination.Assign(Source)" копирует содержание объектных ссылок Source в объектные ссылки Destination.
Если Destination является свойством некоторого объекта (тем не менее, и свойство не является ссылкой на другой объект, как, например, свойство формы ActiveControl, или свойство DataSource элементов управления для работы с базами данных), тогда утверждение "Destination := Source" идентично утверждению "Destination.Assign(Source)". Это объясняет, почему LB.Items := MemStr работает, когда MemStr := LB.Items нет.
Взято из
Советов по Delphi от
Сборник Kuliba
Работа с ActiveX, OCX, VBX
Работа с ActiveX, OCX, VBX
Cодержание раздела:
Работа с Alias
Работа с Alias
Cодержание раздела:
См. также другие разделы:
См. также статьи в других разделах:
Работа с ARP
Работа с ARP
Cодержание раздела:
Работа с ASCII файлами, CSV файлы
Работа с ASCII файлами, CSV файлы
Cодержание раздела:
См. также статьи в других разделах:
Работа с автоинкрементальными (AutoInc) полями
Работа с автоинкрементальными (AutoInc) полями
Работа с автоинкрементальным типом поля (Auto-increment, поле с автоприращением)
В приложениях Delphi, при использовании таблиц, содержащих автоинкрементальные поля или поля, автоматически увеличивающие каким-либо способом, неизвестным приложению, свое значение, могут наблюдаться проблемы. Таблицы Paradox, InterBase, Sybase и Informix имеют средства автоматической вставки и обновления значений полей, без вмешательства сервисов и конечных приложений. Тем не менее, не каждая операция с таблицой поддерживается таким механизмом. Данный документ призван продемонстрировать основные методы работы с такими типами полей в таблицах Paradox 5.0, Informix 5.x, MS/Sybase SQL Server 4.x, InterBase 4.0 и Local InterBase.
У каждого типа таблицы за кулисами работает собственный механизм. Таблицы Paradox поддерживают автоинкрементальный (Autoincrement) тип поля. Когда к таким таблицам добавляются новые записи, Borland Database Engine определяет максимальное текущее значение в данной колонке, прибавляет единицу, и обновляет новую строку с новым значением.
Для таблиц Informix данное поведение предусматривается специфическим типом Informix-поля, названного Serial. Колонки Serial отличаются от автоприращиваемых (Autoincrement) полей Paradox тем, что в таблицах Informix значения этого типа полей могут быть изменены, тогда как в таблицах Paradox они предназначены только для чтения.
Таблицы InterBase и MS/Sybase SQL Server не имеют поддерживающего данную характеристику специального типа поля, но для выполнения той же задачи можно воспользоваться триггерами. Триггеры являются специализированными процедурами, которые находятся на сервере баз данных и автоматически выполняются в ответ на какое-либо событие, например, добавление в таблицу, обновление и удаление. Использование таблиц со связанными триггерами может быть особенно проблематичным, поскольку триггеры способны делать намного больше функций, чем просто увеличивать значения приращиваемой колонки.
Три функциональные области, которые могут влиять на данный тип поля в случае простой вставки, batchmoves и привязки (Linking) таблицы.
Обработка Update и/или Append BatchMoves
Таблицы Paradox
Поскольку автоинкрементальный тип поля является типом только для чтения, то попытка вызвать операцию batchmove с данной колонкой в целевой таблице может привести к ошибке. Для того, чтобы обойти это, свойство компонента TBatchMove Mappings должно быть установлено так, чтобы поля исходной таблицы соответствовали полям целевой таблицы, за исключением ее автоинкрементальных полей.
Таблицы Informix
Групповое перемещение строк в таблицу Informix с колонками, имеющими тип Serial, ошибки не вызовет. Тем не менее, должны вас предупредить о возможных проблемах, поскольку Serial-колонки имеют возможность обновления и часто используются в качестве первичного ключа.
Таблицы InterBase
Таблицы MS/Sybase SQL Server
Триггеры в таблицах InterBase и SQL Server могут отследить любые неверные изменения, сделанные в таблице, но это всецело зависит от установок самого триггера. Здесь также вас необходимо предупредить о возможных проблемах, поскольку обновляемые триггером колонки могут быть использованы в качестве первичного ключа.
Привязки таблиц посредством MasterSource & MasterFields
Таблицы Paradox
Таблицы Informix
Если свойства MasterFields и MasterSource используются для привязки таблиц с отношениями мастер-деталь и одно из полей в "деталь"-таблице является автоинкрементальным или Serial-полем, то соответствующее поле в "мастер"-таблице должно иметь тип Long Integer или быть Serial-полем. Если "мастер"-таблица не является таблицей Paradox, то ключевое поле "мастер"-таблицы может быть полем любого целого типа, которого она поддерживает.
Таблицы InterBase
Таблицы MS/Sybase SQL Server
Привязка с использованием данного типа таблиц не вызывает проблем, если пользоваться полями, изменяемые триггером. Единственное требование заключается в сопоставлении необходимых типов колонок обоих таблиц.
Простая вставка/обновление (Inserts/Updates)
Таблицы Paradox
Поскольку автоинкрементальные поля Paradox имеют аттрибут только для чтения, они обычно не предназначены для обновления и вставки новых записей. Следовательно, свойство Required для field-компонентов, базирующихся на автоинкрементальных полях, должны всегда быть установлены в False. Это может быть выполнено из Delphi с помощью Fields Editor определением field-компонентов в режиме разработки) двойной щелчок на компоненте TQuery или TTable), или во время работы программы с помощью следующего кода:
Table1.Fields[0].Required:= False;
или
Table1.FieldByName('Fieldname').Required := False;
Таблицы Informix
Хотя Serial-поля Informix и являются обновляемыми, но если у них должна быть использована характеристика автоприращения, то свойство Required для field-компонентов, базирующихся на таком поле, должно быть установлена в False. Делайте все также, как это было описано для таблиц Paradox.
Таблицы InterBase
Таблицы MS/Sybase SQL Server
Обработка вставки этих изменяемых триггером типов таблиц требует предпринять некоторое количество шагов. Дополнительные шаги особенно необходимы в том случае, если вставка выполняется посредством стандартных элементов управления для работы с базами данных, типа DBEdits или DBMemos.
Вставка строк в изменяемые триггерами InterBase- и SQL Server таблицы может с достаточной долей вероятности вызвать сообщение об ошибке 'Record/Key Deleted'. Это сообщение об ощибки появляется несмотря на то, что таблица правильно обновляется на сервере. Это происходит в случае, если:
1. Триггер обновляет первичный ключ. Ошибка может возникнуть не только при использовании триггера, но триггер является наиболее вероятной причиной ошибки.
2a. Другие колонки таблицы имеют связанные значения по умолчанию. Это выполняется ПО УМОЛЧАНИЕ в случае создания таблицы InterBase или хранимой на сервере SQL Server процедурой sp_bindefault.
или
2b. При вставке новой строки обновляются поля, имеющие тип Blob.
или
2b. В таблице InterBase определены калькулируемые поля.
Основополагающая причина этих ошибок кроется в том, что когда запись (или идентификационный ключ) изменяется на сервере, BDE больше не имеет способов идентифицировать запись для ее повторного поиска. То есть запись больше не появляется, как это было бы, если бы ее "запостили", следовательно, BDE будет думать, что запись удалена (или изменен ключ).
Во-первых, field-компоненты изменяемых триггером полей должны иметь свойство Required, установленное в False. Делайте все также, как это было описано для таблиц Paradox.
Во-вторых, чтобы избежать случайных ошибок, установите порядок таблицы по индексу, не использующему поля, обновляемые триггером. Это также не позволит вновь введенной записи исчезать сразу после ее вставки.
Наконец, если условие 1, приведенное выше, невозможно, но возможно наступление событий 2a, 2b или 2c, то необходимо создать обработчик события AfterPost компонента TTable как показано ниже:
procedure TForm1.Table1AfterPost(DataSet: TDataset);
begin
Table1.Refresh;
end;
Метод Refresh вновь перечитывает значения, измененные сервером.
Если выполнение условий 2a, 2b или 2c невозможно, то таблица могла бы быть обновлена без элементов управления Delphi для работы с базами данных. Это может быть выполенено с помощью компонента TQuery, ссылающегося на ту же самую таблицу. После того, как будет послан запрос на обновление, любые TTable-компоненты, использующие ту же самую таблицу, должны быть обновлены (Refreshed).
Взято
из
Работа с BDE в сети, общий доступ к данным
Работа с BDE в сети, общий доступ к данным
Cодержание раздела:
См. также статьи в других разделах:
Работа с BitMap
Работа с BitMap
Cодержание раздела:
См. также статьи в других разделах:
Работа с числами
Работа с числами
Cодержание раздела:
См. также статьи в других разделах:
Работа с чужими процессами
Работа с чужими процессами
Cодержание раздела:
См. также в других разделах:
Работа с Clipper
Работа с Clipper
Cодержание раздела:
Работа с цветами и палитрами
Работа с цветами и палитрами
Cодержание раздела:
См. также статьи в других разделах:
Работа с датами и временем
Работа с датами и временем
Cодержание раздела:
См. также другие разделы:
Работа с DB/2
Работа с DB/2
Cодержание раздела:
Работа с DBase
Работа с DBase
Cодержание раздела:
См. также статьи в других разделах:
Работа с DBExpress
Работа с DBExpress
Cодержание раздела:
См. также статьи в других разделах:
Работа с DLL
Работа с DLL
Cодержание раздела:
См. также в других разделах:
Работа с Email
Работа с Email
Cодержание раздела:
·
·
·
·
·
См. также статьи в других разделах:
Работа с Excel из Дельфи
Работа с Excel из Дельфи
Чтобы работать с Excel из Delphi cуществует два основных пути. . Таким же образом можно работать и с Word, Access, Outlook(не Express) и многими другими программами.
Второй способ (для таблицы Excel) это
Vit
Взято с Vingrad.ru
Cодержание раздела:
См. также статьи в других разделах:
Работа с Explorer (Проводником)
Работа с Explorer (Проводником)
Cодержание раздела:
Работа с файловой системой
Работа с файловой системой
Cодержание раздела:
·
·
·
См. также статьи в других разделах: