в 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

Зыкрыть Excel можно еще так, я так делаю при закрытии формы(окна) инморта

Код

try   Ex1.Workbooks.Close(LOCALE_USER_DEFAULT);   Ex1.Disconnect;   Ex1.Quit;   Ex1:=nil;  except  end;

на всякий случай дам функцию DelProb

Код

Function TfmImpExcel.DelProb(prob:string):string; Var i:integer; begin result:=''; For i:=1 to Length(prob) do begin   if (prob[i] in ['0'..'9']) or (prob[i]=',') or((prob[i]='.')) then result:=result+prob[i]; end; end;

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

Еще несколько примеров, используя Ole

Excel:Variant - глобальная переменная

Код

... begin //вначале проверяем, не открыт ли Excel  и закрываем if not VarIsEmpty(Excel) then begin  Excel.Quit;  Excel := Unassigned; end;//if    Try//открываем Excel и создаем раб.книгу      Excel:=CreateOleObject('Excel.Application');      /кол-во листов в новой книге      Excel.SheetsInNewWorkbook:=1;//      //добавляем раб.книгу      Excel.WorkBooks.Add;      //в переменную "загоняем" текущий лист      Sheets:=Excel.Workbooks[1].Sheets[1];    Except      SysUtils.beep;      ShowMessage('Не могу открыть Excel!');      Exit;    end;//try-except    //рисуем border //сначала определяем диапазон    Range:=Sheets.Range['B1'];    Range.Borders[4].LineStyle := 1;//Range.Borders[4] - можно ставить от 1 до 8 - точно не мпомню      //рисуем border вокруг ячейки (обрамление)      Range.Borders[1].LineStyle := 1;      Range.Borders[2].LineStyle := 1;      Range.Borders[3].LineStyle := 1;      Range.Borders[4].LineStyle := 1;    //присваиваем значение яцейке    Sheets.Cells[2,2]:=Edit1.Text;// формат Sheets.Cells[№ строки,№ колонки]    //так выполняем выравнивание в диапазоне    //присваиваем диапазону координаты ячейки    Range:=Sheets.Cells[2,2];//можно переменные Range:=Sheets.Cells[iRow,iCol];    Range.HorizontalAlignment := xlCenter;    Range.VerticalAlignment := xlCenter;    //форматируем шрифт    Sheets.Cells[iRow,3]:='ЗАЯВКА';    Range:=Sheets.Cells[iRow,3];    Range.Font.Bold:=True; //с присваиванием значения ячейке могут быть проблемы, т.к. Excel думает, что он очень умный //и вместо числа может переформатировать в дату вида 12дек2004, что бы такого не случилось, //можно заранее отформатировать ячейку в нужный формат (дата, число, валюта, текстовый) //все форматы можно узнать в Excel`е, с пом. макросов, просмотрев затем код, созданный самим //Excel`ем //#,##0.000$ - денежный //[$-FC19]dd mmmm yyyy г/;@ - дата //h:mm;@ - время //0.00% - проценты //# ??/?? - простые дроби 21/25 //[<=9999999]###-####;(###) ###-#### - номер телефона //@ - текстовый формат, если указывать такой формат и присваивать //числовое значение, а затем складывать, то ничего не выйдет //передаваемая строки из Delphi может отличаться, нужно эксперементировать tZay - TTable dbGridZay - DBGrid vRow - integer    while not tZay.Eof do begin      For iColCount:=0 to dbGridZay.Columns.Count-1 do begin        Range:=Sheets.Cells[vRow,iColCount+1];        Case tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).DataType of          ftFloat   : begin                        Range.NumberFormat := '0,000';                        Sheets.Cells[vRow,iColCount+1]:=                        tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsFloat                      end;          ftString  : begin                        Range.NumberFormat := '@';                        Sheets.Cells[vRow,iColCount+1]:=                        tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsString;                      end;          ftInteger : begin                        Range.NumberFormat := '0';                        Sheets.Cells[vRow,iColCount+1]:=                        tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsInteger;                      end;          ftAutoinc : begin                        Range.NumberFormat := '0';                        Sheets.Cells[vRow,iColCount+1]:=                        tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsInteger;                      end;          ftDate    : begin                        Range.NumberFormat := '@';                        dDate:=tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsDateTime;                        Sheets.Cells[vRow,iColCount+1]:=FormatDateTime('dd.mm.yyyy',dDate);                      end        else          Range.NumberFormat := '@';          Sheets.Cells[vRow,iColCount+1]:=          tZay.FieldByName(dbGridZay.Columns[iColCount].FieldName).AsString;        end;//case-else

Всем спасибо!

я не закончил
удаляем лишние столбцы (по умолчанию со сдвигом влево)

Код

dbGridZay - DBGrid    For iColCount:= dbGridZay.Columns.Count-1 downto 0 do begin      if dbGridZay.Columns[iColCount].Visible=False then begin        UsedRange := Sheets.Range['A1','Z100'];//диапазон поиска заголовка        Range := UsedRange.Find(What:=dbGridZay.Columns[iColCount].title.Caption, LookIn := xlValues, LookAt := xlWhole,SearchDirection := xlNext);        if not VarIsEmpty(Range) then begin          try            FirstAddress := Range.Address;            s:=StringReplace(FirstAddress,'$','',[rfReplaceAll]);            [b]Range:=Sheets.Range[s+':'+Copy(s,1,1)+IntToStr(vRow)];[/b]            [b]Range.Delete;[/b]          except          end;//try        end;//if not VarIsEmpty(Range)then begin      end;//if dbGridZay.Columns[iColCount].Visible=False then begin    end;//for delete

если будут какие-нибудь вопросы или поправки, с удовольствием рассмотрю, исправлю

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

запустить внешнее приложение и подождать, пока оно отработает
такая функция тоже будет полезна

Код

function ExecAndWait(const FileName, Params: ShortString; const WinState: Word): boolean; export; var StartInfo: TStartupInfo; ProcInfo: TProcessInformation; CmdLine: ShortString; begin { Помещаем имя файла между кавычками, с соблюдением всех пробелов в именах Win9x } CmdLine := '"' + Filename + '" ' + Params; FillChar(StartInfo, SizeOf(StartInfo), #0); with StartInfo do begin   cb := SizeOf(StartInfo);   dwFlags := STARTF_USESHOWWINDOW;   wShowWindow := WinState; end; Result := CreateProcess(nil, PChar( String( CmdLine ) ), nil, nil, false,                         CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,                         PChar(ExtractFilePath(Filename)),StartInfo,ProcInfo); { Ожидаем завершения приложения } if Result then begin   WaitForSingleObject(ProcInfo.hProcess, INFINITE);   { Free the Handles }   CloseHandle(ProcInfo.hProcess);   CloseHandle(ProcInfo.hThread); end; end;

dsergey, http://vingrad.ru/VF-DLP-000765

вопросов больше не имею

в разделе мультимедии -> мегаплеер, валяются примеры id3(1.0-2.x)редкая штука
надо вклычит в базу

Vit и всем привет! Vit, не знаю замечали дубликаты тем или нет, но на всякий случай скажу: дублируются темы:
Ситемные функции и WinApi->Процессы, потоки...->Как увеличить процессорное время, выделяемое программе и тема оттуда же но
Как поменять приоритет моего приложения.

Поехали дальше. Нашел несколько темок по потокам(API & Delphi) Все взято с проекта DelphiWorld.

№1
Как при создании объекта TThread передать ему некоторое значение

Код

К примеру, функция "прослушивает" каталог на предмет файлов. Если находит, то создает нить, которая будет обрабатывать файл. Потомку надо передать имя файла, а вот как? Странный вопрос. Я бы понял, если бы требовалось передавать данные во время работы нити. А так обычно поступают следующим образом. В объект нити, происходящий от TThread дописывают поля. Как правило, в секцию PRIVATE. Затем переопределяют конструктор CREATE, который, принимая необходимые параметры заполняет соответствующие поля. А уже в методе EXECUTE легко можно пользоваться данными, переданными ей при его создании. TYourThread = class(TTHread)  private    FFileName: string;  protected    procedure Execute; overrided;  public    constructor Create(CreateSuspennded: Boolean; const AFileName: string); end; ... constructor TYourThread.Create(CreateSuspennded: Boolean;            const AFileName: string); begin  inherited Create(CreateSuspennded);  FFIleName := AFileName; end; procedure TYourThread.Execute; begin  try    ...    if FFileName = ...    ...  except    ...  end; end; ... TYourForm = class(TForm) ... private  YourThread: TYourThread;  procedure LaunchYourThread(const AFileName: string);  procedure YourTreadTerminate(Sender: TObject);  ... end; ... procedure TYourForm.LaunchYourThread(          const AFileName: string); begin  YourThread := TYourThread.Create(True, AFileName);  YourThread.Onterminate := YourTreadTerminate;  YourThread.Resume end; ... procedure TYourForm.YourTreadTerminate(Sender: TObject); begin  ... end; ... end.

№2
Помещение формы в поток

Код

Delphi имеет в своем распоряжении классную функцию, позволяющую сделать это: procedure WriteComponentResFile(const FileName: string;  Instance: TComponent); Просто заполните имя файла, в котором вы хотите сохранить компонент, и читайте его затем следующей функцией: function ReadComponentResFile(const FileName: string;  Instance: TComponent): TComponent;

№3
Несколько функций для TStream

Код

Оформил: DeeCo Автор: http://www.swissdelphicenter.ch { These are three utility functions to write strings to a TStream. Nothing fancy, but I just ended up coding this repeatedly so I made these functions. } { Hier sind einige TStreaam Hilfsfunktionen um strings in einen TStream zu schreiben. } unit ClassUtils; interface uses   SysUtils,   Classes; {: Write a string to the stream   @param Stream is the TStream to write to.   @param s is the string to write   @returns the number of bytes written. } function Writestring(_Stream: TStream; const _s: string): Integer; {: Write a string to the stream appending CRLF   @param Stream is the TStream to write to.   @param s is the string to write   @returns the number of bytes written. } function WritestringLn(_Stream: TStream; const _s: string): Integer; {: Write formatted data to the stream appending CRLF   @param Stream is the TStream to write to.   @param Format is a format string as used in sysutils.format   @param Args is an array of const as used in sysutils.format   @returns the number of bytes written. } function WriteFmtLn(_Stream: TStream; const _Format: string;   _Args: array of const): Integer; implementation function Writestring(_Stream: TStream; const _s: string): Integer; begin   Result := _Stream.Write(PChar(_s)^, Length(_s)); end; function WritestringLn(_Stream: TStream; const _s: string): Integer; begin   Result := Writestring(_Stream, _s);   Result := Result + Writestring(_Stream, #13#10); end; function WriteFmtLn(_Stream: TStream; const _Format: string;   _Args: array of const): Integer; begin   Result := WritestringLn(_Stream, Format(_Format, _Args)); end;

Самих линков дать не могу, т.к. давно эту инфу отрыл, беру уже с винта

Добавлено @ 23:02
Да, кстати, хочу заметить: это я не тестировал.
Добавлено @ 23:08
Тоже с Delphi World

Поток с доступом к глобальной переменной основной программы

Код

Автор: Xavier Pacheco unit Main; interface uses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  StdCtrls; type  TMainForm = class(TForm)    Button1: TButton;    procedure Button1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  MainForm: TMainForm; implementation {$R *.DFM} { NOTE: Change GlobalStr from var to threadvar to see difference } var  //threadvar  GlobalStr: string; type  TTLSThread = class(TThread)  private    FNewStr: string;  protected    procedure Execute; override;  public    constructor Create(const ANewStr: string);  end; procedure SetShowStr(const S: string); begin  if S = '' then    MessageBox(0, PChar(GlobalStr), 'The string is...', MB_OK)  else    GlobalStr := S; end; constructor TTLSThread.Create(const ANewStr: string); begin  FNewStr := ANewStr;  inherited Create(False); end; procedure TTLSThread.Execute; begin  FreeOnTerminate := True;  SetShowStr(FNewStr);  SetShowStr(''); end; procedure TMainForm.Button1Click(Sender: TObject); begin  SetShowStr('Hello world');  SetShowStr('');  TTLSThread.Create('Dilbert');  Sleep(100);  SetShowStr(''); end; end.

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

Цитата(Slawanix @ 19.1.2005, 00:00)

Vit, не знаю замечали дубликаты тем или нет, но на всякий случай скажу: дублируются темы: Ситемные функции и WinApi->Процессы, потоки...->Как увеличить процессорное время, выделяемое программе и тема оттуда же но Как поменять приоритет моего приложения.

Имеется ввиду DRKB