Цитата(Yanis @ 5.12.2004, 18:53)

Видимо не получится. Не чувтвуется интузиазм в этих словах

Извини, а ты думал vit будет вам под с++ делать

Что-то я вообще туго улавливаю смысл последнее время... Смотрим цепь обсуждений:

Цитата(Yanis @ 4.12.2004, 14:43)

Я смотрю что наполнение DRKB идёт медленно, особенно последней версии

Цитата(Yanis @ 4.12.2004, 14:43)

Может стоить создать DRKB4C++!?

Цитата(Vit @ 4.12.2004, 17:56)

Я не против. Могу дать исходники DRKB - переделывайте под C++

Цитата(Yanis @ 5.12.2004, 09:53)

Видимо не получится. Не чувтвуется интузиазм в этих словах

Неужели господин Yanis всерьёз полагает что перевод на C++ должен как-то ускорить выход очередной версии DRKB или полагает что наполнение DRKB идёт медленно из-за того что у меня просто слишком много свободного времени, и меня просто надо загрузить для ускорения процесса? Это прямо как из детской сказки: "Давай ты меня понесёшь на себе а я буду тебе дорогу показывать и идти тебе будет легче..."

Вот немного по алгоритмам теории графов - не с форума, а с моей квалификационной работы. Правда, на украинском языке. Если понадобится, могу перевести на русский.

Цитата

АЛГОРИТМИ ТЕОРІЇ ГРАФІВ Основні визначення теорії графів Орієнтований граф, як пишуть у [1] – це «пара (V, E), де V – кінцева множина, а E – бінарне відношення на V, тобто підмножина множини V*V… …множину V називають множиною вершин графа, а множину E – множиною ребер». У неорієнтованому графі множина V складається з неупорядкованих пар вершин. Парою називається множина {u,v}, де u і v належать V. Якщо в графі є ребро (u,v), то говорять, що вершина u суміжна з вершиною v. Для неорієнтованих графів відношення суміжності є симетричним. Шлях довжини k з вершини u у вершину v визначається як послідовність вершин v0, v1, v2, … vk, у який v0 = u, vk = v, а (vi-1, vi) – ребро графа. Циклом в орієнтованому графі називається шлях, у якому початкова вершина збігається з кінцевою і який містить хоча б одне ребро. Граф, у якому немає циклів, називається ациклічним. Представлення графів Є два стандартних способи представлення графів: як список суміжних вершин чи як матрицю суміжності. Обидва способи мають свої плюси і недоліки. Список суміжних вершин дуже зручний при представленні розріджених графів. Він дає вигідне зменшення займаного обсягу пам'яті. Але при цьому цей спосіб не дає можливості швидко перевірити наявність ребра між двома довільними вершинами. Це представлення графу використовує масив списків по одному списку для кожної вершини. Список зберігає усі вершини, суміжні з даною вершиною в довільному порядку. Матриця суміжності займає більший обсяг пам'яті, але зручна для представлення щільних графів. Тут кожен елемент Mij матриці позначає наявність ребра межу вершиною i та вершиною j. Якщо граф – зважений, то Mij може позначати вагу ребра (i,j). Алгоритм пошуку в ширину Алгоритм пошуку в ширину (Breadth-first search) – один з базисних алгоритмів, що є основою багатьох інших. Наприклад, алгоритм Дейкстри пошуку найкоротших шляхів з однієї вершини й алгоритм Прима пошуку мінімального покриваючого дерева можуть розглядатися як узагальнення пошуку в ширину.. Нехай заданий граф G і фіксована початкова вершина s. Алгоритм пошуку в ширину перелічує всі досяжні з s (якщо йти по ребрах) вершини в порядку збільшення відстані від s. У процесі пошуку з графу виділяється частина, що називається «деревом пошуку в ширину» з коренем s. Вона містить усі досяжні з s вершини (і тільки їх). Для кожної з них шлях з кореня в дереві пошуку буде одним з найкоротших шляхів до s. Алгоритм можна застосувати і до орієнтованих, і до неорієнтованих графів. Назва пояснюється тим, що в процесі пошуку ми йдемо в широчінь, а не в глиб (з початку переглядаємо сусідні вершини, потім сусідів сусідів, і т.д.). Для наочності будемо вважати, що в процесі роботи алгоритму вершини графа можуть бути білими, сірими і чорними. Спочатку вони всі білі, а в ході роботи алгоритму біла вершина може стати сірою, сіра - чорною, але не навпаки. Зустрівши нову вершину, алгоритм пошуку фарбує її, так що сірі і чорні вершини - уже виявлені вершини. Різниця між сірими і чорними вершинами використовується алгоритмом для керування порядком обходу: сірі вершини утворять "лінію фронту", а чорні - "тил". Таким чином, тільки сірі вершини можуть мати суміжні невиявлені вершини. Спочатку дерево пошуку складається тільки з початкової вершини s. Як тільки алгоритм виявляє нову вершину v, суміжну з раніше знайденою вершиною u, вершина v разом з ребром (u, v) додається до дерева пошуку, стаючи дитиною вершини u, а u стає батьком v. Кожна вершина виявляється тільки один раз, так що двох батьків у вершини бути не може. Оцінюючи складність цього алгоритму, ми зауважуємо, що вершини тільки сутеніють, отже, кожна вершина обробляється тільки один раз. При цьому для обходу суміжних вершин для даної вершини використовується часу O(E). Отже, обчислювальна складність алгоритму пошуку в ширину – O(V+E), де V – кількість вершин у графі, а E – кількість ребер. Алгоритм пошуку в глибину Пошук у глибину – ще один спосіб обходу графу. Він застосовується в таких алгоритмах, як алгоритм топологічного сортування, алгоритм пошуку сильно зв'язаних компонентів. Стратегія пошуку в глибину така: йти вглиб, поки це можливо (є непройдені вихідні ребра), повертатися і шукати інший шлях, коли таких ребер немає. Якщо після цього залишаються недоторкані вершини - можна вибрати одну з них і повторювати процес доти, поки залишаються невиявлені вершини. Знайшовши уперше вершину v, суміжну з u, ми відзначаємо цю подію, записуючи в поле ?[v] значення u. Утворюється дерево чи кілька дерев. Як і пошук у ширину, алгоритм пошуку в глибину використовує кольори вершин. Спочатку усі вершини - білі. При виявленні нової вершини, вона фарбується в сірий колір. Коли вершина цілком оброблена, вона фарбується в чорний колір. Крім цього пошук у глибину ставить на вершинах мітки часу. Кожна вершина має дві мітки: d[v] показує, коли вершина була виявлена, f[v] - коли оброблена. Ці мітки використовуються в багатьох алгоритмах на графах. Під час виконання цього алгоритму, обробка кожної вершини відбувається рівно один раз. Отже, складність роботи даного алгоритму становить O(V+E), де V – кількість вершин у графі, а E – кількість ребер. Алгоритм Дейкстри пошуку найкоротших шляхів Уявимо собі карту автомобільних шляхів України. Як знайти найкоротший шлях із Дніпропетровська в Київ? Можна, звичайно, перебрати всі можливі варіанти і вибрати мінімальний з них. Але тоді ми одержуємо мільйони свідомо невірних операцій (наприклад, навіщо нам їхати з Дніпропетровська в Київ через Донецьк, що знаходиться зовсім в іншому боці). Далі буде розглянутий спосіб ефективного рішення цієї задачі. Тут буде розглядатися тільки пошук найкоротших шляхів з однієї вершини: даний зважений граф G і початкова вершина s. Потрібно знайти всі найкоротші шляхи з s в усі вершини графу. Алгоритм Дейкстри здатний знайти найкоротший шлях тільки для графів, у яких усі ребра недодатньої ваги. Багато алгоритмів пошуку найкоротших шляхів використовують особливу техніку – техніку релаксації. І алгоритм Дейскстри – не виключення. Техніка релаксації полягає в наступному: для кожної вершини v ми зберігаємо деяке число d[v], що є верхньою оцінкою ваги найкоротшого шляху з s у v. Початкове значення оцінки найкоротшого шляху і масиву ? (масиву предків) задається наступною процедурою: Initialize-Single-Source(G, s) 1 for (для) усіх вершин v 2  do d[v] = ? 3      ?[v] = NIL 4 d[s] = 0 Релаксація ребра (u,v) полягає в наступному: значення d[v] зменшується до d[u]+w(u,v) (якщо друге значення менше попереднього). При цьому d[v] залишається верхньою оцінкою. Relax(u, v, w) 1 if d[v] > d[u] + w(u,w) 2  then d[v] = d[u] + w(u,w) 3          ?[v] = u По своїй суттевості, алгоритм Дейкстри є жадним алгоритмом. У процесі роботи алгоритму Дейкстри підтримується множина S, що складається з вершин v, для яких знайдений найкоротший шлях. Алгоритм вибирає вершину u з найменшим d[u], додає її до множини S і здійснює релаксацію всіх ребер, що виходять з u, після чого цикл повторюється. Складність роботи алгоритму Дейкстри становить O(V2) Пошук максимального паросполучення Нехай G(V, E) - неорієнтований граф. Паросполученням назвемо множину ребер M, що не мають спільних кінців (кожна вершина v з V є кінцем максимум одного ребра з M). Будемо говорити, що вершина v з V входить у паросполучення M, якщо в M є ребро з кінцем v. У противному випадку v вільна. Максимальне паросполучення - це паросполучення M, що містить максимально можливе число ребер. Для рішення задачі про найбільше паросполучення використовується метод ланцюгів, що чергуються. Нехай M - паросполучення в двочастковому графі G. Ланцюг, у який по черзі входять ребра з M і з "не-M", назвемо ланцюгом, що чергується. Вершини, инцидентні ребрам з M, назвемо насиченими. Чергуючийся відносно M ланцюг з ненасиченими вершинами називається ланцюгом, що збільшує, відносно M. Паросполучення M є максимальним тоді і тільки тоді, коли немає збільшуючих відносно M ланцюгів Для задач про максимальне паросполучення є безліч метафор. Ось одна з них: є множина чоловіків і множина наречених. Ребро (u,v) означає, що чоловік u і наречена v згодні оженитися. Максимальне паросполучення доставляє ЗАГСу більше всього роботи. Алгоритм пошуку максимального паросполучення такий: 1. Ініціалізація 2. Побудова жадібного паросполучення. 3. У циклі по i з I' застосувати алгоритм знаходження всіх досяжних вершин з                   i. Якщо серед них виявиться вершина з J', то збільшити ланцюг. 4. Якщо множини I' і J' непорожні і на кроці 3 удалося збільшити ланцюг, то                  перейти до 3 5. Видати рішення Тут I' і J' - множини ненасичених вершин із двох часток графа. "Збільшити ланцюг" - говорячи простою мовою - означає розгорнути ребра графа.

Когда делал квалификационную, материалы брал в основном из Кормен, Лейзерсон, Ревест - Алгоритмы: построение и анализ

Да, неплохо было бы перевести... Спасибо

есть интересная ссылка:
http://www.kib.ru/lib/resources/src19/Secrets_Delphi_7_Book/

По крайней мере там можно немного прочитать о RaveReports

Может есть смысл просто "выкусить" оттуда инфо, скажите, какие темы наиболее востребованы

Это сообщение отредактировал(а) dsergey - 24.12.2004, 11:13

посмотрю

Vit, я могу выложить примеры работы с MS Agent, если конечно Microsoft не расстроиться

Есть предлежение, включить примеры шифрования, например
Алгоритм MD5 шифрования (хэширования)

Код

Function md5(s:string):string;   var a:array[0..15] of byte;      i:integer;   LenHi, LenLo: longword;   Index: DWord;   HashBuffer: array[0..63] of byte;   CurrentHash: array[0..3] of DWord;   procedure Burn;   begin     LenHi:= 0; LenLo:= 0;     Index:= 0;     FillChar(HashBuffer,Sizeof(HashBuffer),0);     FillChar(CurrentHash,Sizeof(CurrentHash),0);   end;   procedure Init;   begin    Burn;    CurrentHash[0]:= $67452301;    CurrentHash[1]:= $efcdab89;    CurrentHash[2]:= $98badcfe;    CurrentHash[3]:= $10325476;   end;   function LRot32(a, b: longword): longword;   begin    Result:= (a shl b) or (a shr (32-b));   end;   procedure Compress;   var    Data: array[0..15] of dword;    A, B, C, D: dword;   begin    Move(HashBuffer,Data,Sizeof(Data));    A:= CurrentHash[0];    B:= CurrentHash[1];    C:= CurrentHash[2];    D:= CurrentHash[3];    A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 0] + $d76aa478,7);    D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 1] + $e8c7b756,12);    C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 2] + $242070db,17);    B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 3] + $c1bdceee,22);    A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 4] + $f57c0faf,7);    D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 5] + $4787c62a,12);    C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[ 6] + $a8304613,17);    B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[ 7] + $fd469501,22);    A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[ 8] + $698098d8,7);    D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[ 9] + $8b44f7af,12);    C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $ffff5bb1,17);    B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895cd7be,22);    A:= B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6b901122,7);    D:= A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $fd987193,12);    C:= D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $a679438e,17);    B:= C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49b40821,22);    A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 1] + $f61e2562,5);    D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 6] + $c040b340,9);    C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265e5a51,14);    B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 0] + $e9b6c7aa,20);    A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 5] + $d62f105d,5);    D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453,9);    C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $d8a1e681,14);    B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 4] + $e7d3fbc8,20);    A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[ 9] + $21e1cde6,5);    D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $c33707d6,9);    C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 3] + $f4d50d87,14);    B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[ 8] + $455a14ed,20);    A:= B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $a9e3e905,5);    D:= A + LRot32(D + (B xor (C and (A xor B))) + Data[ 2] + $fcefa3f8,9);    C:= D + LRot32(C + (A xor (B and (D xor A))) + Data[ 7] + $676f02d9,14);    B:= C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8d2a4c8a,20);    A:= B + LRot32(A + (B xor C xor D) + Data[ 5] + $fffa3942,4);    D:= A + LRot32(D + (A xor B xor C) + Data[ 8] + $8771f681,11);    C:= D + LRot32(C + (D xor A xor B) + Data[11] + $6d9d6122,16);    B:= C + LRot32(B + (C xor D xor A) + Data[14] + $fde5380c,23);    A:= B + LRot32(A + (B xor C xor D) + Data[ 1] + $a4beea44,4);    D:= A + LRot32(D + (A xor B xor C) + Data[ 4] + $4bdecfa9,11);    C:= D + LRot32(C + (D xor A xor B) + Data[ 7] + $f6bb4b60,16);    B:= C + LRot32(B + (C xor D xor A) + Data[10] + $bebfbc70,23);    A:= B + LRot32(A + (B xor C xor D) + Data[13] + $289b7ec6,4);    D:= A + LRot32(D + (A xor B xor C) + Data[ 0] + $eaa127fa,11);    C:= D + LRot32(C + (D xor A xor B) + Data[ 3] + $d4ef3085,16);    B:= C + LRot32(B + (C xor D xor A) + Data[ 6] + $04881d05,23);    A:= B + LRot32(A + (B xor C xor D) + Data[ 9] + $d9d4d039,4);    D:= A + LRot32(D + (A xor B xor C) + Data[12] + $e6db99e5,11);    C:= D + LRot32(C + (D xor A xor B) + Data[15] + $1fa27cf8,16);    B:= C + LRot32(B + (C xor D xor A) + Data[ 2] + $c4ac5665,23);    A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 0] + $f4292244,6);    D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 7] + $432aff97,10);    C:= D + LRot32(C + (A xor (D or (not B))) + Data[14] + $ab9423a7,15);    B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 5] + $fc93a039,21);    A:= B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655b59c3,6);    D:= A + LRot32(D + (B xor (A or (not C))) + Data[ 3] + $8f0ccc92,10);    C:= D + LRot32(C + (A xor (D or (not B))) + Data[10] + $ffeff47d,15);    B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 1] + $85845dd1,21);    A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 8] + $6fa87e4f,6);    D:= A + LRot32(D + (B xor (A or (not C))) + Data[15] + $fe2ce6e0,10);    C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 6] + $a3014314,15);    B:= C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4e0811a1,21);    A:= B + LRot32(A + (C xor (B or (not D))) + Data[ 4] + $f7537e82,6);    D:= A + LRot32(D + (B xor (A or (not C))) + Data[11] + $bd3af235,10);    C:= D + LRot32(C + (A xor (D or (not B))) + Data[ 2] + $2ad7d2bb,15);    B:= C + LRot32(B + (D xor (C or (not A))) + Data[ 9] + $eb86d391,21);    Inc(CurrentHash[0],A);    Inc(CurrentHash[1],B);    Inc(CurrentHash[2],C);    Inc(CurrentHash[3],D);    Index:= 0;    FillChar(HashBuffer,Sizeof(HashBuffer),0);   end;   procedure Update(const Buffer; Size: longword);   var    PBuf: ^byte;   begin    Inc(LenHi,Size shr 29);    Inc(LenLo,Size*8);    if LenLo< (Size*8) then      Inc(LenHi);    PBuf:= @Buffer;    while Size> 0 do    begin      if (Sizeof(HashBuffer)-Index)<= DWord(Size) then      begin        Move(PBuf^,HashBuffer[Index],Sizeof(HashBuffer)-Index);        Dec(Size,Sizeof(HashBuffer)-Index);        Inc(PBuf,Sizeof(HashBuffer)-Index);        Compress;      end      else      begin        Move(PBuf^,HashBuffer[Index],Size);        Inc(Index,Size);        Size:= 0;      end;    end;   end;   procedure Final(var Digest);   begin    HashBuffer[Index]:= $80;    if Index>= 56 then Compress;    PDWord(@HashBuffer[56])^:= LenLo;    PDWord(@HashBuffer[60])^:= LenHi;    Compress;    Move(CurrentHash,Digest,Sizeof(CurrentHash));    Burn;   end;   begin   Init;   Update(s[1],Length(s));   Final(a);   result:='';   for i:=0 to 15 do    result:=result+IntToHex(a[i],0);   Burn;   end;

Автор Vit.

dsergey, он давно включен.

да я не к тому, что именно этот код нужно включать в новую версию, я просто привел пример.
Когда-то я искал алгоритмы шифрования, создание серийных номеров и т.к., читал об "антивзомах", но информации нарыл малова-то
Добавлено @ 11:12
можно добаить, наверное что-нибудь о сжатии

в DRKB есть статья создаем свой unrar, используя unrar.dll

на форуме где-то был пример использования
Кладем на форму кнопку и листбокс

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls,unrars; type  TForm1 = class(TForm)    Button1: TButton;    ListBox1: TListBox;    procedure Button1Click(Sender: TObject);    procedure FormCreate(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  pathstarts:string; implementation {$R *.dfm} procedure unrarss(ArcName,path:Pchar); var   st1:string;   OperBegin, OperEnd: TTimeStamp;   Total: LongWord;   hArcData:THandle;   RHCode,PFCode :integer;   CmtBuf:array [0..16384] of char;   HeaderData: RARHeaderData;   OpenArchiveData: RAROpenArchiveData; begin   if not fileexists(ArcName) then   begin   ShowMessage ('Нет Файла '+ArcName);   Exit;   end;   OpenArchiveData.ArcName:=ArcName;   OpenArchiveData.CmtBuf:=CmtBuf;   OpenArchiveData.CmtBufSize:=sizeof(CmtBuf);   OpenArchiveData.OpenMode:=RAR_OM_EXTRACT;   hArcData:=RAROpenArchive(OpenArchiveData);   RARSetPassword(hArcData,'000');   OperBegin:=DateTimeToTimeStamp(Now);   RHCode := 0; while (RHCode = 0) do begin PFCode:=RARProcessFile(hArcData,RAR_EXTRACT,path,nil); RHCode:=RARReadHeader(hArcData,HeaderData); if Pos('\',HeaderData.FileName)>0 then begin Form1.Listbox1.Items.Add(HeaderData.FileName); Form1.ListBox1.ItemIndex:=Form1.ListBox1.Items.Count-1; End; OperEnd:=DateTimeToTimeStamp(Now); Total := OperEnd.Time - OperBegin.Time; if Total=0 then Total:=1; Application.ProcessMessages; end; Str(RHCode,st1); if RhCode<>10 then ShowMessage('Ошибка распаковки Код:'+St1+#10+#13+'Файл:'+ArcName); RARCloseArchive(hArcData); end; procedure TForm1.Button1Click(Sender: TObject); begin ListBox1.Clear; unrarss(pchar(pathstarts+'rar\Izone300.rar'),pchar(pathstarts+'rar\unpack')); end; procedure TForm1.FormCreate(Sender: TObject); begin pathstarts:=ExtractFileDir(Paramstr(0)); if pathstarts<>'' then if pathstarts[length(pathstarts)]<>'\' then pathstarts:=pathstarts+'\'; end; end.

dsergey, дело в том, что в DRKB попадает почти весь материал, который виту или был прислан или он его сам нашел. Если его там нет, то значит, его никто не прислал или вит сам, не нашел. Делать заказы на добавление той или иной информации не нужно, если у вас есть примеры, то выкладывайте их, и я думаю, вит с радостью, их разместит. А говорить, хорошо бы добавить то или другое не нужно. Специально искать, материал по конкретной тематике я думаю, вит не будет т.к. при составлении DRKB и так дел хватает.

Хоть в DRKB есть инфо об использовании Excel`я, могу выложить свои примеры работы с Excel`ем `97, XP,2003
Импорт и экспорт данных, обрамление ячеек, размеры ячеек, поиск рабочих книг и листов в рабочих книгах в открытом Excel`e, поиск информмации, поиск последней заполненной ячейки, открытие, корректное закрытие Excel`я, установка формата (числовой, текстовый и т.д.) ячейки, удаление столбцов строк.

Ну, до понедельника.

dsergey, выкладывай.

Примеры работы с MS Excel
в секции uses стоит так ExcelXP,{Excel2000, Excel97} крайней мере у меня, т.к. некоторые параметры при работе с разными версиями отличаются, например при открытии файла в версии XP больше параметров, чем в версии `97.
На форме лежит компонента Ex1 типа TExcelApplication со страницы Servers, свойства AutoConnect и AutoQuit :=False, свойство ConnectKind:=ckRunningOrNew,

Код

//объявления переменных var WorkBk : _WorkBook; //  определяем WorkBook WorkSheet : _WorkSheet; //  определяем WorkSheet Range:OleVariant;// begin ...     Ex1.Connect;//открываем сам Excel     //открываем существующий файл, в разных версиях разное кол-во параметров     Ex1.Workbooks.Open(FileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam,       EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,       EmptyParam,EmptyParam,EmptyParam, LOCALE_USER_DEFAULT); //параметры для версии XP - имя файла, пути на ссылки в файле(UpdateLinks),Откывать ли //только для чтения, Формат, Пароль, WriteResPassword - ?, Игнорировать ли рекомендации //только для чтения, Origin - ?, Delimiter - символ-разделитель целой и дробной частей, Editable-?     Ex1.Application.EnableEvents := false;//отключаем реакцию Excel`я на события //так ищем название рабочей книги, т.к. Excel может уже быть открыт с другой книгой //поиск начинаем с единицы   For i:=1 to ex1.Workbooks.Count do begin     if ex1.Workbooks.Item[i].Name='MyFile.xls' then break;   end;  // Выбираем WorkBook   WorkBk := ex1.WorkBooks.Item[iInd];   // Определяем WorkSheet  //если кол-во листов больше 1, иначе нет смысла искать //memoSheets - TMemo - с ключевыми фразами, напрмер, //Лист 1, Мой лист, Данные,   if WorkBk.Worksheets.Count>1 then begin     For x:=0 to memoSheets.Lines.Count-1 do begin      For q:=1 to WorkBk.Worksheets.Count do begin        WorkSheet:=WorkBk.WorkSheets.Get_Item(q) as _WorkSheet;        if WorkSheet.Name = memoSheets.Lines[x] then begin          //нашли лист          bNaydeno:=True;          WorkSheet.Activate(LOCALE_USER_DEFAULT);//активируем лист        end;        if bNaydeno= true then break;      end;      if bNaydeno=true then break;     end;//for   end else//if     WorkSheet:=WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;; ------------------ //Поиск последней строки... //можно заранее ставить в файле какую-нибудь метку, напрмер 99999 //функция Find будет показана ниже iNameRow,iLastRow: Integer sNameCol: String   if Find('99999',iNameRow,sNameCol, WorkSheet) then begin    iLastRow:=iNameRow-1;//в столбце с наименованием ищем "99999"-конец импорта   end else begin     //и запоминаем в iRows    try//если не находим 99999 то ищем последнюю незаполненную ячейку      WorkSheet.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate;      // Получаем значение последней строки      iLastRow:=(ex1.ActiveCell.Row)-1;     except       try         WorkSheet.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Select;         // Получаем значение последней строки         iLastRow:=(ex1.ActiveCell.Row);       except         iLastRow:=0;       end;//try-except     end;//try-except   end; memoNames - TMemo с наименованиями столбцов, т.к. в моем проекте у разных поставщиков //могут столбцы называться по-разному, например, Товар, Наименование, Наименование товара   //ищем наименование   For r:=0 to memoNames.Lines.Count-1 do begin     bNaydeno:=False;     if Find(memoNames.Lines[r],iNameRow,sNameCol,WorkSheet) then begin       ...      break;     end;//if Find(memoNames.Lines[r],iNameRow,sNameCol) then begin   end;//For r:=0 to memoNames.Lines.Count-1 do begin //так ищем все нужные столбцы, запоминая столбец в каждую отдельную переменную //начинаем импорт со строки iNameRow //в конце могут начаться пустые строки, если неправльно //определилась последняя незаполненная ячейка //тогда нужно прервать цикл импорта      if (WorkSheet.Cells.Item[iNameRow,sNameCol].Value='') or       (WorkSheet.Cells.Item[iNameRow,sNameCol].Value=' ') then       Inc(iStop)//если пустая строка, то увеличиваем на 1      else       iStop:=0;//если следующая не пустая то обнуляем и продолжаем импорт      //если начались пустые строки то прекращаем импорт      if iStop>4 then break; //sg1-TStringGrid      //наименование препарата      sg1.Cells[1,e]:=WorkSheet.Cells.Item[iNameRow,sNameCol].Value;      //цена      sg1.Cells[2,e]:=WorkSheet.Cells.Item[iNameRow,sPriceCol].Value; //DelProb функция удаления всего лишнего, кроме цифр, точек и запятых //навыходе получаем вместо "2 305 585,85" "2305585,85"      sg1.Cells[2,e]:=DelProb(sg1.Cells[2,e]);//удаляем пробелы      //производитель      sg1.Cells[3,e]:=WorkSheet.Cells.Item[iNameRow,sProdCol].Value;      Inc(iNameRow); //добавляем строки к StringGrid только если они нужны      if sg1.RowCount=e then sg1.RowCount:=sg1.RowCount+1;      //прерываем по желанию пользователя      if fmMain.vAbort=False then begin//прерываем операцию           ...        try         Ex1.Workbooks.Close(LOCALE_USER_DEFAULT);         Ex1.Disconnect;         Ex1.Quit;        except        end;//try-except        Exit;       end;//if fmMain.vAbort=False then begin //так закрываем Excel try   Ex1.Quit;   Ex1.Disconnect;  except   ShowMessage('Ошибка закрытия Excel'); //обнуляем переменную Range  VarClear(Range);

Код

sText - текст для поиска iRow - строка, в которой найдено значение sCol - колонка, в которой найдено значение UsedRange.Find - параметры для поиска, типа What:=sText, ищем в справке по Excel`ю Function TfmImpExcel.Find(sText:String;Var iRow:Integer;Var sCol:String;WorkSheetF:_WorkSheet):Bool; Var UsedRange, Range: OLEVariant; t,y:Integer;//вспомогат для импорта FirstAddress: string; begin //поиск начали  Result:=False;  UsedRange := WorkSheetF.Range['A1','Z5000'];//диапазон поиска, напрмер от 'F25' до 'G30'  Range := UsedRange.Find(What:=sText, LookIn := xlValues, LookAt := xlWhole,SearchDirection := xlNext);  if not VarIsClear(Range) then begin    try      FirstAddress := Range.Address;      //вычисляем номер строки из полученного адреса(абсолютные координаты)      //он начинается после второго значка доллара      //формат найденной строки,что-то типа $A$2 (абсолютные координаты)      t:=PosEx('$',FirstAddress,2);      iRow:=StrToInt(Copy(FirstAddress,t+1,length(FirstAddress)-t));      //вычисляем номер столбца из полученного адреса(абсолютные координаты)      //буква начинается со второго символа      y:=PosEx('$',FirstAddress,2);      sCol:=Copy(FirstAddress,2,y-2);      Result:=true;      VarClear(Range);      VarClear(UsedRange);    except      Result:=False;    end;//try-except  end;//if end;

Это сообщение отредактировал(а) dsergey - 27.12.2004, 10:47