Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru

Ежедневная рассылка сайта Мастера DELPHI

DELPHI.mastak.ru

Выпуск от 12.09.02 09:04

Вышел очередной дайджест форумов. Скачать можно здесь
Кое-что из нашей кладовки   |x|
  • Компонент hpsSMTP для отправки писем. drug_d1ller drug_d1ller@marihuana.com   (11.09.02 17:11)
    После первого релиза, мой ящик был завален сообщениями о том, что компонент не работает под Delphi 6 и что былобы не плохо выложить пример его использования.
    В этот раз я учёл ваши предложения и пожелания.

    Достоинства перед другими аналогичными компонентами:
    + Самый малогобаритный компонент для отправки писем.
    + Исходник и пример использования прилагаются
    + Работает в Win 95/98/ME/NT/2000/XP
    может чего забыл...
    »»» Скачать: исходные тексты (59кб)
Лучшее из нашего FAQ   |x|
Вот всю жизнь в TVision в итераторах нужно было (параметром) передавать указатель на локальную процедуру, а тут задумал сделать свой итератор для обхода некоей древовидной структуры и на тебе - компилятор ругается.
Зравствуете Акжан.
У вас в разделе есть следующий ворос и несколько ответов на него:
 
Вот всю жизнь в TVision в итераторах нужно было (параметром) передавать указатель на локальную процедуру, а тут задумал сделать свой итератор для обхода некоей древовидной структуры и на тебе - компилятор ругается. Да еще и в хелпе носом тыкают, что так мол в принципе нельзя делать... Гм. И как быть?
 
- могу предложить собственное решение данной проблемы. Тем более, что мой способ работает с рекурсивными вызовами любого уровня сложности:

type
  Long = LongInt;
  Bool = Boolean; // - так уж у меня в библиотеке сложилось
  Tl3IteratorAction = function(Data: Pointer; Index: Long): Bool;
                      {$IfDef Win32}
                      register;
                      {$EndIf Win32}
var
 l3StubHead : THandle = 0;
 
function l3AllocStub: THandle;
  {-}
(*  register;
asm
     !      mov   ecx, l3StubHead
          jecxz @Alloc
          mov   eax, ecx
          mov   ecx, [ecx]
          mov   l3StubHead, ecx
          ret
@Alloc:
          xor   eax, eax
          push  16               { SizeOf(TCode) -> stack  }
          push  eax              { GMem_Fixed -> stack     }
          call  GlobalAlloc
@ret:
end;{asm}*)
begin
 if (l3StubHead = 0) then
  Result := Windows{l3System}.GlobalAlloc(GMem_Fixed, 16)
 else begin
  Result := l3StubHead;
  l3StubHead := PHandle(Result)^;
 end;
end;
 
procedure l3FreeLocalStub(Stub: Pointer);
  {-}
begin
 PHandle(Stub)^ := l3StubHead;
 l3StubHead := THandle(Stub);
end;
 
(*procedure l3FreeLocalStub(Stub: Pointer);
                          {eax}
  register;
  {-}
asm
          push eax                             !   { Handle -> stack         }
          call GlobalFree
end;{asm}*)
 
procedure l3FreeStubs;
var
 Prev : THandle;
 Next : THandle;
begin
 Prev := l3StubHead;
 while (Prev <> 0) do begin
  Next := PHandle(Prev)^;
  Windows{l3System}.GlobalFree(Prev);
  Prev := Next;
 end;{Prev <> 0}
 l3StubHead := 0;
end;
 
(*type
  TCode = array [0..11] of Byte;
const
  Code : TCode = (
    $66, $58,               { pop eax         }
    $68, $FF, $FF,          { push $FFFF      } { OldBP  }
    $66, $50,               { push eax        }
    $EA, $EE, $EE, $FF, $FF { jmp $FFFF:$EEEE } { Action }
  );*)
 
function l3LocalStub(Action: Pointer): Pointer;
                     {eax}
  register;
  {-}
asm
          push edi                               { Save edi                }
          push eax !                               { Save Action             }
          call l3AllocStub
          {! --- !}
          {xor  eax, eax                          { 0 -> eax                }
          {push 16                                { SizeOf(TCode) -> stack  }
          {push eax                               { GMem_Fixed -> stack     }
          {call GlobalAlloc}
          {! --- !}
 
          { Создаем новый код: }
          mov  edi, eax                          { Handle -> edi           }
          mov  edx, eax                          { Handle -> edx           }
          cld                                    { Move forward            }
 
          mov  eax, $68
          stosb
          mov  eax, ebp                          { предыдущий ebp -> eax   }
          stosd                                  { "push OldBP" -> [edi]   }
 
          mov  eax, $B9
          stosb
          pop  eax                !                { Action -> eax           }
          stosd                                  { "mov ecx, Action" -> [edi] }
 
          mov  eax, $D1FF
          stosw                                  { "call ecx" -> [edi]     }
 
          mov  eax, $59
          stosb                                  { "pop ecx" -> es:[di]    }
 
          mov  eax, $C3
          stosb                                  { "ret" -> [edi]          }
 
          mov  eax, edx                          { Handle -> eax           }
          pop  edi                               { Restore edi             }
end;{asm}
 
function  l3L2IA(Action: Pointer): Tl3IteratorAction;
                {eax}
  register;
  {-}
asm
          jmp  l3LocalStub
end;{asm}
 
procedure l3FreeIA(Stub: Tl3IteratorAction);
                  {eax}
  register;
  {-}
asm
          jmp  l! 3FreeLocalStub
end;{asm}
 
теперь простейшая реализация итератора:

procedure Tl3VList.Iterate(aLo, aHi: Tl3Index; Action: Tl3IteratorAction);
  {virtual;{!v19}         {edx, ecx}
  register;
  {-}
(*asm
         push ebx
         mov  ebx, eax
         mov  eax, [eax].Tl3VList.f_Count
         or   eax, eax
         jle  @@ret // список пуст
 
         dec  eax
         cmp  ecx, eax
         jle  @@aHiLECount
         mov  ecx, eax
@@aHiLECount:
 
         mov  eax, [ebx].Tl3VList.f_List
         or   eax, eax
         jz   @@ret // список пуст
 
         or   edx, edx
         jge  @@aLoGE0
         xor  edx, edx
@@aLoGE0:
         sub  ecx, edx
         jl   @@ret // верхний индекс меньше нижнего
 
         mov  ebx, edx
         shl  ebx, 2
         add  eax, ebx
 
         pop  ebx
         inc  ecx
 
! @@loop:
         push eax
         push edx
         push ecx
 
         call Action
 
         pop  ecx
         pop  edx
 
         or   al, al
         jz   @@loopend
 
         pop  eax
         add  eax, 4
         inc  edx
 
         loop @@loop
 
         jmp  @@ex
@@loopend:
         pop  eax
         jmp  @@ex
@@ret:
         pop  ebx
@@ex:
end;//asm*)
var
 i, j, k : Long;
 l_TmpItem : Pointer;
begin
 if (f_List <> nil) then begin
  j := Max(0, aLo);
  k := Min(Pred(Count), aHi);
  if IsMultiThread then
   for i := j to k do begin
    l_TmpItem := Items[i];
    if not Action(@l_TmpItem, i) then break;
   end
  else
   for i := j to k do
    if not Action(PChar(f_List) + i * SizeOf(Pointer), i) then br! eak;
 end;{f_List <> nil}
end;
 
procedure Tl3VStorage.IterateF(I1, I2: Tl3Index; Action: Tl3IteratorAction);
  {-}
begin
 try
  Iterate(I1, I2, Action);
 finally
  l3FreeIA(Action);
 end;{try..finally}
end;
 
и его вызов:

function Tl3VList.IndexOf(Item: Pointer): LongInt;
 
 function FindItem(P: PPointer; Index: Long): Bool; far;
 begin
  if (P^ = Item) then begin
   IndexOf := Index;
   Result := false;
  end else
   Result := true;
 end;
 
begin
 Result := -1;
 IterateAllF(l3L2IA(@FindItem));
end;

 
- забавно, что метод Iterate можно вызывать как для глобального, так и для локального метода (естественно с предшествующим вызовом l3L2IA).
в секции finalization модуля где живет l3L2IA надо не забыть вызвать метод: l3FreeStubs.
- это схематично ид! еи, просто выдирать все целиком из своей библиотеки - тяжело да и некогда.

-- Прислал: Alex W. Lulin lulin@garant.ru http://lulinalex.chat.ru --

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
  • Strored Procedure - где ошибка
    Здравствуйте. Написал процедуру ////// Begin clipboard ////// CREATE PROCEDURE GetPrice (IN aData date, IN aWare ...
  • Как получить контрольную сумму (CRC) функции?
    Точнее как получить понятно...неясно как определить размер памяти, занимаемый функцией? Буду благодарен за любые идеи!
  • Доступ к 3-му параметру DllEntryPoint()
    BOOL WINAPI DllEntryPoint( HINSTANCE hinstDLL, // handle to DLL module DWORD fdwReason, // reason for calling ...
  • Инфразвук
    Интересно, можно ли из системного динамика выдавить звук частотой ниже 16 герц?
  • бензоколонки ...
    всем привет !!! кто-то подключал бензоколонку к компу ? как и откуда читаетса ? где найти доку ?
  • На что сменить ГЛЮЧНЫЙ Paradox?
    Есть база (уже довольно большая) на Paradox'e. К ней имеется клиент. Paradox своими глюками откровенно задолбал. Народ, ...
  • Driver
    Кто нибудь писал драйвер в дельфях? Нужна общая инфа. Я знаю только что обычно драйвер это длл и работает с какой-то ...
У нас большой выбор статей   |x|
MIDAS - multi-tired distributed application service suite
Подробно о MIDAS (multi-tired distributed application service suite). Создание сервера приложений. Создание "Тонкого клиента".
Новинки книжного рынка   |x|
Shareware : профессиональная разработка и продвижение программ
Рассматриваются особенности создания условно-бесплатных программ, приводятся рекомендации по разработке интерфейса и оформлению документации, обсуждаются теоретические и практические вопросы проектирования, рекламы, маркетинга и технической поддержки создаваемого программного продукта. Книга содержит примеры удачной разработки и реализации программ из мировой и российской практики. Множество иллюстраций дает возможность более наглядно представить объем и качество работы, необходимой для создания программ на профессиональном уровне.
Автор: Жарков С.
Другие сайты о DELPHI   |x|
Черный программист
Программы и исходные тексты на DELPHI. Форматы файлов.
FAQ. HELP. Статьи. Примеры программ.
Поиск по основным сайтам RU DELPHI.
Web программирование. HTML, PHP, Perl.

» Оценка сайта: 2
Опрос населения :)
Образование программиста?
»»» Высшее
»»» Незаконченное высшее
»»» Среднее специальное
»»» Среднее
Журнал "RSDN Magazine"  |x|

Дорогие друзья! Мы рады представить вам новый совместный проект сайтов www.rsdn.ru, delphi.mastak.ru и www.optim.ru - профессиональный журнал для программистов RSDN Magazine.
Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!
На сайте выложен анонс пилотного выпуска журнала, вступительное слово от редакции.

Для души

Хокку дня
В праздник по улицам Эдо
Бродят нарядные гейши
И множество вкусных собак...

Афоризмы
Самый сильный не всегда бывает самым счастливым...

Фраза дня
Большой пpогpамме - большие глюки.

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В Калифорнии (США) животным запрещается сношаться в пределах 500 метров от общественных заведений.
В Алабаме (США) запрещено водить машину необутым. Закон, однако, позволяет ездить по встречной полосе, если включить фары..

И на закуску коротенький анекдот
О человеке можно судить по его Temporary Internet Files...

Фотоприколы.
Начните день с хорошего настроения!
http://delphi.mastak.ru/cgi-bin/prikol.pl?id=94


На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (delphi@mastak.com)

Добро пожаловать на сайт -= Мастера DELPHI =- 


http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное